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);
#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 );
+@EXPORT_OK = qw(
+ dbh fields hfields qsearch qsearchs dbdef jsearch
+ str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql
+);
$DEBUG = 0;
$me = '[FS::Record]';
params => { map { $_ => $param->{$_} } @pass_params },
#?
default_csv => $opt->{default_csv},
+ postinsert_callback => $opt->{postinsert_callback},
);
if ( $opt->{'batch_namecol'} ) {
=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'};
$row_callback = '';
@fields = @{ $param->{'fields'} };
- $postinsert_callback = $param->{'postinsert_callback'}
- if $param->{'postinsert_callback'}
-
} else {
die "neither format nor fields specified";
}
eval "use Parse::FixedLength;";
die $@ if $@;
- $parser = new Parse::FixedLength $fixedlength_format;
+ $parser = Parse::FixedLength->new($fixedlength_format);
}
else {
} 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 ) {
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
$self->getfield($field)
- =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
+ =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
}
}
+=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);
'';
return "Illegal (enum) field $field: ". $self->getfield($field);
}
+=item ut_enumn COLUMN CHOICES_ARRAYREF
+
+Like ut_enum, except the null value is also allowed.
+
+=cut
+
+sub ut_enumn {
+ my( $self, $field, $choices ) = @_;
+ $self->getfield($field)
+ ? $self->ut_enum($field, $choices)
+ : '';
+}
+
+
=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
Check/untaint a foreign column key. Call a regular ut_ method (like ut_number)
my $sth = dbh->prepare($sql) or die dbh->errstr;
$sth->execute(@_)
or die "Unexpected error executing statement $sql: ". $sth->errstr;
- my $scalar = $sth->fetchrow_arrayref->[0];
+ my $row = $sth->fetchrow_arrayref or return '';
+ my $scalar = $row->[0];
defined($scalar) ? $scalar : '';
}
}
+=item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF
+
+Returns the items concatendated based on database type, using "CONCAT()" for
+mysql and " || " for Pg and other databases.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub concat_sql {
+ my $driver = ref($_[0]) ? driver_name : shift;
+ my $items = shift;
+
+ if ( $driver =~ /^mysql/i ) {
+ 'CONCAT('. join(',', @$items). ')';
+ } else {
+ join('||', @$items);
+ }
+
+}
+
=back
=head1 BUGS