[Rt-commit] r3061 - in DBIx-SearchBuilder/trunk: . SearchBuilder t

[glasser at bestpractical.com]

Author: glasser
Date: Thu Jun  2 20:11:44 2005
New Revision: 3061

Modified:
   DBIx-SearchBuilder/trunk/   (props changed)
   DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
   DBIx-SearchBuilder/trunk/t/11schema_records.t
Log:
 r33832 at tin-foil:  glasser | 2005-06-02 17:57:40 -0400
 Reading and writing to (non-foreign) references.  Recognition of foreign-collections,
 but doesn't do anything with them


Modified: DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm	Thu Jun  2 20:11:44 2005
@@ -431,22 +431,33 @@
 
     if ( $self->_Accessible( $Attrib, 'read' ) ) {
         *{$AUTOLOAD} = sub { return ( $_[0]->_Value($Attrib) ) };
-	goto &$AUTOLOAD;
+        goto &$AUTOLOAD;
+    }
+    elsif ( $self->_Accessible( $Attrib, 'record-read') ) {
+        *{$AUTOLOAD} = sub { $_[0]->_ToRecord( $Attrib, $_[0]->_Value($Attrib) ) };
+        goto &$AUTOLOAD;        
     }
     elsif ( $AUTOLOAD =~ /.*::[sS]et_?(\w+)/o ) {
-            $Attrib = $1;
+        $Attrib = $1;
 
         if ( $self->_Accessible( $Attrib, 'write' ) ) {
-
             *{$AUTOLOAD} = sub {
                 return ( $_[0]->_Set( Field => $Attrib, Value => $_[1] ) );
             };
-	    goto &$AUTOLOAD;
-        }
+            goto &$AUTOLOAD;
+        } elsif ( $self->_Accessible( $Attrib, 'record-write') ) {
+            *{$AUTOLOAD} = sub {
+                my $self = shift;
+                my $val = shift;
 
+                $val = $val->id if UNIVERSAL::isa($val, 'DBIx::SearchBuilder::Record');
+                return ( $self->_Set( Field => $Attrib, Value => $val ) );
+            };
+            goto &$AUTOLOAD;            
+        }
         elsif ( $self->_Accessible( $Attrib, 'read' ) ) {
             *{$AUTOLOAD} = sub { return ( 0, 'Immutable field' ) };
-	    goto &$AUTOLOAD;
+            goto &$AUTOLOAD;
         }
         else {
             return ( 0, 'Nonexistant field?' );
@@ -461,7 +472,7 @@
                     Args  => [@_],
                 );
             };
-	    goto &$AUTOLOAD;
+            goto &$AUTOLOAD;
         }
         else {
             return ( 0, 'No object mapping for field' );
@@ -476,7 +487,7 @@
         $Attrib = $1;
 
         *{$AUTOLOAD} = sub { return ( $_[0]->_Validate( $Attrib, $_[1] ) ) };
-	goto &$AUTOLOAD;
+        goto &$AUTOLOAD;
     }
 
     # TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,
@@ -586,9 +597,17 @@
   my $schema = $self->Schema;
   
   for my $field (keys %$schema) {
-    next unless $schema->{$field}{'TYPE'} or $schema->{$field}{'REFERENCES'};
-    
-    $accessible->{$field} = { 'read' => 1, 'write' => 1 };
+    if ($schema->{$field}{'TYPE'}) {
+        $accessible->{$field} = { 'read' => 1, 'write' => 1 };
+    } elsif (my $refclass = $schema->{$field}{'REFERENCES'}) {
+        if (UNIVERSAL::isa($refclass, 'DBIx::SearchBuilder::Record')) {
+            $accessible->{$field} = { 'record-read' => 1, 'record-write' => 1 };
+        } elsif (UNIVERSAL::isa($refclass, 'DBIx::SearchBuilder')) {
+            $accessible->{$field} = { 'foreign-collection' => 1 };
+        } else {
+            warn "Error: $refclass neither Record nor Collection";
+        }
+    }
   }
   
   return $accessible;  
@@ -668,8 +687,7 @@
 
 sub __Value {
   my $self = shift;
-  my $origfield = shift;
-  my $field = lc $origfield;
+  my $field = lc shift;
 
   if (!$self->{'fetched'}{$field} and my $id = $self->id() ) {
     my $pkey = $self->_PrimaryKey();
@@ -683,9 +701,7 @@
   }
 
   my $value = $self->{'values'}{$field};
-  
-  $value = $self->_ToRecord($origfield, $value) if $self->can('Schema');
-  
+    
   return $value;
 }
 # }}}

Modified: DBIx-SearchBuilder/trunk/t/11schema_records.t
==============================================================================
--- DBIx-SearchBuilder/trunk/t/11schema_records.t	(original)
+++ DBIx-SearchBuilder/trunk/t/11schema_records.t	Thu Jun  2 20:11:44 2005
@@ -9,7 +9,7 @@
 BEGIN { require "t/utils.pl" }
 our (@AvailableDrivers);
 
-use constant TESTS_PER_DRIVER => 10;
+use constant TESTS_PER_DRIVER => 17;
 
 my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
 plan tests => $total;
@@ -33,10 +33,11 @@
 	my $emp = TestApp::Employee->new($handle);
 	my $e_id = $emp->Create( Name => 'RUZ' );
 	ok($e_id, "Got an id for the new employee: $e_id");
+	$emp->Load($e_id);
+	is($emp->id, $e_id);
 	my $phone = TestApp::Phone->new($handle);
 	isa_ok( $phone, 'TestApp::Phone');
 	my $p_id = $phone->Create( Employee => $e_id, Phone => '+7(903)264-03-51');
-	# XXX: test fails if next string is commented
 	is($p_id, 1, "Loaded phone $p_id");
 	$phone->Load( $p_id );
 
@@ -50,6 +51,24 @@
 	# tests for no object mapping
 	my $val = $phone->Phone;
 	is( $val, '+7(903)264-03-51', 'Non-object things still work');
+	
+	my $emp2 = TestApp::Employee->new($handle);
+	isa_ok($emp2, 'TestApp::Employee');
+	my $e2_id = $emp2->Create( Name => 'Dave' );
+	ok($e2_id, "Got an id for the new employee: $e2_id");
+
+	$phone->SetEmployee($e2_id);
+	
+	my $emp3 = $phone->Employee;
+	isa_ok($emp3, 'TestApp::Employee');
+	is($emp3->Name, 'Dave', 'changed employees by ID');
+
+	$phone->SetEmployee($emp);
+
+	my $emp4 = $phone->Employee;
+	isa_ok($emp4, 'TestApp::Employee');
+	is($emp4->Name, 'RUZ', 'changed employees by obj');
+	
 
 	cleanup_schema( 'TestApp', $handle );
 }} # SKIP, foreach blocks