X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=748026a13caa7f895827d65dbeb0fcf4a31263fb;hb=583902ab51f62551fe3620d98d42e72620edfa76;hp=1fe51e0659bdccc0b6ced442f78177b47a48f6b3;hpb=49ba3cd359748f5fa3e1b0087840a23c5838d1ab;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 1fe51e065..748026a13 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -2,14 +2,14 @@ package FS::Record;
 
 use strict;
 use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $me %dbdef_cache );
+             $me %dbdef_cache %virtual_fields_cache );
 use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
 use Locale::Country;
 use DBI qw(:sql_types);
-use DBIx::DBSchema 0.21;
+use DBIx::DBSchema 0.23;
 use FS::UID qw(dbh getotaker datasrc driver_name);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
@@ -21,7 +21,7 @@ use Tie::IxHash;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
-$DEBUG = 2;
+$DEBUG = 0;
 $me = '[FS::Record]';
 
 #ask FS::UID to run this stuff for us later
@@ -131,14 +131,18 @@ sub new {
     $self->{'Table'} = shift;
     carp "warning: FS::Record::new called with table name ". $self->{'Table'};
   }
+  
+  $self->{'Hash'} = shift;
 
-  my $hashref = $self->{'Hash'} = shift;
-
-  foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { 
-    $hashref->{$field}='';
+  foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { 
+    $self->{'Hash'}{$field}='';
   }
 
-  $self->_cache($hashref, shift) if $self->can('_cache') && @_;
+  $self->_rebless if $self->can('_rebless');
+
+  $self->{'modified'} = 0;
+
+  $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
 
   $self;
 }
@@ -176,7 +180,7 @@ sub create {
   }
 }
 
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, AS
 
 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
