projects
/
freeside.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git]
/
FS
/
FS
/
Record.pm
diff --git
a/FS/FS/Record.pm
b/FS/FS/Record.pm
index
835b73d
..
b226e17
100644
(file)
--- a/
FS/FS/Record.pm
+++ b/
FS/FS/Record.pm
@@
-367,6
+367,9
@@
sub qsearch {
my @bind_type = ();
my $dbh = dbh;
foreach my $stable ( @stable ) {
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;
#stop altering the caller's hashref
my $record = { %{ shift(@record) || {} } };#and be liberal in receipt
my $select = shift @select;
@@
-979,6
+982,9
@@
sub AUTOLOAD {
my($field)=$AUTOLOAD;
$field =~ s/.*://;
my($field)=$AUTOLOAD;
$field =~ s/.*://;
+ confess "errant AUTOLOAD $field for $self (arg $value)"
+ unless blessed($self) && $self->can('setfield');
+
#$fk_method_cache{$self->table} ||= fk_methods($self->table);
if ( exists($fk_method_cache{$self->table}->{$field}) ) {
#$fk_method_cache{$self->table} ||= fk_methods($self->table);
if ( exists($fk_method_cache{$self->table}->{$field}) ) {
@@
-991,6
+997,8
@@
sub AUTOLOAD {
eval "use FS::$table";
die $@ if $@;
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 );
my $pkey_value = $self->$column();
my %search = ( $foreign_column => $pkey_value );
@@
-1006,12
+1014,8
@@
sub AUTOLOAD {
}
if ( defined($value) ) {
}
if ( defined($value) ) {
- confess "errant AUTOLOAD $field for $self (arg $value)"
- unless blessed($self) && $self->can('setfield');
$self->setfield($field,$value);
} else {
$self->setfield($field,$value);
} else {
- confess "errant AUTOLOAD $field for $self (no args)"
- unless blessed($self) && $self->can('getfield');
$self->getfield($field);
}
}
$self->getfield($field);
}
}
@@
-1123,6
+1127,13
@@
sub hashref {
$self->{'Hash'};
}
$self->{'Hash'};
}
+#fallback
+sub API_getinfo {
+ my $self = shift;
+ +{ ( map { $_=>$self->$_ } $self->fields ),
+ };
+}
+
=item modified
Returns true if any of this object's values have been modified with set (or via
=item modified
Returns true if any of this object's values have been modified with set (or via
@@
-1848,9
+1859,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'}
@@
-1883,6
+1897,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'} }
@@
-1937,18
+1956,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";
}
@@
-2128,6
+2146,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";
@@
-2486,8
+2509,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);
@@
-2861,7
+2886,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+//;
@@
-3321,6
+3346,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;