delete payments

[freeside.git] / FS / FS / Record.pm

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 6c7a321..755cef8 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,12 +1,14 @@
 package FS::Record;
 
 use strict;
 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 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;
 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;
 @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 { 
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = sub { 


@@ -121,7 +124,10 @@ sub new {
   my $self = {};
   bless ($self, $class);
 
   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;
 
 
   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 ) {
     $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 $_ = "" )-;
         }
         } else {
           qq-( $_ IS NULL OR $_ = "" )-;
         }


@@ -221,13 +227,30 @@ sub qsearch {
   }
   $statement .= " $extra_sql" if defined($extra_sql);
 
   }
   $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";
 
   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
     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);' ) {
   $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.
 
 
 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 {
 =cut
 
 sub jsearch {


@@ -451,6 +476,7 @@ sub insert {
       join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
     ")"
   ;
       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';
   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
   );
           ? ( $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';
   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 );
 
 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 ) {
 
   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 '';
   }
 
     return '';
   }
 


@@ -573,6 +600,7 @@ sub replace {
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
   ;
       } ( $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';
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';


@@ -986,7 +1014,8 @@ I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
 
 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
 }
 
 =item dbdef