projects
/
freeside.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
adjust Amcom CDR format, #27946
[freeside.git]
/
FS
/
FS
/
Record.pm
diff --git
a/FS/FS/Record.pm
b/FS/FS/Record.pm
index
a36256b
..
88e5411
100644
(file)
--- a/
FS/FS/Record.pm
+++ b/
FS/FS/Record.pm
@@
-1256,7
+1256,7
@@
sub insert {
}
my $h_sth;
}
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 $h_statement = $self->_h_statement('insert');
warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or do {
@@
-1750,9
+1750,12
@@
sub batch_import {
my $file = $param->{file};
my $params = $param->{params} || {};
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,
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'}
my $postinsert_callback = '';
$postinsert_callback = $param->{'postinsert_callback'}
@@
-1785,6
+1788,11
@@
sub batch_import {
? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
: '';
? $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'} }
$xml_format =
$param->{'format_xml_formats'}
? $param->{'format_xml_formats'}{ $param->{'format'} }
@@
-1839,18
+1847,17
@@
sub batch_import {
if ( $type eq 'csv' ) {
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 $@;
} 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";
}
die "Unknown file type $type\n";
}
@@
-2030,6
+2037,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";
#my $table = $param->{table};
my $class = "FS::$table";
@@
-2354,8
+2366,10
@@
sub ut_text {
#warn "msgcat ". \&msgcat. "\n";
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
#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)
$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);
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
@@
-2729,7
+2743,7
@@
May not be null.
sub ut_name {
my( $self, $field ) = @_;
# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
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+//;
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
my $name = $1;
$name =~ s/^\s+//;
@@
-2974,7
+2988,7
@@
You should generally not have to worry about calling this, as the system handles
sub encrypt {
my ($self, $value) = @_;
sub encrypt {
my ($self, $value) = @_;
- my $encrypted;
+ my $encrypted
= $value
;
if ($conf->exists('encryption')) {
if ($self->is_encrypted($value)) {
if ($conf->exists('encryption')) {
if ($self->is_encrypted($value)) {
@@
-3194,6
+3208,8
@@
sub _quote {
my $column_type = $column_obj->type;
my $nullable = $column_obj->null;
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;
warn " $table.$column: $value ($column_type".
( $nullable ? ' NULL' : ' NOT NULL' ).
")\n" if $DEBUG > 2;