finish adding freeside-monthly and monthly events
[freeside.git] / FS / FS / Record.pm
index 9cff579..4a0fe3f 100644 (file)
@@ -185,13 +185,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 +227,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);
@@ -398,7 +433,8 @@ 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);
@@ -471,7 +507,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
@@ -709,18 +745,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 +796,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 +977,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;
@@ -1435,6 +1494,8 @@ Check/untaint zip codes.
 
 =cut
 
+my @zip_reqd_countries = qw( CA ); #US implicit...
+
 sub ut_zip {
   my( $self, $field, $country ) = @_;
   if ( $country eq 'US' ) {
@@ -1443,7 +1504,10 @@ sub ut_zip {
                 $self->getfield($field);
     $self->setfield($field,$1);
   } 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*$/