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);
our $nowarn_identical = 0;
our $nowarn_classload = 0;
our $no_update_diff = 0;
+our $no_history = 0;
our $no_check_foreign = 1; #well, not inefficiently in perl by default anymore
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
$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
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/.*://;
# }
#}
+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.
}
my $h_sth;
- if ( defined dbdef->table('h_'. $table) ) {
+ if ( defined( dbdef->table('h_'. $table) ) && ! $no_history ) {
my $h_statement = $self->_h_statement('insert');
warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or do {
=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
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'}
? $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'} }
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";
}
}
+ 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";
sub encrypt {
my ($self, $value) = @_;
- my $encrypted;
+ my $encrypted = $value;
if ($conf->exists('encryption')) {
if ($self->is_encrypted($value)) {
projects / freeside.git / blobdiff