[rt-devel] [PATCH] DBIx::SB Foriegn keys to objects mapping

[Ruslan U. Zakirov]

          Hello.
New feature to SB.

Allow field to object mapping via AUTOLOAD

             Best regards. Ruslan.
-------------- next part --------------
diff -rubB DBIx-SearchBuilder-0.97/SearchBuilder/Record.pm DBIx-SearchBuilder-0.97-c1/SearchBuilder/Record.pm
--- DBIx-SearchBuilder-0.97/SearchBuilder/Record.pm	2004-02-04 22:00:42.000000000 +0300
+++ DBIx-SearchBuilder-0.97-c1/SearchBuilder/Record.pm	2004-02-28 22:16:59.000000000 +0300
@@ -408,9 +408,7 @@
 
     *{$AUTOLOAD} = sub { return ($_[0]->_Value($Attrib))};
     return($self->_Value($Attrib));
-  }
-    
-  elsif ($AUTOLOAD =~ /.*::[sS]et_?(\w+)/o) {
+  } elsif ($AUTOLOAD =~ /.*::[sS]et_?(\w+)/o) {
 
     if ($self->_Accessible($1,'write')) {
       my $Attrib = $1;
@@ -432,8 +430,28 @@
     else { 
       return(0, 'Nonexistant field?');
     }
+  } elsif ($AUTOLOAD =~ /.*::(\w+?)_?[oO]bj$/o) {
+    if ($self->_Accessible($1,'read')) {
+      if ($self->_Accessible($1,'object')) {
+        my $Attrib = $1;
+        *{$AUTOLOAD} = sub {
+		my $s = shift;
+        	my $args = [@_];
+        	return $s->_Object(
+				Field => $Attrib,
+				ConstructorArgs => $args
+			);
+	};
+	return $self->_Object( Field => $Attrib );
+      } else {
+        return(0, 'No object mapping for field');
+      }
+    } else {
+      return(0, 'Nonexistant field?');
+    }
   }
 
+
   #Previously, I checked for writability here. but I'm not sure that's the
   #right idea. it breaks the ability to do ValidateQueue for a ticket
   #on creation.
@@ -721,6 +739,44 @@
 
 # }}}	
 
+sub _Object
+{
+  my $self = shift;
+  my $args = {
+    Field => '',
+    ConstructorArgs => undef,
+    @_
+  };
+  return $self->_Object(@_);
+}
+
+sub __Object
+{
+  my $self = shift;
+  my $args = {
+    Field => '',
+    ConstructorArgs => undef,
+    @_
+  };
+  my $class = $self->_Accessible( $args->{'Field'}, 'object' );
+  unless ( $class =~ /::/ ) {
+    my ($namespace) = ref($self) =~ /^(.*::)/;
+    $class = $namespace.$class;
+  }
+  no strict qw( refs );
+  my $vglob = ${ $class . '::' }{'VERSION'};
+  unless ( $vglob && *$vglob{'SCALAR'} ) {
+    eval "require $class";
+    die "Use of $class: $@" if ( $@ );
+    unless ( $vglob && *$vglob{'SCALAR'} ) {
+      *{$class."::VERSION"} = '-1, By DBIx::SerchBuilder';
+    }
+  }
+  my $object = $class->new( @{$args->{'ConstructorArgs'}} );
+  $object->LoadById( $self->__Value($args->{'Field'}) );
+  return $object;
+}
+
 # }}}
   
 # {{{ routines dealing with loading records