X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=5494053d738c3a5c534f7ef4918c1a0e1d592074;hb=6f26e3a7b5b0411601553fa38d1bfbe59fb02bad;hp=ecd3e9565ff7baeb022ce5ea61a9dd58e7d53823;hpb=f9e0349e73332e1dc7951c30f2a7cbf683e9b594;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ecd3e9565..5494053d7 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -38,7 +38,8 @@ use Tie::IxHash; #export dbdef for now... everything else expects to find it here @EXPORT_OK = qw( dbh fields hfields qsearch qsearchs dbdef jsearch - str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql + str2time_sql str2time_sql_closing regexp_sql not_regexp_sql + concat_sql group_concat_sql midnight_sql ); @@ -125,6 +126,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'); @@ -1581,7 +1584,7 @@ Table name (required). =item params -Listref of field names for static fields. They will be given values from the +Arrayref of field names for static fields. They will be given values from the PARAMS hashref and passed as a "params" hashref to batch_import. =item formats @@ -1630,13 +1633,15 @@ format_types). =back -PARAMS is a base64-encoded Storable string containing the POSTed data as -a hash ref. It normally contains at least one field, "uploaded files", -generated by /elements/file-upload.html and containing the list of uploaded -files. Currently only supports a single file named "file". +PARAMS is a hashref (or base64-encoded Storable hashref) containing the +POSTed data. It must contain the field "uploaded files", generated by +/elements/file-upload.html and containing the list of uploaded files. +Currently only supports a single file named "file". =cut +# uploaded_files is kind of bizarre; fix that some time + use Storable qw(thaw); use Data::Dumper; use MIME::Base64; @@ -1647,7 +1652,13 @@ sub process_batch_import { my @pass_params = $opt->{params} ? @{ $opt->{params} } : (); my %formats = %{ $opt->{formats} }; - my $param = thaw(decode_base64(shift)); + my $param = shift; + # because some job-spawning code (JSRPC) pre-freezes the arguments, + # and then the 'frozen' attribute doesn't get set, and thus $job->args + # doesn't know to thaw them, we have to do this everywhere. + if (!ref $param) { + $param = thaw(decode_base64($param)); + } warn Dumper($param) if $DEBUG; my $files = $param->{'uploaded_files'} @@ -1755,7 +1766,7 @@ sub batch_import { 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'} @@ -1788,6 +1799,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'} } @@ -1842,18 +1858,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"; } @@ -2308,6 +2323,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 @@ -2362,8 +2406,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); @@ -2450,8 +2496,8 @@ sub ut_alpha_lower { Check/untaint phone numbers. May be null. If there is an error, returns the error, otherwise returns false. -Takes an optional two-letter ISO country code; without it or with unsupported -countries, ut_phonen simply calls ut_alphan. +Takes an optional two-letter ISO 3166-1 alpha-2 country code; without +it or with unsupported countries, ut_phonen simply calls ut_alphan. =cut @@ -2737,7 +2783,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+//; @@ -3128,7 +3174,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 @@ -3141,7 +3187,23 @@ 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, @_); +} + +=item row_exists [ WHERE [, PLACEHOLDER ...] ] + +Convenience method for the common case of "SELECT 1 FROM table ... LIMIT 1" +with optional (but almost always needed) WHERE. + +=cut + +sub row_exists { + my($self, $where) = (shift, shift); + my $table = $self->table or die 'row_exists called on object of class '.ref($self); + my $sql = "SELECT 1 FROM $table"; + $sql .= " WHERE $where" if $where; + $sql .= " LIMIT 1"; + $self->scalar_sql($sql, @_); } =back @@ -3202,6 +3264,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; @@ -3375,6 +3439,24 @@ sub concat_sql { } +=item group_concat_sql COLUMN, DELIMITER + +Returns an SQL expression to concatenate an aggregate column, using +GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg. + +=cut + +sub group_concat_sql { + my ($col, $delim) = @_; + $delim = dbh->quote($delim); + if ( driver_name() =~ /^mysql/i ) { + # DISTINCT(foo) is valid as $col + return "GROUP_CONCAT($col SEPARATOR $delim)"; + } else { + return "array_to_string(array_agg($col), $delim)"; + } +} + =item midnight_sql DATE Returns an SQL expression to convert DATE (a unix timestamp) to midnight