X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=9a724feac62f806592309c4bbf5b26529320ace1;hp=7d5ff0582667bd5346f7ee3649bda7d046817fc8;hb=c97973a5145438eedd9fe16841897f5c4febb995;hpb=25747983ac27c3b804a2f15312c8c7b59769e014

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 7d5ff0582..9a724feac 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -9,8 +9,8 @@ use Carp qw(carp cluck croak confess);
 use File::CounterFile;
 use Locale::Country;
 use DBI qw(:sql_types);
-use DBIx::DBSchema 0.19;
-use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
+use DBIx::DBSchema 0.21;
+use FS::UID qw(dbh getotaker datasrc driver_name);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
 
@@ -60,14 +60,12 @@ FS::Record - Database record objects
     $hashref = $record->hashref;
 
     $error = $record->insert;
-    #$error = $record->add; #deprecated
 
     $error = $record->delete;
-    #$error = $record->del; #deprecated
 
     $error = $new_record->replace($old_record);
-    #$error = $new_record->rep($old_record); #deprecated
 
+    # external use deprecated - handled by the database (at least for Pg, mysql)
     $value = $record->unique('column');
 
     $error = $record->ut_float('column');
@@ -88,7 +86,7 @@ FS::Record - Database record objects
 
     $quoted_value = _quote($value,'table','field');
 
