$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');
}
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 {
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";
'';
}
+=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
#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);
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
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+//;
sub encrypt {
my ($self, $value) = @_;
- my $encrypted;
+ my $encrypted = $value;
if ($conf->exists('encryption')) {
if ($self->is_encrypted($value)) {
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
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
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;