X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=bdf3bcf3a1dc915ecf4844c2792e58e6e0e05ad2;hb=54a357b171aa44f9399b4c146acd2afd3b686075;hp=d24401301a781d1bbf7d19616366a3ebd779ac4d;hpb=a65d16767bcaa1077be0f41568a4349c9db18990;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index d24401301..bdf3bcf3a 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -458,7 +458,13 @@ sub qsearch { # grep defined( $record->{$_} ) && $record->{$_} ne '', @fields # ) or croak "Error executing \"$statement\": ". $sth->errstr; - $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; + my $ok = $sth->execute; + if (!$ok) { + my $error = "Error executing \"$statement\""; + $error .= ' (' . join(', ', map {"'$_'"} @value) . ')' if @value; + $error .= ': '. $sth->errstr; + croak $error; + } my $table = $stable[0]; my $pkey = ''; @@ -1623,7 +1629,7 @@ sub batch_import { if ( $type eq 'csv' ) { - my %attr = (); + my %attr = ( 'binary' => 1, ); $attr{sep_char} = $sep_char if $sep_char; $parser = new Text::CSV_XS \%attr; @@ -1788,6 +1794,8 @@ sub batch_import { last unless scalar(@buffer); my $row = shift @buffer; + &{ $asn_format->{row_callback} }( $row, $asn_header_buffer ) + if $asn_format->{row_callback}; foreach my $key ( keys %{ $asn_format->{map} } ) { $hash{$key} = &{ $asn_format->{map}{$key} }( $row, $asn_header_buffer ); } @@ -2091,11 +2099,18 @@ is an error, returns the error, otherwise returns false. sub ut_money { my($self,$field)=@_; - $self->setfield($field, 0) if $self->getfield($field) eq ''; - $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/ - or return "Illegal (money) $field: ". $self->getfield($field); - #$self->setfield($field, "$1$2$3" || 0); - $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); + + if ( $self->getfield($field) eq '' ) { + $self->setfield($field, 0); + } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{1})\s*$/ ) { + #handle one decimal place without barfing out + $self->setfield($field, ( ($1||''). ($2||''). ($3.'0') ) || 0); + } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/ ) { + $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); + } else { + return "Illegal (money) $field: ". $self->getfield($field); + } + ''; } @@ -2506,10 +2521,29 @@ sub ut_name { # warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n"; $self->getfield($field) =~ /^([\w \,\.\-\']+)$/ or return gettext('illegal_name'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); + my $name = $1; + $name =~ s/^\s+//; + $name =~ s/\s+$//; + $name =~ s/\s+/ /g; + $self->setfield($field, $name); ''; } +=item ut_namen COLUMN + +Check/untaint proper names; allows alphanumerics, spaces and the following +punctuation: , . - ' + +May not be null. + +=cut + +sub ut_namen { + my( $self, $field ) = @_; + return $self->setfield($field, '') if $self->getfield($field) =~ /^$/; + $self->ut_name($field); +} + =item ut_zip COLUMN Check/untaint zip codes.