X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;ds=sidebyside;f=FS%2FFS%2FRecord.pm;h=020d14d8f298d8fe210e31db4198fed363047b66;hb=8f42b751aebda2e7dce2c363bed6f1e15b411b1d;hp=6c7a321e6bfea476a3a0cc1c9214c7cd61cd3c4c;hpb=45b4365687be864c68b1daa0ee7787a6a0933589;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 6c7a321e6..020d14d8f 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,12 +1,14 @@
 package FS::Record;
 
 use strict;
-use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG);
+use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+             $me );
 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.19;
 use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
 use FS::SearchCache;
@@ -15,6 +17,7 @@ use FS::SearchCache;
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
 $DEBUG = 0;
+$me = '[FS::Record]';
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = sub { 
@@ -56,13 +59,13 @@ FS::Record - Database record objects
     $hashref = $record->hashref;
 
     $error = $record->insert;
-    #$error = $record->add; #depriciated
+    #$error = $record->add; #deprecated
 
     $error = $record->delete;
-    #$error = $record->del; #depriciated
+    #$error = $record->del; #deprecated
 
     $error = $new_record->replace($old_record);
-    #$error = $new_record->rep($old_record); #depriciated
+    #$error = $new_record->rep($old_record); #deprecated
 
     $value = $record->unique('column');
 
@@ -121,7 +124,10 @@ sub new {
   my $self = {};
   bless ($self, $class);
 
-  $self->{'Table'} = shift unless defined ( $self->table );
+  unless ( defined ( $self->table ) ) {
+    $self->{'Table'} = shift;
+    carp "warning: FS::Record::new called with table name ". $self->{'Table'};
+  }
 
   my $hashref = $self->{'Hash'} = shift;
 
@@ -210,7 +216,7 @@ sub qsearch {
     $statement .= ' WHERE '. join(' AND ', map {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
         if ( driver_name =~ /^Pg$/i ) {
-          "$_ IS NULL";
+          qq-( $_ IS NULL OR $_ = '' )-;
         } else {
           qq-( $_ IS NULL OR $_ = "" )-;
         }
@@ -221,13 +227,30 @@ sub qsearch {
   }
   $statement .= " $extra_sql" if defined($extra_sql);
 
-  warn $statement if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
-  $sth->execute( map $record->{$_},
+  my $bind = 1;
+
+  foreach my $field (
     grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
-  ) or croak "Error executing \"$statement\": ". $dbh->errstr;
+  ) {
+    if ( $record->{$field} =~ /^\d+(\.\d+)?$/
+         && $dbdef->table($table)->column($field)->type =~ /(int)/i
+    ) {
+      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
+    } else {
+      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
+    }
+  }
+
+#  $sth->execute( map $record->{$_},
+#    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+#  ) or croak "Error executing \"$statement\": ". $sth->errstr;
+
+  $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
+
   $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
 
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
@@ -257,13 +280,15 @@ sub qsearch {
 
 }
 
-=item jsearch
+=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
 
 Experimental JOINed search method.  Using this method, you can execute a
 single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
+Arguments: 
+
 =cut
 
 sub jsearch {
@@ -451,6 +476,7 @@ sub insert {
       join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
     ")"
   ;
+  warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
@@ -500,6 +526,7 @@ sub delete {
           ? ( $self->dbdef_table->primary_key)
           : $self->fields
   );
+  warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
@@ -538,11 +565,11 @@ returns the error, otherwise returns false.
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );
-  warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG;
+  warn "[debug]$me $new ->replace $old\n" if $DEBUG;
 
   my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
   unless ( @diff ) {
-    carp "[warning][FS::Record] $new -> replace $old: records identical";
+    carp "[warning]$me $new -> replace $old: records identical";
     return '';
   }
 
@@ -573,6 +600,7 @@ sub replace {
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
   ;
+  warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
@@ -946,6 +974,34 @@ sub ut_enum {
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 
+=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Check/untaint a foreign column key.  Call a regular ut_ method (like ut_number)
+on the column first.
+
+=cut
+
+sub ut_foreign_key {
+  my( $self, $field, $table, $foreign ) = @_;
+  qsearchs($table, { $foreign => $self->getfield($field) })
+    or return "Can't find $field ". $self->getfield($field).
+              " in $table.$foreign";
+  '';
+}
+
+=item ut_foreign_keyn COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Like ut_foreign_key, except the null value is also allowed.
+
+=cut
+
+sub ut_foreign_keyn {
+  my( $self, $field, $table, $foreign ) = @_;
+  $self->getfield($field)
+    ? $self->ut_foreign_key($field, $table, $foreign)
+    : '';
+}
+
 =item fields [ TABLE ]
 
 This can be used as both a subroutine and a method call.  It returns a list
@@ -986,7 +1042,8 @@ I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
-  $dbdef = load DBIx::DBSchema $file;
+  $dbdef = load DBIx::DBSchema $file
+    or die "can't load database schema from $file";
 }
 
 =item dbdef