communigate phase 3: RPOP/acct_snarf, RT#7515

[freeside.git] / FS / FS / Record.pm

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 201e7b2..bc075dd 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -31,7 +31,7 @@ use Tie::IxHash;
 
 #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 );
+                str2time_sql str2time_sql_closing regexp_sql not_regexp_sql );
 
 $DEBUG = 0;
 $me = '[FS::Record]';
@@ -795,6 +795,17 @@ sub setfield {
   $self->set(@_);
 }
 
+=item exists COLUMN
+
+Returns true if the column/field/key COLUMN exists.
+
+=cut
+
+sub exists {
+  my($self,$field) = @_;
+  exists($self->{Hash}->{$field});
+}
+
 =item AUTLOADED METHODS
 
 $record->column is a synonym for $record->get('column');
@@ -1569,6 +1580,7 @@ sub process_batch_import {
     format_headers             => $opt->{format_headers},
     format_sep_chars           => $opt->{format_sep_chars},
     format_fixedlength_formats => $opt->{format_fixedlength_formats},
+    format_row_callbacks       => $opt->{format_row_callbacks},
     #per-import
     job                        => $job,
     file                       => $file,
@@ -1609,6 +1621,8 @@ Class method for batch imports.  Available params:
 
 =item format_fixedlength_formats
 
+=item format_row_callbacks
+
 =item params
 
 =item job
@@ -1633,7 +1647,7 @@ sub batch_import {
   my $param = shift;
 
   warn "$me batch_import call with params: \n". Dumper($param)
-    if $DEBUG;
+  ;#  if $DEBUG;
 
   my $table   = $param->{table};
   my $formats = $param->{formats};
@@ -1674,6 +1688,11 @@ sub batch_import {
       ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
       : '';
 
+  my $row_callback =
+    $param->{'format_row_callbacks'}
+      ? $param->{'format_row_callbacks'}{ $param->{'format'} }
+      : '';
+
   my @fields = @{ $formats->{ $format } };
 
   my $row = 0;
@@ -1769,6 +1788,8 @@ sub batch_import {
 
       next if $line =~ /^\s*$/; #skip empty lines
 
+      $line = &{$row_callback}($line) if $row_callback;
+
       $parser->parse($line) or do {
         $dbh->rollback if $oldAutoCommit;
         return "can't parse: ". $parser->error_input();
@@ -2140,7 +2161,7 @@ sub ut_alpha {
   '';
 }
 
-=item ut_alpha COLUMN
+=item ut_alphan COLUMN
 
 Check/untaint alphanumeric strings (no spaces).  May be null.  If there is an
 error, returns the error, otherwise returns false.
@@ -2155,6 +2176,22 @@ sub ut_alphan {
   '';
 }
 
+=item ut_alphasn COLUMN
+
+Check/untaint alphanumeric strings, spaces allowed.  May be null.  If there is
+an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_alphasn {
+  my($self,$field)=@_;
+  $self->getfield($field) =~ /^([\w ]*)$/ 
+    or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
+  $self->setfield($field,$1);
+  '';
+}
+
+
 =item ut_alpha_lower COLUMN
 
 Check/untaint lowercase alphanumeric strings (no spaces).  May not be null.  If
@@ -2764,23 +2801,25 @@ sub h_date {
   $h ? $h->history_date : '';
 }
 
-=item scalar_sql SQL
+=item scalar_sql SQL [ PLACEHOLDER, ... ]
+
+A class or object method.  Executes the sql statement represented by SQL and
+returns a scalar representing the result: the first column of the first row.
 
-A class method with a propensity for becoming an instance method.  This
-method executes the sql statement represented by SQL and returns a scalar
-representing the result.  Don't ask for rows -- you get the first column
-of the first row.  Don't give me bogus SQL or I'll die on you.
+Dies on bogus SQL.  Returns an empty string if no row is returned.
 
-Returns an empty string in the event of no rows.
+Typically used for statments which return a single value such as "SELECT
+COUNT(*) FROM table WHERE something" OR "SELECT column FROM table WHERE key = ?"
 
 =cut
 
 sub scalar_sql {
-  my($self, $sql ) = ( shift, shift );
+  my($self, $sql) = (shift, shift);
   my $sth = dbh->prepare($sql) or die dbh->errstr;
-  $sth->execute
+  $sth->execute(@_)
     or die "Unexpected error executing statement $sql: ". $sth->errstr;
-  $sth->fetchrow_arrayref->[0] || '';
+  my $scalar = $sth->fetchrow_arrayref->[0];
+  defined($scalar) ? $scalar : '';
 }
 
 =back
@@ -2926,6 +2965,48 @@ sub str2time_sql_closing {
   return ' ) ';
 }
 
+=item regexp_sql [ DRIVER_NAME ]
+
+Returns the operator to do a regular expression comparison based on database
+type, such as '~' for Pg or 'REGEXP' for mysql.
+
+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 regexp_sql {
+  my $driver = shift || driver_name;
+
+  return '~'      if $driver =~ /^Pg/i;
+  return 'REGEXP' if $driver =~ /^mysql/i;
+
+  die "don't know how to use regular expressions in ". driver_name." databases";
+
+}
+
+=item not_regexp_sql [ DRIVER_NAME ]
+
+Returns the operator to do a regular expression negation based on database
+type, such as '!~' for Pg or 'NOT REGEXP' for mysql.
+
+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 not_regexp_sql {
+  my $driver = shift || driver_name;
+
+  return '!~'         if $driver =~ /^Pg/i;
+  return 'NOT REGEXP' if $driver =~ /^mysql/i;
+
+  die "don't know how to use regular expressions in ". driver_name." databases";
+
+}
+
 =back
 
 =head1 BUGS