autoload methods returning foreign records, RT#13971

[freeside.git] / FS / FS / Record.pm

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 4937347..835b73d 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -3,7 +3,7 @@ use base qw( Exporter );
 
 use strict;
 use vars qw( $AUTOLOAD
-             %virtual_fields_cache
+             %virtual_fields_cache %fk_method_cache
              $money_char $lat_lower $lon_upper
            );
 use Carp qw(carp cluck croak confess);
@@ -73,6 +73,10 @@ FS::UID->install_callback( sub {
     eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
   }
 
+  foreach my $table ( dbdef->tables ) {
+    $fk_method_cache{$table} = fk_methods($table);
+  }
+
 } );
 
 =head1 NAME
@@ -962,6 +966,11 @@ $record->column is a synonym for $record->get('column');
 
 $record->column('value') is a synonym for $record->set('column','value');
 
+$record->foreign_table_name calls qsearchs and returns a single
+FS::foreign_table record (for tables referenced by a column of this table) or
+qsearch and returns an array of FS::foreign_table records (for tables
+referenced by a column in the foreign table).
+
 =cut
 
 # readable/safe
@@ -969,6 +978,33 @@ sub AUTOLOAD {
   my($self,$value)=@_;
   my($field)=$AUTOLOAD;
   $field =~ s/.*://;
+
+  #$fk_method_cache{$self->table} ||= fk_methods($self->table);
+  if ( exists($fk_method_cache{$self->table}->{$field}) ) {
+
+    my $fk_info = $fk_method_cache{$self->table}->{$field};
+    my $method = $fk_info->{method} || 'qsearchs';
+    my $table = $fk_info->{table} || $field;
+    my $column = $fk_info->{column};
+    my $foreign_column = $fk_info->{references} || $column;
+
+    eval "use FS::$table";
+    die $@ if $@;
+
+    my $pkey_value = $self->$column();
+    my %search = ( $foreign_column => $pkey_value );
+
+    # FS::Record->$method() ?  they're actually just subs :/
+    if ( $method eq 'qsearchs' ) { 
+      return $pkey_value ? qsearchs( $table, \%search ) : '';
+    } elsif ( $method eq 'qsearch' ) {
+      return $pkey_value ? qsearch(  $table, \%search ) : ();
+    } else {
+      die "unknown method $method";
+    }
+
+  }
+
   if ( defined($value) ) {
     confess "errant AUTOLOAD $field for $self (arg $value)"
       unless blessed($self) && $self->can('setfield');
@@ -980,7 +1016,7 @@ sub AUTOLOAD {
   }    
 }
 
-# efficient
+# efficient (also, old, doesn't support FK stuff)
 #sub AUTOLOAD {
 #  my $field = $AUTOLOAD;
 #  $field =~ s/.*://;
@@ -991,6 +1027,72 @@ sub AUTOLOAD {
 #  }    
 #}
 
+sub fk_methods {
+  my $table = shift;
+
+  my %hash = ();
+
+  # foreign keys we reference in other tables
+  foreach my $fk (dbdef->table($table)->foreign_keys) {
+
+    my $method = '';
+    if ( scalar( @{$fk->columns} ) == 1 ) {
+      if ( ! @{$fk->references} || $fk->columns->[0] eq $fk->references->[0] ){
+        $method = $fk->table;
+      } else {
+        #some sort of hint in the table.pm or schema for methods not named
+        # after their foreign table (well, not a whole lot different than
+        # just providing a small subroutine...)
+      }
+
+      if ( $method ) {
+        $hash{$method} = { #fk_info
+                           'method' => 'qsearchs',
+                           'column' => $fk->columns->[0],
+                           #'references' => $fk->references->[0],
+                         };
+      }
+
+    }
+
+  }
+
+  # foreign keys referenced in other tables to us
+  #  (alas.  why we're cached.  still, might this loop better be done once at
+  #   schema load time insetad of every time we AUTOLOAD a method on a new
+  #   class?)
+  foreach my $f_table ( dbdef->tables ) {
+    foreach my $fk (dbdef->table($f_table)->foreign_keys) {
+
+      next unless $fk->table eq $table;
+
+      my $method = '';
+      if ( scalar( @{$fk->columns} ) == 1 ) {
+        if ( ! @{$fk->references} || $fk->columns->[0] eq $fk->references->[0] ){
+          $method = $f_table;
+        } else {
+          #some sort of hint in the table.pm or schema for methods not named
+          # after their foreign table (well, not a whole lot different than
+          # just providing a small subroutine...)
+        }
+
+        if ( $method ) {
+          $hash{$method} = { #fk_info
+                             'method' => 'qsearch',
+                             'column' => $fk->columns->[0], #references||column
+                             #'references' => $fk->column->[0],
+                           };
+        }
+
+      }
+
+    }
+
+  }
+
+  \%hash;
+}
+
 =item hash
 
 Returns a list of the column/value pairs, usually for assigning to a new hash.
@@ -1516,7 +1618,7 @@ sub rep {
 =item check
 
 Checks custom fields. Subclasses should still provide a check method to validate
-non-custom fields, foreign keys, etc., and call this method via $self->SUPER::check.
+non-custom fields, etc., and call this method via $self->SUPER::check.
 
 =cut