X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=a47cc8bc19c6600460e297bf1cbf251e90e9d14a;hb=e9e0cf0989259b94d9758eceff448666a2e5a5cc;hp=4937347296c60effc9369fd08e76c670d39791f4;hpb=8cc50a2ad12ec3d5bd3f31db741290664064ef06;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 493734729..a47cc8bc1 100644 --- 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,18 +978,44 @@ sub AUTOLOAD { my($self,$value)=@_; my($field)=$AUTOLOAD; $field =~ s/.*://; + + confess "errant AUTOLOAD $field for $self (arg $value)" + unless blessed($self) && $self->can('setfield'); + + #$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'); $self->setfield($field,$value); } else { - confess "errant AUTOLOAD $field for $self (no args)" - unless blessed($self) && $self->can('getfield'); $self->getfield($field); } } -# efficient +# efficient (also, old, doesn't support FK stuff) #sub AUTOLOAD { # my $field = $AUTOLOAD; # $field =~ s/.*://; @@ -991,6 +1026,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 +1617,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 @@ -1746,9 +1847,12 @@ sub batch_import { my $file = $param->{file}; my $params = $param->{params} || {}; + my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix'); + my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8; + my( $type, $header, $sep_char, $fixedlength_format, $xml_format, $asn_format, - $row_callback, @fields ); + $parser_opt, $row_callback, @fields ); my $postinsert_callback = ''; $postinsert_callback = $param->{'postinsert_callback'} @@ -1781,6 +1885,11 @@ sub batch_import { ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } : ''; + $parser_opt = + $param->{'format_parser_opts'} + ? $param->{'format_parser_opts'}{ $param->{'format'} } + : {}; + $xml_format = $param->{'format_xml_formats'} ? $param->{'format_xml_formats'}{ $param->{'format'} } @@ -1835,18 +1944,17 @@ sub batch_import { if ( $type eq 'csv' ) { - my %attr = ( 'binary' => 1, ); - $attr{sep_char} = $sep_char if $sep_char; - $parser = new Text::CSV_XS \%attr; + $parser_opt->{'binary'} = 1; + $parser_opt->{'sep_char'} = $sep_char if $sep_char; + $parser = Text::CSV_XS->new($parser_opt); } elsif ( $type eq 'fixedlength' ) { eval "use Parse::FixedLength;"; die $@ if $@; - $parser = Parse::FixedLength->new($fixedlength_format); + $parser = Parse::FixedLength->new($fixedlength_format, $parser_opt); - } - else { + } else { die "Unknown file type $type\n"; } @@ -2026,6 +2134,11 @@ sub batch_import { } + if ( $custnum_prefix && $hash{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/ + && length($1) == $custnum_length ) { + $hash{custnum} = $2; + } + #my $table = $param->{table}; my $class = "FS::$table";