X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=113e1a18df73519212cb1cb801dc46d80101249d;hb=1c14b1faec0f3f07a6d4190cf535b3ddb45075ce;hp=59472c898be12b76274372a207af0e70a39a556e;hpb=7f07089722bfcabe3bf42619bb2bdb81fd8d44e1;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 59472c898..113e1a18d 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -6,8 +6,8 @@ use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
+use DBIx::DBSchema;
 use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name);
-use FS::dbdef;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
@@ -126,7 +126,7 @@ sub new {
     $hashref->{$field}='' unless defined $hashref->{$field};
     #trim the '$' and ',' from money fields for Pg (belong HERE?)
     #(what about Pg i18n?)
-    if ( driver_name eq 'Pg' 
+    if ( driver_name =~ /^Pg$/i
          && $self->dbdef_table->column($field)->type eq 'money' ) {
       ${$hashref}{$field} =~ s/^\$//;
       ${$hashref}{$field} =~ s/\,//;
@@ -149,26 +149,36 @@ sub create {
   }
 }
 
-=item qsearch TABLE, HASHREF
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL
 
 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.
 
+###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
+#feature where you can specify SELECT - remember, the objects returned,
+#although blessed into the appropriate `FS::TABLE' package, will only have the
+#fields you specify.  This might have unwanted results if you then go calling
+#regular FS::TABLE methods
+#on it.
+
 =cut
 
 sub qsearch {
-  my($table, $record) = @_;
+  my($table, $record, $select, $extra_sql ) = @_;
+  $select ||= '*';
   my $dbh = dbh;
 
   my @fields = grep exists($record->{$_}), fields($table);
 
-  my $statement = "SELECT * FROM $table";
+  my $statement = "SELECT $select FROM $table";
   if ( @fields ) {
-    $statement .= " WHERE ". join(' AND ', map {
+    $statement .= ' WHERE '. join(' AND ', map {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
-        if ( driver_name eq 'Pg' ) {
+        if ( driver_name =~ /^Pg$/i ) {
           "$_ IS NULL";
         } else {
           qq-( $_ IS NULL OR $_ = "" )-;
@@ -178,13 +188,16 @@ sub qsearch {
       }
     } @fields );
   }
+  $statement .= " $extra_sql" if defined($extra_sql);
 
   warn $statement if $DEBUG;
-  my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr;
+  my $sth = $dbh->prepare($statement)
+    or croak "$dbh->errstr doing $statement";
 
   $sth->execute( map $record->{$_},
     grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
   ) or croak $dbh->errstr;
+  $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
 
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
     if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
@@ -376,6 +389,7 @@ sub insert {
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
+  dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
 }
@@ -405,7 +419,7 @@ sub delete {
     map {
       $self->getfield($_) eq ''
         #? "( $_ IS NULL OR $_ = \"\" )"
-        ? ( driver_name eq 'Pg' 
+        ? ( driver_name =~ /^Pg$/i
               ? "$_ IS NULL"
               : "( $_ IS NULL OR $_ = \"\" )"
           )
@@ -425,6 +439,7 @@ sub delete {
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
+  dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   undef $self; #no need to keep object!
 
@@ -477,7 +492,7 @@ sub replace {
       map {
         $old->getfield($_) eq ''
           #? "( $_ IS NULL OR $_ = \"\" )"
-          ? ( driver_name eq 'Pg' 
+          ? ( driver_name =~ /^Pg$/i
                 ? "$_ IS NULL"
                 : "( $_ IS NULL OR $_ = \"\" )"
             )
@@ -496,6 +511,7 @@ sub replace {
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
+  dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
 
@@ -525,7 +541,7 @@ sub check {
 =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<FS::dbdef_table>).
+on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
 Returns the new value.
 
 =cut
@@ -789,7 +805,7 @@ sub ut_anything {
 
 This can be used as both a subroutine and a method call.  It returns a list
 of the columns in this record's table, or an explicitly specified table.
-(See L<FS::dbdef_table>).
+(See L<DBIx::DBSchema::Table>).
 
 =cut
 
@@ -815,15 +831,15 @@ sub fields {
 
 =item reload_dbdef([FILENAME])
 
-Load a database definition (see L<FS::dbdef>), optionally from a non-default
-filename.  This command is executed at startup unless
-I<$FS::Record::setup_hack> is true.  Returns a FS::dbdef object.
+Load a database definition (see L<DBIx::DBSchema>), optionally from a
+non-default filename.  This command is executed at startup unless
+I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 =cut
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
-  $dbdef = load FS::dbdef ($file);
+  $dbdef = load DBIx::DBSchema $file;
 }
 
 =item dbdef
@@ -880,6 +896,8 @@ sub hfields {
 #  } (fields($self->table)) );
 #}
 
+sub DESTROY { return; }
+
 #sub DESTROY {
 #  my $self = shift;
 #  #use Carp qw(cluck);
@@ -895,7 +913,7 @@ sub hfields {
 
 =head1 VERSION
 
-$Id: Record.pm,v 1.9 2000-11-07 15:00:37 ivan Exp $
+$Id: Record.pm,v 1.14 2001-04-15 12:56:30 ivan Exp $
 
 =head1 BUGS
 
@@ -940,7 +958,7 @@ be fixed.  (only affects RDBMS which return uppercase column names)
 
 =head1 SEE ALSO
 
-L<FS::dbdef>, L<FS::UID>, L<DBI>
+L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
 
 Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.