@@ -195,7 +199,7 @@ objects.
 =cut
 
 sub qsearch {
-  my($stable, $record, $select, $extra_sql, $cache ) = @_;
+  my($stable, $record, $select, $extra_sql, $cache, $as ) = @_;
   #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
   #for jsearch
   $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
@@ -204,12 +208,22 @@ sub qsearch {
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
-  my $pkey = $dbdef->table($table)->primary_key;
+  my $dbdef_table = $dbdef->table($table)
+    or die "No schema for table $table found - ".
+           "do you need to create it or run dbdef-create?";
+  my $pkey = $dbdef_table->primary_key;
 
   my @real_fields = grep exists($record->{$_}), real_fields($table);
-  my @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
+  my @virtual_fields;
+  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+    @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
+  } else {
+    cluck "warning: FS::$table not loaded; virtual fields not searchable";
+    @virtual_fields = ();
+  }
 
   my $statement = "SELECT $select FROM $stable";
+  $statement .= " AS $as" if $as;
   if ( @real_fields or @virtual_fields ) {
     $statement .= ' WHERE '. join(' AND ',
       ( map {
@@ -230,7 +244,8 @@ sub qsearch {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
         if ( $op eq '=' ) {
           if ( driver_name eq 'Pg' ) {
-            if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+            my $type = $dbdef->table($table)->column($column)->type;
+            if ( $type =~ /(int|serial)/i ) {
               qq-( $column IS NULL )-;
             } else {
               qq-( $column IS NULL OR $column = '' )-;
@@ -240,7 +255,8 @@ sub qsearch {
           }
         } elsif ( $op eq '!=' ) {
           if ( driver_name eq 'Pg' ) {
-            if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+            my $type = $dbdef->table($table)->column($column)->type;
+            if ( $type =~ /(int|serial)/i ) {
               qq-( $column IS NOT NULL )-;
             } else {
               qq-( $column IS NOT NULL AND $column != '' )-;
@@ -309,7 +325,7 @@ sub qsearch {
     grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
   ) {
     if ( $record->{$field} =~ /^\d+(\.\d+)?$/
-         && $dbdef->table($table)->column($field)->type =~ /(int)/i
+         && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
     ) {
       $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
     } else {
@@ -323,10 +339,15 @@ sub qsearch {
 
   $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
 
+  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+    @virtual_fields = "FS::$table"->virtual_fields;
+  } else {
+    cluck "warning: FS::$table not loaded; virtual fields not returned either";
+    @virtual_fields = ();
+  }
+
   my %result;
   tie %result, "Tie::IxHash";
-  @virtual_fields = "FS::$table"->virtual_fields;
-
   my @stuff = @{ $sth->fetchall_arrayref( {} ) };
   if($pkey) {
     %result = map { $_->{$pkey}, $_ } @stuff;
@@ -335,6 +356,7 @@ sub qsearch {
   }
 
   $sth->finish;
+
   if ( keys(%result) and @virtual_fields ) {
     $statement =
       "SELECT virtual_field.recnum, part_virtual_field.name, ".
@@ -417,7 +439,7 @@ for a single item, or your data is corrupted.
 sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
   my $table = $_[0];
   my(@result) = qsearch(@_);
-  carp "warning: Multiple records in scalar search ($table)"
+  cluck "warning: Multiple records in scalar search ($table)"
     if scalar(@result) > 1;
   #should warn more vehemently if the search was on a primary key?
   scalar(@result) ? ($result[0]) : ();
@@ -481,6 +503,7 @@ Sets the value of the column/field/key COLUMN to VALUE.  Returns VALUE.
 
 sub set { 
   my($self,$field,$value) = @_;
+  $self->{'modified'} = 1;
   $self->{'Hash'}->{$field} = $value;
 }
 sub setfield {
@@ -535,12 +558,16 @@ To make a distinct duplicate of an FS::Record object, you can do:
 
 sub hash {
   my($self) = @_;
+  confess $self. ' -> hash: Hash attribute is undefined'
+    unless defined($self->{'Hash'});
   %{ $self->{'Hash'} }; 
 }
 
 =item hashref
 
-Returns a reference to the column/value hash.
+Returns a reference to the column/value hash.  This may be deprecated in the
+future; if there's a reason you can't just use the autoloaded or get/set
+methods, speak up.
 
 =cut
 
@@ -549,6 +576,19 @@ sub hashref {
   $self->{'Hash'};
 }
 
+=item modified
+
+Returns true if any of this object's values have been modified with set (or via
+an autoloaded method).  Doesn't yet recognize when you retreive a hashref and
+modify that.
+
+=cut
+
+sub modified {
+  my $self = shift;
+  $self->{'modified'};
+}
+
 =item insert
 
 Inserts this record to the database.  If there is an error, returns the error,
@@ -664,7 +704,7 @@ sub insert {
   if (@virtual_fields) {
     my %v_values = map { $_, $self->getfield($_) } @virtual_fields;
 
-    my $vfieldpart = vfieldpart_hashref($table);
+    my $vfieldpart = $self->vfieldpart_hashref;
 
     my $v_statement = "INSERT INTO virtual_field(recnum, vfieldpart, value) ".
                     "VALUES (?, ?, ?)";
@@ -753,7 +793,7 @@ sub delete {
   my $primary_key = $self->dbdef_table->primary_key;
   my $v_sth;
   my @del_vfields;
-  my $vfp = vfieldpart_hashref($self->table);
+  my $vfp = $self->vfieldpart_hashref;
   foreach($self->virtual_fields) {
     next if $self->getfield($_) eq '';
     unless(@del_vfields) {
@@ -804,7 +844,24 @@ returns the error, otherwise returns false.
 =cut
 
 sub replace {
-  my ( $new, $old ) = ( shift, shift );
+  my $new = shift;
+
+  my $old;
+  if ( @_ ) { 
+    $old = shift;
+  } else {
+    warn "[debug]$me replace called with no arguments; autoloading old record\n"
+     if $DEBUG;
+    my $primary_key = $new->dbdef_table->primary_key;
+    if ( $primary_key ) {
+      $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
+        or croak "can't find ". $new->table. ".$primary_key ".
+                 $new->$primary_key();
+    } else {
+      croak $new->table. " has no primary key; pass old record as argument";
+    }
+  }
+
   warn "[debug]$me $new ->replace $old\n" if $DEBUG;
 
   return "Records not in same table!" unless $new->table eq $old->table;
@@ -833,13 +890,25 @@ sub replace {
   ). ' WHERE '.
     join(' AND ',
       map {
-        $old->getfield($_) eq ''
-          #? "( $_ IS NULL OR $_ = \"\" )"
-          ? ( driver_name eq 'Pg'
-                ? "$_ IS NULL"
-                : "( $_ IS NULL OR $_ = \"\" )"
-            )
-          : "$_ = ". _quote($old->getfield($_),$old->table,$_)
+
+        if ( $old->getfield($_) eq '' ) {
+
+         #false laziness w/qsearch
+         if ( driver_name eq 'Pg' ) {
+            my $type = $old->dbdef_table->column($_)->type;
+            if ( $type =~ /(int|serial)/i ) {
+              qq-( $_ IS NULL )-;
+            } else {
+              qq-( $_ IS NULL OR $_ = '' )-;
+            }
+          } else {
+            qq-( $_ IS NULL OR $_ = "" )-;
+          }
+
+        } else {
+          "$_ = ". _quote($old->getfield($_),$old->table,$_);
+        }
+
       } ( $primary_key ? ( $primary_key ) : real_fields($old->table) )
     )
   ;
@@ -870,7 +939,7 @@ sub replace {
   my $v_rep_sth;
   my $v_del_sth;
   my (@add_vfields, @rep_vfields, @del_vfields);
-  my $vfp = vfieldpart_hashref($old->table);
+  my $vfp = $old->vfieldpart_hashref;
   foreach(grep { exists($diff{$_}) } $new->virtual_fields) {
     if($diff{$_} eq '') {
       # Delete
@@ -967,7 +1036,14 @@ sub check {
     for ($self->getfield($field)) {
       # See notes on check_block in FS::part_virtual_field.
       eval $self->pvf($field)->check_block;
-      return $@ if $@;
+      if ( $@ ) {
+        #this is bad, probably want to follow the stack backtrace up and see
+        #wtf happened
+        my $err = "Fatal error checking $field for $self";
+        cluck "$err: $@";
+        return "$err (see log for backtrace): $@";
+
+      }
       $self->setfield($field, $_);
     }
   }
@@ -1051,6 +1127,21 @@ sub ut_float {
   '';
 }
 
+=item ut_snumber COLUMN
+
+Check/untaint signed numeric data (whole numbers).  May not be null.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_snumber {
+  my($self, $field) = @_;
+  $self->getfield($field) =~ /^(-?)\s*(\d+)$/
+    or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
+  $self->setfield($field, "$1$2");
+  '';
+}
+
 =item ut_number COLUMN
 
 Check/untaint simple numeric data (whole numbers).  May not be null.  If there
@@ -1273,9 +1364,13 @@ sub ut_zip {
                 $self->getfield($field);
     $self->setfield($field,$1);
   } 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);
+    if ( $self->getfield($field) =~ /^\s*$/ ) {
+      $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);
+    }
   }
   '';
 }
@@ -1342,7 +1437,7 @@ on the column first.
 sub ut_foreign_key {
   my( $self, $field, $table, $foreign ) = @_;
   qsearchs($table, { $foreign => $self->getfield($field) })
-    or return "Can't find $field ". $self->getfield($field).
+    or return "Can't find ". $self->table. ".$field ". $self->getfield($field).
               " in $table.$foreign";
   '';
 }
@@ -1377,14 +1472,17 @@ sub virtual_fields {
 
   return () unless $self->dbdef->table('part_virtual_field');
 
-  # This should be smart enough to cache results.
+  unless ( $virtual_fields_cache{$table} ) {
+    my $query = 'SELECT name from part_virtual_field ' .
+                "WHERE dbtable = '$table'";
+    my $dbh = dbh;
+    my $result = $dbh->selectcol_arrayref($query);
+    confess $dbh->errstr if $dbh->err;
+    $virtual_fields_cache{$table} = $result;
+  }
+
+  @{$virtual_fields_cache{$table}};
 
-  my $query = 'SELECT name from part_virtual_field ' .
-              "WHERE dbtable = '$table'";
-  my $dbh = dbh;
-  my $result = $dbh->selectcol_arrayref($query);
-  confess $dbh->errstr if $dbh->err;
-  return @$result;
 }
 
 
@@ -1486,9 +1584,14 @@ sub _quote {
   my($value, $table, $column) = @_;
   my $column_obj = $dbdef->table($table)->column($column);
   my $column_type = $column_obj->type;
+  my $nullable = $column_obj->null;
+
+  warn "  $table.$column: $value ($column_type".
+       ( $nullable ? ' NULL' : ' NOT NULL' ).
+       ")\n" if $DEBUG > 2;
 
   if ( $value eq '' && $column_type =~ /^int/ ) {
-    if ( $column_obj->null ) {
+    if ( $nullable ) {
       'NULL';
     } else {
       cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
@@ -1511,9 +1614,11 @@ TABLE.
 =cut
 
 sub vfieldpart_hashref {
-  my ($table) = @_;
+  my $self = shift;
+  my $table = $self->table;
+
+  return {} unless $self->dbdef->table('part_virtual_field');
 
-  return () unless $table;
   my $dbh = dbh;
   my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
                   "dbtable = '$table'";
@@ -1614,6 +1719,8 @@ L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
 
 Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
 
+http://poop.sf.net/
+
 =cut
 
 1;