[Bps-public-commit] dbix-searchbuilder branch, remove-autoload, created. 1.56_03-4-g3bf7867

[Jesse Vincent]

The branch, remove-autoload has been created
        at  3bf7867d10ffc5de4af06bef2c1e605c2438bc98 (commit)

- Log -----------------------------------------------------------------
commit 3bf7867d10ffc5de4af06bef2c1e605c2438bc98
Author: Jesse Vincent <jesse at bestpractical.com>
Date:   Tue Aug 24 12:25:38 2010 -0400

    first pass at possibly replacing autoload

diff --git a/SearchBuilder/Record.pm b/SearchBuilder/Record.pm
index 1b7254b..45c8b61 100755
--- a/SearchBuilder/Record.pm
+++ b/SearchBuilder/Record.pm
@@ -4,10 +4,9 @@ package DBIx::SearchBuilder::Record;
 use strict;
 use warnings;
 
-use vars qw($AUTOLOAD);
 use Class::ReturnValue;
 use Encode qw();
-
+our $AUTOLOAD;
 
 
 =head1 NAME
@@ -353,6 +352,7 @@ Instantiate a new record object.
 
 =cut
 
+our $INITTED={};
 
 sub new  {
     my $proto = shift;
@@ -361,10 +361,11 @@ sub new  {
     my $self  = {};
     bless ($self, $class);
     $self->_Init(@_);
-
+    $class->_PregenerateAccessors() unless ($INITTED->{$class}++);
     return $self;
   }
 
+sub DESTROY{}
 
 # Not yet documented here.  Should almost certainly be overloaded.
 sub _Init {
@@ -406,14 +407,101 @@ sub PrimaryKeys {
     return map { $_ => $self->{'values'}->{lc $_} } @{$self->_PrimaryKeys};
 }
 
+sub _inject_sub {
+    my $class       = shift;
+    my $sub         = shift;
+    my $primary_sub = shift;
+    my @aliases     = @_;
 
+    no strict 'refs';
+    if ( !$class->can($primary_sub)) {
+        *{ $class . "::" . $primary_sub } = $sub;
+    }
 
+    for my $alias (@aliases) {
+        if ( !$class->can($alias)){
+            *{ $class . "::" . $alias } = \*{ $class . "::" . $primary_sub };
+        }
+    }
 
-sub DESTROY {
-    return 1;
 }
 
 
+sub _PregenerateAccessors {
+    my $class      = shift;
+    my $attributes = $class->_ClassAccessible();
+
+    no strict 'refs';
+
+    for my $entry ( keys %$attributes ) {
+        next if ( ref($entry) );
+        if ( $attributes->{$entry}->{read} ) {
+            $class->_inject_sub(
+
+                sub { return ( $_[0]->_Value($entry) ) }, $entry
+            );
+        } elsif ( $attributes->{$entry}->{'record-read'} ) {
+
+            $class->_inject_sub(
+                sub { $_[0]->_ToRecord( $entry, $_[0]->__Value($entry) ) }, $entry
+            );
+
+        } elsif ( $attributes->{$entry}->{'foreign-collection'} ) {
+            $class->_inject_sub( sub { $_[0]->_CollectionValue($entry) }, $entry );
+        }
+
+        if ( $attributes->{$entry}->{write} ) {
+            $class->_inject_sub(
+                sub {
+                    return ( $_[0]->_Set( Field => $entry, Value => $_[1] ) );
+                },
+                "Set$entry",
+                "set_$entry"
+            );
+        } elsif ( $attributes->{$entry}->{'record-write'} ) {
+
+            $class->_inject_sub(
+                sub {
+                    my $val = $_[1];
+
+                    $val = $val->id if UNIVERSAL::isa( $val, 'DBIx::SearchBuilder::Record' );
+                    return ( $_[0]->_Set( Field => $entry, Value => $val ) );
+                },
+                "Set$entry",
+                "set_$entry"
+            );
+
+        } elsif ( $attributes->{$entry}->{read}
+            || $attributes->{$entry}->{'record-read'}
+            || $attributes->{$entry}->{'foreign-collection'} )
+        {
+            $class->_inject_sub( sub { return ( 0, 'Immutable field' ) }, "Set$entry", "set_$entry" );
+
+        }
+
+        if ( $attributes->{$entry}->{object} ) {
+
+            $class->_inject_sub(
+                sub {
+                    return (shift)->_Object(
+                        Field => $entry,
+                        Args  => [@_],
+                    )
+                },
+                $entry . "Obj",
+                $entry . "_obj",
+            );
+
+        }
+
+        $class->_inject_sub(
+            sub { return ( $_[0]->_Validate( $entry, $_[1] ) ) },
+            "Validate" . $entry,
+            "validate_" . $entry
+        );
+    }
+}
+
 sub AUTOLOAD {
     my $self = $_[0];
 
@@ -497,8 +585,6 @@ sub AUTOLOAD {
 
 }
 
-
-
 =head2 _Accessible KEY MODE
 
 Private method.
diff --git a/t/01records.t b/t/01records.t
index 1730645..694ca46 100644
--- a/t/01records.t
+++ b/t/01records.t
@@ -78,9 +78,10 @@ SKIP: {
 		local $SIG{__WARN__} = sub {return};
 		is( $rec->_Value( 'SomeUnexpectedField' ), undef, "The record has no 'SomeUnexpectedField'");
 	}
-	($val, $msg) = $rec->SetSomeUnexpectedField( 'foo' );
-	ok(!$val, $msg);
-	is($msg, 'Nonexistant field?', "Field doesn't exist");
+	($val, $msg) = eval { $rec->SetSomeUnexpectedField( 'foo' )};
+    my $err = $@;
+	ok($err, $msg. " - $err");
+	ok($err, "Field doesn't exist");
 	($val, $msg) = $rec->_Set('SomeUnexpectedField', 'foo');
 	ok(!$val, "$msg");
 
diff --git a/t/02records_object.t b/t/02records_object.t
index 18c724e..ff0fd06 100644
--- a/t/02records_object.t
+++ b/t/02records_object.t
@@ -46,9 +46,10 @@ SKIP: {
 	is($obj->Name, 'RUZ');
 
 	# tests for no object mapping
-	my ($state, $msg) = $phone->ValueObj($handle);
+	my ($state, $msg) = eval {$phone->ValueObj($handle)};
+    my $err = $@;
 	ok(!$state, "State is false");
-	is( $msg, 'No object mapping for field', 'Error message is correct');
+    ok ($err, "we can't call Obj on a row that doesn't have one");
 
 	cleanup_schema( 'TestApp', $handle );
 }} # SKIP, foreach blocks

-----------------------------------------------------------------------