X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=35ae45f5bf2eb2a989c96d0fc739df39f5aca7ee;hb=c8cccb4a92adceb943c635fe62dad0d034462ce0;hp=9cff5793682be5e992a3e52839cf0a20ae5c6bbb;hpb=feef0e4c2b4bd6b776b25f5a1bd6fdbf63fd08b2;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 9cff57936..35ae45f5b 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -10,6 +10,7 @@ use Locale::Country;
 use DBI qw(:sql_types);
 use DBIx::DBSchema 0.25;
 use FS::UID qw(dbh getotaker datasrc driver_name);
+use FS::CurrentUser;
 use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
@@ -29,14 +30,12 @@ $me = '[FS::Record]';
 
 $nowarn_identical = 0;
 
-my $conf;
 my $rsa_module;
 my $rsa_loaded;
 my $rsa_encrypt;
 my $rsa_decrypt;
 
 FS::UID->install_callback( sub {
-  $conf = new FS::Conf; 
   $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
 } );
 
@@ -84,6 +83,8 @@ FS::Record - Database record objects
     $error = $record->ut_float('column');
     $error = $record->ut_number('column');
     $error = $record->ut_numbern('column');
+    $error = $record->ut_snumber('column');
+    $error = $record->ut_snumbern('column');
     $error = $record->ut_money('column');
     $error = $record->ut_text('column');
     $error = $record->ut_textn('column');
@@ -185,13 +186,36 @@ sub create {
   }
 }
 
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
+=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
 
 Searches the database for all records matching (at least) the key/value pairs
 in HASHREF.  Returns all the records found as `FS::TABLE' objects if that
 module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
 objects.
 
+The preferred usage is to pass a hash reference of named parameters:
+
+  my @records = qsearch( {
+                           'table'     => 'table_name',
+                           'hashref'   => { 'field' => 'value'
+                                            'field' => { 'op'    => '<',
+                                                         'value' => '420',
+                                                       },
+                                          },
+
+                           #these are optional...
+                           'select'    => '*',
+                           'extra_sql' => 'AND field ',
+                           #'cache_obj' => '', #optional
+                           'addl_from' => 'LEFT JOIN othtable USING ( field )',
+                         }
+                       );
+
+Much code still uses old-style positional parameters, this is also probably
+fine in the common case where there are only two parameters:
+
+  my @records = qsearch( 'table', { 'field' => 'value' } );
+
 ###oops, argh, FS::Record::new only lets us create database fields.
 #Normal behaviour if SELECT is not specified is `*', as in
 #C<SELECT * FROM table WHERE ...>.  However, there is an experimental new
