X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=4915b96ef7baeb93c54e4440d985e6ec689e2fb6;hb=7a486dea647f735a9a1d0381443218ad6affe6e1;hp=ff8a0cc2791282c800320dce0d7b9ac7a77597ee;hpb=8edb7f0ed92d28c935a8e2c26b5b645dccc7704e;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ff8a0cc27..4915b96ef 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -124,6 +124,8 @@ FS::Record - Database record objects $error = $record->ut_floatn('column'); $error = $record->ut_number('column'); $error = $record->ut_numbern('column'); + $error = $record->ut_decimal('column'); + $error = $record->ut_decimaln('column'); $error = $record->ut_snumber('column'); $error = $record->ut_snumbern('column'); $error = $record->ut_money('column'); @@ -367,6 +369,9 @@ sub qsearch { my @bind_type = (); my $dbh = dbh; foreach my $stable ( @stable ) { + + carp '->qsearch on cust_main called' if $stable eq 'cust_main' && $DEBUG; + #stop altering the caller's hashref my $record = { %{ shift(@record) || {} } };#and be liberal in receipt my $select = shift @select; @@ -403,7 +408,6 @@ sub qsearch { push @statement, $statement; warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug; - foreach my $field ( grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields @@ -994,6 +998,8 @@ sub AUTOLOAD { eval "use FS::$table"; die $@ if $@; + carp '->cust_main called' if $table eq 'cust_main' && $DEBUG; + my $pkey_value = $self->$column(); my %search = ( $foreign_column => $pkey_value ); @@ -1036,7 +1042,10 @@ sub fk_methods { my $method = ''; if ( scalar( @{$fk->columns} ) == 1 ) { - if ( ! @{$fk->references} || $fk->columns->[0] eq $fk->references->[0] ){ + if ( ! defined($fk->references) + || ! @{$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 @@ -1067,7 +1076,10 @@ sub fk_methods { my $method = ''; if ( scalar( @{$fk->columns} ) == 1 ) { - if ( ! @{$fk->references} || $fk->columns->[0] eq $fk->references->[0] ){ + if ( ! defined($fk->references) + || ! @{$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 @@ -1122,6 +1134,27 @@ sub hashref { $self->{'Hash'}; } +#fallbacks/generics + +sub API_getinfo { + my $self = shift; + +{ ( map { $_=>$self->$_ } $self->fields ), + }; +} + +sub API_insert { + my( $class, %opt ) = @_; + my $table = $class->table; + my $self = $class->new( { map { $_ => $opt{$_} } fields($table) } ); + my $error = $self->insert; + return +{ 'error' => $error } if $error; + my $pkey = $self->pkey; + return +{ 'error' => '', + 'primary_key' => $pkey, + $pkey => $self->$pkey, + }; +} + =item modified Returns true if any of this object's values have been modified with set (or via @@ -1847,6 +1880,9 @@ 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, $parser_opt, $row_callback, @fields ); @@ -2131,6 +2167,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"; @@ -2400,6 +2441,35 @@ sub ut_numbern { ''; } +=item ut_decimal COLUMN[, DIGITS] + +Check/untaint decimal numbers (up to DIGITS decimal places. If there is an +error, returns the error, otherwise returns false. + +=item ut_decimaln COLUMN[, DIGITS] + +Check/untaint decimal numbers. May be null. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub ut_decimal { + my($self, $field, $digits) = @_; + $digits ||= ''; + $self->getfield($field) =~ /^\s*(\d+(\.\d{0,$digits})?)\s*$/ + or return "Illegal or empty (decimal) $field: ".$self->getfield($field); + $self->setfield($field, $1); + ''; +} + +sub ut_decimaln { + my($self, $field, $digits) = @_; + $self->getfield($field) =~ /^\s*(\d*(\.\d{0,$digits})?)\s*$/ + or return "Illegal (decimal) $field: ".$self->getfield($field); + $self->setfield($field, $1); + ''; +} + =item ut_money COLUMN Check/untaint monetary numbers. May be negative. Set to 0 if null. If there @@ -2489,8 +2559,10 @@ sub ut_text { #warn "msgcat ". \&msgcat. "\n"; #warn "notexist ". \¬exist. "\n"; #warn "AUTOLOAD ". \&AUTOLOAD. "\n"; + # \p{Word} = alphanumerics, marks (diacritics), and connectors + # see perldoc perluniprops $self->getfield($field) - =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/ + =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); @@ -2864,7 +2936,7 @@ May not be null. sub ut_name { my( $self, $field ) = @_; # warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n"; - $self->getfield($field) =~ /^([\w \,\.\-\']+)$/ + $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/ or return gettext('illegal_name'). " $field: ". $self->getfield($field); my $name = $1; $name =~ s/^\s+//; @@ -3250,7 +3322,7 @@ sub scalar_sql { defined($scalar) ? $scalar : ''; } -=item count [ WHERE ] +=item count [ WHERE [, PLACEHOLDER ...] ] Convenience method for the common case of "SELECT COUNT(*) FROM table", with optional WHERE. Must be called as method on a class with an @@ -3263,7 +3335,7 @@ sub count { my $table = $self->table or die 'count called on object of class '.ref($self); my $sql = "SELECT COUNT(*) FROM $table"; $sql .= " WHERE $where" if $where; - $self->scalar_sql($sql); + $self->scalar_sql($sql, @_); } =back @@ -3324,6 +3396,8 @@ sub _quote { my $column_type = $column_obj->type; my $nullable = $column_obj->null; + utf8::upgrade($value); + warn " $table.$column: $value ($column_type". ( $nullable ? ' NULL' : ' NOT NULL' ). ")\n" if $DEBUG > 2;