use strict;
use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $conf $conf_encryption $me
%virtual_fields_cache
+ $conf $conf_encryption $money_char
+ $me
$nowarn_identical $nowarn_classload
$no_update_diff $no_check_foreign
+ @encrypt_payby
);
use Exporter;
use Carp qw(carp cluck croak confess);
use FS::Schema qw(dbdef);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
+use NetAddr::IP; # for validation
#use FS::Conf; #dependency loop bs, in install_callback below instead
use FS::part_virtual_field;
@ISA = qw(Exporter);
+@encrypt_payby = qw( CARD DCRD CHEK DCHK );
+
#export dbdef for now... everything else expects to find it here
@EXPORT_OK = qw(
dbh fields hfields qsearch qsearchs dbdef jsearch
die $@ if $@;
$conf = FS::Conf->new;
$conf_encryption = $conf->exists('encryption');
+ $money_char = $conf->config('money_char') || '$';
$File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
if ( driver_name eq 'Pg' ) {
eval "use DBD::Pg ':pg_types'";
my $bind_type = { TYPE => SQL_VARCHAR };
- if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
+ if ( $type =~ /(big)?(int|serial)/i && $value =~ /^-?\d+(\.\d+)?$/ ) {
$bind_type = { TYPE => SQL_INTEGER };
&& eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
foreach my $record (@return) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+ next if $field eq 'payinfo'
+ && ($record->isa('FS::payinfo_transaction_Mixin')
+ || $record->isa('FS::payinfo_Mixin') )
+ && $record->payby
+ && !grep { $record->payby eq $_ } @encrypt_payby;
# Set it directly... This may cause a problem in the future...
$record->setfield($field, $record->decrypt($record->getfield($field)));
}
&& $conf->exists('encryption')
) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
- $self->{'saved'} = $self->getfield($field);
+ next if $field eq 'payinfo'
+ && ($self->isa('FS::payinfo_transaction_Mixin')
+ || $self->isa('FS::payinfo_Mixin') )
+ && $self->payby
+ && !grep { $self->payby eq $_ } @encrypt_payby;
+ $saved->{$field} = $self->getfield($field);
$self->setfield($field, $self->encrypt($self->getfield($field)));
}
}
&& scalar( eval '@FS::'. $new->table . '::encrypted_fields')
) {
foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
+ next if $field eq 'payinfo'
+ && ($new->isa('FS::payinfo_transaction_Mixin')
+ || $new->isa('FS::payinfo_Mixin') )
+ && $new->payby
+ && !grep { $new->payby eq $_ } @encrypt_payby;
$saved->{$field} = $new->getfield($field);
$new->setfield($field, $new->encrypt($new->getfield($field)));
}
=item fields - Alternate way to specify import, specifying import fields directly as a listref
+=item preinsert_callback
+
=item postinsert_callback
=item params
my( $type, $header, $sep_char, $fixedlength_format,
$xml_format, $row_callback, @fields );
+
my $postinsert_callback = '';
$postinsert_callback = $param->{'postinsert_callback'}
if $param->{'postinsert_callback'};
+ my $preinsert_callback = '';
+ $preinsert_callback = $param->{'preinsert_callback'}
+ if $param->{'preinsert_callback'};
+
if ( $param->{'format'} ) {
my $format = $param->{'format'};
eval "use Parse::FixedLength;";
die $@ if $@;
- $parser = new Parse::FixedLength $fixedlength_format;
+ $parser = Parse::FixedLength->new($fixedlength_format);
}
else {
next if $line =~ /^\s*$/; #skip empty lines
$line = &{$row_callback}($line) if $row_callback;
+
+ next if $line =~ /^\s*$/; #skip empty lines
$parser->parse($line) or do {
$dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $parser->error_input();
+ return "can't parse: ". $parser->error_input() . " " . $parser->error_diag;
};
@columns = $parser->fields();
} elsif ( $type eq 'fixedlength' ) {
+ last unless scalar(@buffer);
+ $line = shift(@buffer);
+
@columns = $parser->parse($line);
} elsif ( $type eq 'xls' ) {
}
next if exists( $param->{skiprow} );
+ if ( $preinsert_callback ) {
+ my $error = &{$preinsert_callback}($record, $param);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "preinsert_callback error". ( $line ? " for $line" : '' ).
+ ": $error";
+ }
+ next if exists $param->{skiprow} && $param->{skiprow};
+ }
+
my $error = $record->insert;
if ( $error ) {
;
# If we're encrypting then don't store the payinfo in the history
- if ( $conf && $conf->exists('encryption') ) {
+ if ( $conf && $conf->exists('encryption') && $self->table ne 'banned_pay' ) {
@fields = grep { $_ ne 'payinfo' } @fields;
}
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
$self->getfield($field)
- =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
+ =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
=item ut_textn COLUMN
Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < >
May be null. If there is an error, returns the error, otherwise returns false.
=cut
$self->setfield($field, uc($1));
'';
}
+
+=item ut_mac_addr COLUMN
+
+Check/untaint mac addresses. May be null.
+
+=cut
+
+sub ut_mac_addr {
+ my($self, $field) = @_;
+
+ my $mac = $self->get($field);
+ $mac =~ s/\s+//g;
+ $mac =~ s/://g;
+ $self->set($field, $mac);
+
+ my $e = $self->ut_hex($field);
+ return $e if $e;
+
+ return "Illegal (mac address) $field: ". $self->getfield($field)
+ unless length($self->getfield($field)) == 12;
+
+ '';
+
+}
+
+=item ut_mac_addrn COLUMN
+
+Check/untaint mac addresses. May be null.
+
+=cut
+
+sub ut_mac_addrn {
+ my($self, $field) = @_;
+ ($self->getfield($field) eq '') ? '' : $self->ut_mac_addr($field);
+}
+
=item ut_ip COLUMN
Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated
}
}
+=item ut_ip46 COLUMN
+
+Check/untaint IPv4 or IPv6 address.
+
+=cut
+
+sub ut_ip46 {
+ my( $self, $field ) = @_;
+ my $ip = NetAddr::IP->new($self->getfield($field))
+ or return "Illegal (IP address) $field: ".$self->getfield($field);
+ $self->setfield($field, lc($ip->addr));
+ return '';
+}
+
+=item ut_ip46n
+
+Check/untaint IPv6 or IPv6 address. May be null.
+
+=cut
+
+sub ut_ip46n {
+ my( $self, $field ) = @_;
+ if ( $self->getfield($field) =~ /^$/ ) {
+ $self->setfield($field, '');
+ return '';
+ }
+ $self->ut_ip46($field);
+}
+
=item ut_coord COLUMN [ LOWER [ UPPER ] ]
Check/untaint coordinates.
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) =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\']+)$/
+ $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
{
$self->setfield($field,'');
} else {
- $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+ $self->getfield($field) =~ /^\s*(\w[\w\-\s]{0,8}\w)\s*$/
or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
$self->setfield($field,$1);
}