@@ -204,18 +228,30 @@ objects.
 =cut
 
 sub qsearch {
-  my($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+  my($stable, $record, $select, $extra_sql, $cache, $addl_from );
+  if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
+    my $opt = shift;
+    $stable    = $opt->{'table'}     or die "table name is required";
+    $record    = $opt->{'hashref'}   || {};
+    $select    = $opt->{'select'}    || '*';
+    $extra_sql = $opt->{'extra_sql'} || '';
+    $cache     = $opt->{'cache_obj'} || '';
+    $addl_from = $opt->{'addl_from'} || '';
+  } else {
+    ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+    $select ||= '*';
+  }
+
   #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
   #for jsearch
   $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
   $stable = $1;
-  $select ||= '*';
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
   my $dbdef_table = dbdef->table($table)
     or die "No schema for table $table found - ".
-           "do you need to create it or run dbdef-create?";
+           "do you need to run freeside-upgrade?";
   my $pkey = $dbdef_table->primary_key;
 
   my @real_fields = grep exists($record->{$_}), real_fields($table);
@@ -250,7 +286,7 @@ sub qsearch {
         if ( $op eq '=' ) {
           if ( driver_name eq 'Pg' ) {
             my $type = dbdef->table($table)->column($column)->type;
-            if ( $type =~ /(int|serial)/i ) {
+            if ( $type =~ /(int|(big)?serial)/i ) {
               qq-( $column IS NULL )-;
             } else {
               qq-( $column IS NULL OR $column = '' )-;
@@ -261,7 +297,7 @@ sub qsearch {
         } elsif ( $op eq '!=' ) {
           if ( driver_name eq 'Pg' ) {
             my $type = dbdef->table($table)->column($column)->type;
-            if ( $type =~ /(int|serial)/i ) {
+            if ( $type =~ /(int|(big)?serial)/i ) {
               qq-( $column IS NOT NULL )-;
             } else {
               qq-( $column IS NOT NULL AND $column != '' )-;
@@ -330,7 +366,7 @@ sub qsearch {
     grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
   ) {
     if ( $record->{$field} =~ /^\d+(\.\d+)?$/
-         && dbdef->table($table)->column($field)->type =~ /(int|serial)/i
+         && dbdef->table($table)->column($field)->type =~ /(int|(big)?serial)/i
     ) {
       $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
     } else {
@@ -354,7 +390,7 @@ sub qsearch {
   my %result;
   tie %result, "Tie::IxHash";
   my @stuff = @{ $sth->fetchall_arrayref( {} ) };
-  if($pkey) {
+  if ( $pkey && scalar(@stuff) && $stuff[0]->{$pkey} ) {
     %result = map { $_->{$pkey}, $_ } @stuff;
   } else {
     @result{@stuff} = @stuff;
@@ -398,13 +434,15 @@ sub qsearch {
         } values(%result);
       }
     } else {
-      warn "untested code (class FS::$table uses custom new method)";
+      #okay, its been tested
+      # warn "untested code (class FS::$table uses custom new method)";
       @return = map {
         eval 'FS::'. $table. '->new( { %{$_} } )';
       } values(%result);
     }
 
     # Check for encrypted fields and decrypt them.
+    my $conf = new FS::Conf; 
     if ($conf->exists('encryption') && eval 'defined(@FS::'. $table . '::encrypted_fields)') {
       foreach my $record (@return) {
         foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
@@ -471,7 +509,7 @@ sub jsearch {
   );
 }
 
-=item qsearchs TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
+=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
 
 Same as qsearch, except that if more than one record matches, it B<carp>s but
 returns the first.  If this happens, you either made a logic error in asking
@@ -659,7 +697,7 @@ sub insert {
     my $col = $self->dbdef_table->column($primary_key);
     
     $db_seq =
-      uc($col->type) eq 'SERIAL'
+      uc($col->type) =~ /^(BIG)?SERIAL\d?/
       || ( driver_name eq 'Pg'
              && defined($col->default)
              && $col->default =~ /^nextval\(/i
@@ -675,7 +713,8 @@ sub insert {
 
   
   # Encrypt before the database
-  if ($conf->exists('encryption') && defined(eval '@FS::'. $table . 'encrypted_fields')) {
+  my $conf = new FS::Conf;
+  if ($conf->exists('encryption') && defined(eval '@FS::'. $table . '::encrypted_fields')) {
     foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
       $self->{'saved'} = $self->getfield($field);
       $self->setfield($field, $self->enrypt($self->getfield($field)));
@@ -685,18 +724,24 @@ sub insert {
 
   #false laziness w/delete
   my @real_fields =
-    grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+    grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
     real_fields($table)
   ;
   my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
   #eslaf
 
-  my $statement = "INSERT INTO $table ( ".
-      join( ', ', @real_fields ).
-    ") VALUES (".
-      join( ', ', @values ).
-    ")"
-  ;
+  my $statement = "INSERT INTO $table ";
+  if ( @real_fields ) {
+    $statement .=
+      "( ".
+        join( ', ', @real_fields ).
+      ") VALUES (".
+        join( ', ', @values ).
+       ")"
+    ;
+  } else {
+    $statement .= 'DEFAULT VALUES';
+  }
   warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
@@ -709,18 +754,32 @@ sub insert {
 
   $sth->execute or return $sth->errstr;
 
-  my $insertid = '';
-  if ( $db_seq ) { # get inserted id from the database, if applicable
+  # get inserted id from the database, if applicable & needed
+  if ( $db_seq && ! $self->getfield($primary_key) ) {
     warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
+  
+    my $insertid = '';
+
     if ( driver_name eq 'Pg' ) {
 
-      my $oid = $sth->{'pg_oid_status'};
-      my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+      #my $oid = $sth->{'pg_oid_status'};
+      #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+
+      my $default = $self->dbdef_table->column($primary_key)->default;
+      unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return "can't parse $table.$primary_key default value".
+               " for sequence name: $default";
+      }
+      my $sequence = $1;
+
+      my $i_sql = "SELECT currval('$sequence')";
       my $i_sth = dbh->prepare($i_sql) or do {
         dbh->rollback if $FS::UID::AutoCommit;
         return dbh->errstr;
       };
-      $i_sth->execute($oid) or do {
+      #$i_sth->execute($oid) or do {
+      $i_sth->execute() or do {
         dbh->rollback if $FS::UID::AutoCommit;
         return $i_sth->errstr;
       };
@@ -746,11 +805,15 @@ sub insert {
       }
 
     } else {
+
       dbh->rollback if $FS::UID::AutoCommit;
       return "don't know how to retreive inserted ids from ". driver_name. 
              ", try using counterfiles (maybe run dbdef-create?)";
+
     }
+
     $self->setfield($primary_key, $insertid);
+
   }
 
   my @virtual_fields = 
@@ -923,6 +986,11 @@ sub replace {
 
   warn "[debug]$me $new ->replace $old\n" if $DEBUG;
 
+  if ( $new->can('replace_check') ) {
+    my $error = $new->replace_check($old);
+    return $error if $error;
+  }
+
   return "Records not in same table!" unless $new->table eq $old->table;
 
   my $primary_key = $old->dbdef_table->primary_key;
@@ -936,6 +1004,7 @@ sub replace {
   return $error if $error;
   
   # Encrypt for replace
+  my $conf = new FS::Conf;
   my $saved = {};
   if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . 'encrypted_fields')) {
     foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
@@ -967,7 +1036,7 @@ sub replace {
          #false laziness w/qsearch
          if ( driver_name eq 'Pg' ) {
             my $type = $old->dbdef_table->column($_)->type;
-            if ( $type =~ /(int|serial)/i ) {
+            if ( $type =~ /(int|(big)?serial)/i ) {
               qq-( $_ IS NULL )-;
             } else {
               qq-( $_ IS NULL OR $_ = '' )-;
@@ -1133,7 +1202,7 @@ sub _h_statement {
   $time ||= time;
 
   my @fields =
-    grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+    grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
     real_fields($self->table);
   ;
   my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
@@ -1221,6 +1290,25 @@ sub ut_snumber {
   '';
 }
 
+=item ut_snumbern COLUMN
+
+Check/untaint signed numeric data (whole numbers).  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub ut_snumbern {
+  my($self, $field) = @_;
+  $self->getfield($field) =~ /^(-?)\s*(\d*)$/
+    or return "Illegal (numeric) $field: ". $self->getfield($field);
+  if ($1) {
+    return "Illegal (numeric) $field: ". $self->getfield($field)
+      unless $2;
+  }
+  $self->setfield($field, "$1$2");
+  '';
+}
+
 =item ut_number COLUMN
 
 Check/untaint simple numeric data (whole numbers).  May not be null.  If there
@@ -1271,7 +1359,7 @@ sub ut_money {
 =item ut_text COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / =
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ]
 May not be null.  If there is an error, returns the error, otherwise returns
 false.
 
@@ -1282,9 +1370,10 @@ sub ut_text {
   #warn "msgcat ". \&msgcat. "\n";
   #warn "notexist ". \&notexist. "\n";
   #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/
-    or return gettext('illegal_or_empty_text'). " $field: ".
-               $self->getfield($field);
+  $self->getfield($field)
+    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]+)$/
+      or return gettext('illegal_or_empty_text'). " $field: ".
+                 $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -1299,8 +1388,9 @@ May be null.  If there is an error, returns the error, otherwise returns false.
 
 sub ut_textn {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
-    or return gettext('illegal_text'). " $field: ". $self->getfield($field);
+  $self->getfield($field)
+    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]*)$/
+      or return gettext('illegal_text'). " $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -1435,22 +1525,40 @@ Check/untaint zip codes.
 
 =cut
 
+my @zip_reqd_countries = qw( CA ); #US implicit...
+
 sub ut_zip {
   my( $self, $field, $country ) = @_;
+
   if ( $country eq 'US' ) {
-    $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
+
+    $self->getfield($field) =~ /^\s*(\d{5}(\-\d{4})?)\s*$/
+      or return gettext('illegal_zip'). " $field for country $country: ".
+                $self->getfield($field);
+    $self->setfield($field, $1);
+
+  } elsif ( $country eq 'CA' ) {
+
+    $self->getfield($field) =~ /^\s*([A-Z]\d[A-Z])\s*(\d[A-Z]\d)\s*$/i
       or return gettext('illegal_zip'). " $field for country $country: ".
                 $self->getfield($field);
-    $self->setfield($field,$1);
+    $self->setfield($field, "$1 $2");
+
   } else {
-    if ( $self->getfield($field) =~ /^\s*$/ ) {
+
+    if ( $self->getfield($field) =~ /^\s*$/
+         && ( !$country || ! grep { $_ eq $country } @zip_reqd_countries )
+       )
+    {
       $self->setfield($field,'');
     } else {
       $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
         or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
       $self->setfield($field,$1);
     }
+
   }
+
   '';
 }
 
@@ -1534,6 +1642,36 @@ sub ut_foreign_keyn {
     : '';
 }
 
+=item ut_agentnum_acl
+
+Checks this column as an agentnum, taking into account the current users's
+ACLs.
+
+=cut
+
+sub ut_agentnum_acl {
+  my( $self, $field, $null_acl ) = @_;
+
+  my $error = $self->ut_foreign_keyn($field, 'agent', 'agentnum');
+  return "Illegal agentnum: $error" if $error;
+
+  my $curuser = $FS::CurrentUser::CurrentUser;
+
+  if ( $self->$field() ) {
+
+    return "Access deined"
+      unless $curuser->agentnum($self->$field());
+
+  } else {
+
+    return "Access denied"
+      unless $curuser->access_right($null_acl);
+
+  }
+
+  '';
+
+}
 
 =item virtual_fields [ TABLE ]
 
@@ -1556,7 +1694,8 @@ sub virtual_fields {
                 "WHERE dbtable = '$table'";
     my $dbh = dbh;
     my $result = $dbh->selectcol_arrayref($query);
-    confess $dbh->errstr if $dbh->err;
+    confess "Error executing virtual fields query: $query: ". $dbh->errstr
+      if $dbh->err;
     $virtual_fields_cache{$table} = $result;
   }
 
@@ -1640,14 +1779,12 @@ sub _quote {
        ( $nullable ? ' NULL' : ' NOT NULL' ).
        ")\n" if $DEBUG > 2;
 
-  if ( $value eq '' && $column_type =~ /^int/ ) {
-    if ( $nullable ) {
-      'NULL';
-    } else {
-      cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
-            "using 0 instead";
-      0;
-    }
+  if ( $value eq '' && $nullable ) {
+    'NULL'
+  } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
+    cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
+          "using 0 instead";
+    0;
   } elsif ( $value =~ /^\d+(\.\d+)?$/ && 
             ! $column_type =~ /(char|binary|text)$/i ) {
     $value;
@@ -1709,6 +1846,7 @@ sub encrypt {
   my ($self, $value) = @_;
   my $encrypted;
 
+  my $conf = new FS::Conf;
   if ($conf->exists('encryption')) {
     if ($self->is_encrypted($value)) {
       # Return the original value if it isn't plaintext.
@@ -1742,6 +1880,7 @@ sub is_encrypted {
 sub decrypt {
   my ($self,$value) = @_;
   my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted.
+  my $conf = new FS::Conf;
   if ($conf->exists('encryption') && $self->is_encrypted($value)) {
     $self->loadRSA;
     if (ref($rsa_decrypt) =~ /::RSA/) {
@@ -1757,6 +1896,7 @@ sub loadRSA {
     #Initialize the Module
     $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
 
+    my $conf = new FS::Conf;
     if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
       $rsa_module = $conf->config('encryptionmodule');
     }