-    #depriciated
+    #deprecated
     $fields = hfields('table');
     if ( $fields->{Field} ) { # etc.
 
@@ -132,15 +130,8 @@ sub new {
 
   my $hashref = $self->{'Hash'} = shift;
 
-  foreach my $field ( $self->fields ) { 
-    $hashref->{$field}='' unless defined $hashref->{$field};
-    #trim the '$' and ',' from money fields for Pg (belong HERE?)
-    #(what about Pg i18n?)
-    if ( driver_name =~ /^Pg$/i
-         && $self->dbdef_table->column($field)->type eq 'money' ) {
-      ${$hashref}{$field} =~ s/^\$//;
-      ${$hashref}{$field} =~ s/\,//;
-    }
+  foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { 
+    $hashref->{$field}='';
   }
 
   $self->_cache($hashref, shift) if $self->can('_cache') && @_;
@@ -174,7 +165,7 @@ sub create {
   my $self = {};
   bless ($self, $class);
   if ( defined $self->table ) {
-    cluck "create constructor is depriciated, use new!";
+    cluck "create constructor is deprecated, use new!";
     $self->new(@_);
   } else {
     croak "FS::Record::create called (not from a subclass)!";
@@ -217,40 +208,54 @@ sub qsearch {
     $statement .= ' WHERE '. join(' AND ', map {
 
       my $op = '=';
+      my $column = $_;
       if ( ref($record->{$_}) ) {
         $op = $record->{$_}{'op'} if $record->{$_}{'op'};
-        $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i;
+        #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
+        if ( uc($op) eq 'ILIKE' ) {
+          $op = 'LIKE';
+          $record->{$_}{'value'} = lc($record->{$_}{'value'});
+          $column = "LOWER($_)";
+        }
         $record->{$_} = $record->{$_}{'value'}
       }
 
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
         if ( $op eq '=' ) {
-          if ( driver_name =~ /^Pg$/i ) {
-            qq-( $_ IS NULL OR $_ = '' )-;
+          if ( driver_name eq 'Pg' ) {
+            if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+              qq-( $column IS NULL )-;
+            } else {
+              qq-( $column IS NULL OR $column = '' )-;
+            }
           } else {
-            qq-( $_ IS NULL OR $_ = "" )-;
+            qq-( $column IS NULL OR $column = "" )-;
           }
         } elsif ( $op eq '!=' ) {
-          if ( driver_name =~ /^Pg$/i ) {
-            qq-( $_ IS NOT NULL AND $_ != '' )-;
+          if ( driver_name eq 'Pg' ) {
+            if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+              qq-( $column IS NOT NULL )-;
+            } else {
+              qq-( $column IS NOT NULL AND $column != '' )-;
+            }
           } else {
-            qq-( $_ IS NOT NULL AND $_ != "" )-;
+            qq-( $column IS NOT NULL AND $column != "" )-;
           }
         } else {
-          if ( driver_name =~ /^Pg$/i ) {
-            qq-( $_ $op '' )-;
+          if ( driver_name eq 'Pg' ) {
+            qq-( $column $op '' )-;
           } else {
-            qq-( $_ $op "" )-;
+            qq-( $column $op "" )-;
           }
         }
       } else {
-        "$_ $op ?";
+        "$column $op ?";
       }
     } @fields );
   }
   $statement .= " $extra_sql" if defined($extra_sql);
 
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
@@ -333,9 +338,11 @@ for a single item, or your data is corrupted.
 =cut
 
 sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
+  my $table = $_[0];
   my(@result) = qsearch(@_);
-  carp "warning: Multiple records in scalar search!" if scalar(@result) > 1;
-    #should warn more vehemently if the search was on a primary key?
+  carp "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]) : ();
 }
 
@@ -352,7 +359,7 @@ Returns the table name.
 =cut
 
 sub table {
-#  cluck "warning: FS::Record::table depriciated; supply one in subclass!";
+#  cluck "warning: FS::Record::table deprecated; supply one in subclass!";
   my $self = shift;
   $self -> {'Table'};
 }
@@ -479,41 +486,48 @@ sub insert {
   return $error if $error;
 
   #single-field unique keys are given a value if false
-  #(like MySQL's AUTO_INCREMENT)
+  #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
   foreach ( $self->dbdef_table->unique->singles ) {
     $self->unique($_) unless $self->getfield($_);
   }
-  #and also the primary key
+
+  #and also the primary key, if the database isn't going to
   my $primary_key = $self->dbdef_table->primary_key;
-  $self->unique($primary_key) 
-    if $primary_key && ! $self->getfield($primary_key);
+  my $db_seq = 0;
+  if ( $primary_key ) {
+    my $col = $self->dbdef_table->column($primary_key);
+    
+    $db_seq =
+      uc($col->type) eq 'SERIAL'
+      || ( driver_name eq 'Pg'
+             && defined($col->default)
+             && $col->default =~ /^nextval\(/i
+         )
+      || ( driver_name eq 'mysql'
+             && defined($col->local)
+             && $col->local =~ /AUTO_INCREMENT/i
+         );
+    $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq;
+  }
 
+  my $table = $self->table;
   #false laziness w/delete
   my @fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
     $self->fields
   ;
-  my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
+  my @values = map { _quote( $self->getfield($_), $table, $_) } @fields;
   #eslaf
 
-  my $statement = "INSERT INTO ". $self->table. " ( ".
+  my $statement = "INSERT INTO $table ( ".
       join( ', ', @fields ).
     ") VALUES (".
       join( ', ', @values ).
     ")"
   ;
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
-  my $h_sth;
-  if ( defined $dbdef->table('h_'. $self->table) ) {
-    my $h_statement = $self->_h_statement('insert');
-    warn "[debug]$me $h_statement\n" if $DEBUG;
-    $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
-  } else {
-    $h_sth = '';
-  }
-
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -522,7 +536,64 @@ sub insert {
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
+
+  if ( $db_seq ) { # get inserted id from the database, if applicable
+    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 $i_sth = dbh->prepare($i_sql) or do {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return dbh->errstr;
+      };
+      $i_sth->execute($oid) or do {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return $i_sth->errstr;
+      };
+      $insertid = $i_sth->fetchrow_arrayref->[0];
+
+    } elsif ( driver_name eq 'mysql' ) {
+
+      $insertid = dbh->{'mysql_insertid'};
+      # work around mysql_insertid being null some of the time, ala RT :/
+      unless ( $insertid ) {
+        warn "WARNING: DBD::mysql didn't return mysql_insertid; ".
+             "using SELECT LAST_INSERT_ID();";
+        my $i_sql = "SELECT LAST_INSERT_ID()";
+        my $i_sth = dbh->prepare($i_sql) or do {
+          dbh->rollback if $FS::UID::AutoCommit;
+          return dbh->errstr;
+        };
+        $i_sth->execute or do {
+          dbh->rollback if $FS::UID::AutoCommit;
+          return $i_sth->errstr;
+        };
+        $insertid = $i_sth->fetchrow_arrayref->[0];
+      }
+
+    } 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 $h_sth;
+  if ( defined $dbdef->table('h_'. $table) ) {
+    my $h_statement = $self->_h_statement('insert');
+    warn "[debug]$me $h_statement\n" if $DEBUG > 2;
+    $h_sth = dbh->prepare($h_statement) or do {
+      dbh->rollback if $FS::UID::AutoCommit;
+      return dbh->errstr;
+    };
+  } else {
+    $h_sth = '';
+  }
   $h_sth->execute or return $h_sth->errstr if $h_sth;
+
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
@@ -535,7 +606,7 @@ Depriciated (use insert instead).
 =cut
 
 sub add {
-  cluck "warning: FS::Record::add depriciated!";
+  cluck "warning: FS::Record::add deprecated!";
   insert @_; #call method in this scope
 }
 
@@ -553,7 +624,7 @@ sub delete {
     map {
       $self->getfield($_) eq ''
         #? "( $_ IS NULL OR $_ = \"\" )"
-        ? ( driver_name =~ /^Pg$/i
+        ? ( driver_name eq 'Pg'
               ? "$_ IS NULL"
               : "( $_ IS NULL OR $_ = \"\" )"
           )
@@ -562,13 +633,13 @@ sub delete {
           ? ( $self->dbdef_table->primary_key)
           : $self->fields
   );
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $h_sth;
   if ( defined $dbdef->table('h_'. $self->table) ) {
     my $h_statement = $self->_h_statement('delete');
-    warn "[debug]$me $h_statement\n" if $DEBUG;
+    warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
   } else {
     $h_sth = '';
@@ -599,7 +670,7 @@ Depriciated (use delete instead).
 =cut
 
 sub del {
-  cluck "warning: FS::Record::del depriciated!";
+  cluck "warning: FS::Record::del deprecated!";
   &delete(@_); #call method in this scope
 }
 
@@ -639,7 +710,7 @@ sub replace {
       map {
         $old->getfield($_) eq ''
           #? "( $_ IS NULL OR $_ = \"\" )"
-          ? ( driver_name =~ /^Pg$/i
+          ? ( driver_name eq 'Pg'
                 ? "$_ IS NULL"
                 : "( $_ IS NULL OR $_ = \"\" )"
             )
@@ -647,13 +718,13 @@ sub replace {
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
   ;
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $h_old_sth;
   if ( defined $dbdef->table('h_'. $old->table) ) {
     my $h_old_statement = $old->_h_statement('replace_old');
-    warn "[debug]$me $h_old_statement\n" if $DEBUG;
+    warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
     $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
   } else {
     $h_old_sth = '';
@@ -662,7 +733,7 @@ sub replace {
   my $h_new_sth;
   if ( defined $dbdef->table('h_'. $new->table) ) {
     my $h_new_statement = $new->_h_statement('replace_new');
-    warn "[debug]$me $h_new_statement\n" if $DEBUG;
+    warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
     $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
   } else {
     $h_new_sth = '';
@@ -692,7 +763,7 @@ Depriciated (use replace instead).
 =cut
 
 sub rep {
-  cluck "warning: FS::Record::rep depriciated!";
+  cluck "warning: FS::Record::rep deprecated!";
   replace @_; #call method in this scope
 }
 
@@ -725,8 +796,13 @@ sub _h_statement {
 
 =item unique COLUMN
 
-Replaces COLUMN in record with a unique number.  Called by the B<add> method
-on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
+B<Warning>: External use is B<deprecated>.  
+
+Replaces COLUMN in record with a unique number, using counters in the
+filesystem.  Used by the B<insert> method on single-field unique columns
+(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys
+that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql).
+
 Returns the new value.
 
 =cut
@@ -735,8 +811,6 @@ sub unique {
   my($self,$field) = @_;
   my($table)=$self->table;
 
-  croak("&FS::UID::checkruid failed") unless &checkruid;
-
   croak "Unique called on field $field, but it is ",
         $self->getfield($field),
         ", not null!"
@@ -752,9 +826,8 @@ sub unique {
 #  my($counter) = new File::CounterFile "$user/$table.$field",0;
 # endhack
 
-  my($index)=$counter->inc;
-  $index=$counter->inc
-    while qsearchs($table,{$field=>$index}); #just in case
+  my $index = $counter->inc;
+  $index = $counter->inc while qsearchs($table, { $field=>$index } );
 
   $index =~ /^(\d*)$/;
   $index=$1;
@@ -937,7 +1010,7 @@ sub ut_ip {
   $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
     or return "Illegal (IP address) $field: ". $self->getfield($field);
   for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
-  $self->setfield($field, "$1.$2.$3.$3");
+  $self->setfield($field, "$1.$2.$3.$4");
   '';
 }
 
@@ -1130,10 +1203,15 @@ I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
-  $dbdef = exists $dbdef_cache{$file}
-    ? $dbdef_cache{$file}
-    : $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
-                              or die "can't load database schema from $file";
+
+  unless ( exists $dbdef_cache{$file} ) {
+    warn "[debug]$me loading dbdef for $file\n" if $DEBUG;
+    $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
+                            or die "can't load database schema from $file";
+  } else {
+    warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
+  }
+  $dbdef = $dbdef_cache{$file};
 }
 
 =item dbdef
@@ -1153,28 +1231,36 @@ type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
 =cut
 
 sub _quote {
-  my($value,$table,$field)=@_;
-  my($dbh)=dbh;
-  if ( $value =~ /^\d+(\.\d+)?$/ && 
-#       ! ( datatype($table,$field) =~ /^char/ ) 
-       ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i 
-  ) {
+  my($value, $table, $column) = @_;
+  my $column_obj = $dbdef->table($table)->column($column);
+  my $column_type = $column_obj->type;
+
+  if ( $value eq '' && $column_type =~ /^int/ ) {
+    if ( $column_obj->null ) {
+      'NULL';
+    } else {
+      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;
   } else {
-    $dbh->quote($value);
+    dbh->quote($value);
   }
 }
 
 =item hfields TABLE
 
-This is depriciated.  Don't use it.
+This is deprecated.  Don't use it.
 
 It returns a hash-type list with the fields of this record's table set true.
 
 =cut
 
 sub hfields {
-  carp "warning: hfields is depriciated";
+  carp "warning: hfields is deprecated";
   my($table)=@_;
   my(%hash);
   foreach (fields($table)) {
@@ -1210,7 +1296,7 @@ sub DESTROY { return; }
 This module should probably be renamed, since much of the functionality is
 of general use.  It is not completely unlike Adapter::DBI (see below).
 
-Exported qsearch and qsearchs should be depriciated in favor of method calls
+Exported qsearch and qsearchs should be deprecated in favor of method calls
 (against an FS::Record object like the old search and searchs that qsearch
 and qsearchs were on top of.)
 
@@ -1218,7 +1304,7 @@ The whole fields / hfields mess should be removed.
 
 The various WHERE clauses should be subroutined.
 
-table string should be depriciated in favor of DBIx::DBSchema::Table.
+table string should be deprecated in favor of DBIx::DBSchema::Table.
 
 No doubt we could benefit from a Tied hash.  Documenting how exists / defined
 true maps to the database (and WHERE clauses) would also help.