X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=ffeabcb17e1b011f9d3df5c38d1f0a0ffb7a1c2d;hp=16520f409152ec02571577609f6e1aaafd79c535;hb=7f4e4fddb595f5c825a18c88ed79029160650dc9;hpb=39289cd1e5a06044aa9a8dc3d2e4d8c9ffb02b11

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 16520f409..ffeabcb17 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -21,6 +21,7 @@ use FS::CurrentUser;
 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;
@@ -30,8 +31,10 @@ use Tie::IxHash;
 @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]';
@@ -1591,6 +1594,7 @@ sub process_batch_import {
     params                     => { map { $_ => $param->{$_} } @pass_params },
     #?
     default_csv                => $opt->{default_csv},
+    postinsert_callback        => $opt->{postinsert_callback},
   );
 
   if ( $opt->{'batch_namecol'} ) {
@@ -1629,6 +1633,8 @@ Class method for batch imports.  Available params:
 
 =item fields - Alternate way to specify import, specifying import fields directly as a listref
 
+=item preinsert_callback
+
 =item postinsert_callback
 
 =item params
@@ -1663,7 +1669,14 @@ sub batch_import {
 
   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'};
@@ -1709,9 +1722,6 @@ sub batch_import {
     $row_callback = '';
     @fields = @{ $param->{'fields'} };
 
-    $postinsert_callback = $param->{'postinsert_callback'}
-      if $param->{'postinsert_callback'}
-
   } else {
     die "neither format nor fields specified";
   }
@@ -1747,7 +1757,7 @@ sub batch_import {
 
       eval "use Parse::FixedLength;";
       die $@ if $@;
-      $parser = new Parse::FixedLength $fixedlength_format;
+      $parser = Parse::FixedLength->new($fixedlength_format);
 
     }
     else {
@@ -1843,15 +1853,20 @@ sub batch_import {
       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' ) {
@@ -1911,6 +1926,16 @@ sub batch_import {
     }
     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 ) {
@@ -2199,7 +2224,7 @@ sub ut_text {
   #warn "notexist ". \&notexist. "\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);
@@ -2374,6 +2399,35 @@ sub ut_ipn {
   }
 }
 
+=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.
@@ -2487,8 +2541,7 @@ May not be null.
 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);
   '';
@@ -2589,6 +2642,20 @@ sub ut_enum {
   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)
@@ -2895,7 +2962,8 @@ sub scalar_sql {
   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 : '';
 }
 
@@ -3084,6 +3152,29 @@ sub not_regexp_sql {
 
 }
 
+=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