X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=d843658044df8b9db26b76453f6234408c54bd3b;hp=5dbcd4d4b04b8af14965be5f0ff0692333987aaa;hb=0186436eb38e70da0a015e49dab67cec5f1a3467;hpb=d18a2abec5a0323c26fbc5704fb1a2675eaea352

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 5dbcd4d4b..d84365804 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,9 +1,8 @@
 package FS::Record;
 
 use strict;
-use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $me %dbdef_cache %virtual_fields_cache );
-use subs qw(reload_dbdef);
+use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+             $me %virtual_fields_cache $nowarn_identical );
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
@@ -11,6 +10,7 @@ use Locale::Country;
 use DBI qw(:sql_types);
 use DBIx::DBSchema 0.25;
 use FS::UID qw(dbh getotaker datasrc driver_name);
+use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
 use FS::Conf;
@@ -20,24 +20,25 @@ use FS::part_virtual_field;
 use Tie::IxHash;
 
 @ISA = qw(Exporter);
+
+#export dbdef for now... everything else expects to find it here
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
 $DEBUG = 0;
 $me = '[FS::Record]';
 
+$nowarn_identical = 0;
+
 my $conf;
 my $rsa_module;
 my $rsa_loaded;
 my $rsa_encrypt;
 my $rsa_decrypt;
 
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::Record'} = sub { 
+FS::UID->install_callback( sub {
   $conf = new FS::Conf; 
   $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
-  $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
-  &reload_dbdef unless $setup_hack; #$setup_hack needed now?
-};
+} );
 
 =head1 NAME
 
@@ -46,7 +47,7 @@ FS::Record - Database record objects
 =head1 SYNOPSIS
 
     use FS::Record;
-    use FS::Record qw(dbh fields qsearch qsearchs dbdef);
+    use FS::Record qw(dbh fields qsearch qsearchs);
 
     $record = new FS::Record 'table', \%hash;
     $record = new FS::Record 'table', { 'column' => 'value', ... };
@@ -92,10 +93,6 @@ FS::Record - Database record objects
     $error = $record->ut_anything('column');
     $error = $record->ut_name('column');
 
-    $dbdef = reload_dbdef;
-    $dbdef = reload_dbdef "/non/standard/filename";
-    $dbdef = dbdef;
-
     $quoted_value = _quote($value,'table','field');
 
     #deprecated
@@ -188,13 +185,36 @@ sub create {
   }
 }
 
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
+=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
 
 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.
 
+The preferred usage is to pass a hash reference of named parameters:
+
+  my @records = qsearch( {
+                           'table'     => 'table_name',
+                           'hashref'   => { 'field' => 'value'
+                                            'field' => { 'op'    => '<',
+                                                         'value' => '420',
+                                                       },
+                                          },
+
+                           #these are optional...
+                           'select'    => '*',
+                           'extra_sql' => 'AND field ',
+                           #'cache_obj' => '', #optional
+                           'addl_from' => 'LEFT JOIN othtable USING ( field )',
+                         }
+                       );
+
+Much code still uses old-style positional parameters, this is also probably
+fine in the common case where there are only two parameters:
+
+  my @records = qsearch( 'table', { 'field' => 'value' } );
+
 ###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
@@ -207,16 +227,28 @@ objects.
 =cut
 
 sub qsearch {
-  my($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+  my($stable, $record, $select, $extra_sql, $cache, $addl_from );
+  if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
+    my $opt = shift;
+    $stable    = $opt->{'table'}     or die "table name is required";
+    $record    = $opt->{'hashref'}   || {};
+    $select    = $opt->{'select'}    || '*';
+    $extra_sql = $opt->{'extra_sql'} || '';
+    $cache     = $opt->{'cache_obj'} || '';
+    $addl_from = $opt->{'addl_from'} || '';
+  } else {
+    ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+    $select ||= '*';
+  }
+
   #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
   #for jsearch
   $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
   $stable = $1;
-  $select ||= '*';
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
-  my $dbdef_table = $dbdef->table($table)
+  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;
@@ -252,7 +284,7 @@ sub qsearch {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
         if ( $op eq '=' ) {
           if ( driver_name eq 'Pg' ) {
-            my $type = $dbdef->table($table)->column($column)->type;
+            my $type = dbdef->table($table)->column($column)->type;
             if ( $type =~ /(int|serial)/i ) {
               qq-( $column IS NULL )-;
             } else {
@@ -263,7 +295,7 @@ sub qsearch {
           }
         } elsif ( $op eq '!=' ) {
           if ( driver_name eq 'Pg' ) {
-            my $type = $dbdef->table($table)->column($column)->type;
+            my $type = dbdef->table($table)->column($column)->type;
             if ( $type =~ /(int|serial)/i ) {
               qq-( $column IS NOT NULL )-;
             } else {
@@ -333,7 +365,7 @@ sub qsearch {
     grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
   ) {
     if ( $record->{$field} =~ /^\d+(\.\d+)?$/
-         && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
+         && dbdef->table($table)->column($field)->type =~ /(int|serial)/i
     ) {
       $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
     } else {
@@ -425,6 +457,34 @@ sub qsearch {
   return @return;
 }
 
+=item by_key PRIMARY_KEY_VALUE
+
+This is a class method that returns the record with the given primary key
+value.  This method is only useful in FS::Record subclasses.  For example:
+
+  my $cust_main = FS::cust_main->by_key(1); # retrieve customer with custnum 1
+
+is equivalent to:
+
+  my $cust_main = qsearchs('cust_main', { 'custnum' => 1 } );
+
+=cut
+
+sub by_key {
+  my ($class, $pkey_value) = @_;
+
+  my $table = $class->table
+    or croak "No table for $class found";
+
+  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
+    or die "No primary key for table $table";
+
+  return qsearchs($table, { $pkey => $pkey_value });
+}
+
 =item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
 
 Experimental JOINed search method.  Using this method, you can execute a
@@ -446,7 +506,7 @@ sub jsearch {
   );
 }
 
-=item qsearchs TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
+=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
 
 Same as qsearch, except that if more than one record matches, it B<carp>s but
 returns the first.  If this happens, you either made a logic error in asking
@@ -490,7 +550,7 @@ Returns the DBIx::DBSchema::Table object for the table.
 sub dbdef_table {
   my($self)=@_;
   my($table)=$self->table;
-  $dbdef->table($table);
+  dbdef->table($table);
 }
 
 =item get, getfield COLUMN
@@ -757,7 +817,7 @@ sub insert {
 
 
   my $h_sth;
-  if ( defined $dbdef->table('h_'. $table) ) {
+  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 {
@@ -818,7 +878,7 @@ sub delete {
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $h_sth;
-  if ( defined $dbdef->table('h_'. $self->table) ) {
+  if ( defined dbdef->table('h_'. $self->table) ) {
     my $h_statement = $self->_h_statement('delete');
     warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
@@ -901,7 +961,9 @@ sub replace {
   return "Records not in same table!" unless $new->table eq $old->table;
 
   my $primary_key = $old->dbdef_table->primary_key;
-  return "Can't change $primary_key"
+  return "Can't change primary key $primary_key ".
+         'from '. $old->getfield($primary_key).
+         ' to ' . $new->getfield($primary_key)
     if $primary_key
        && ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
 
@@ -922,7 +984,8 @@ sub replace {
                    ? ($_, $new->getfield($_)) : () } $old->fields;
                    
   unless ( keys(%diff) ) {
-    carp "[warning]$me $new -> replace $old: records identical";
+    carp "[warning]$me $new -> replace $old: records identical"
+      unless $nowarn_identical;
     return '';
   }
 
@@ -959,7 +1022,7 @@ sub replace {
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $h_old_sth;
-  if ( defined $dbdef->table('h_'. $old->table) ) {
+  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 > 2;
     $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
@@ -968,7 +1031,7 @@ sub replace {
   }
 
   my $h_new_sth;
-  if ( defined $dbdef->table('h_'. $new->table) ) {
+  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 > 2;
     $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
@@ -1519,9 +1582,9 @@ sub virtual_fields {
   my $table;
   $table = $self->table or confess "virtual_fields called on non-table";
 
-  confess "Unknown table $table" unless $dbdef->table($table);
+  confess "Unknown table $table" unless dbdef->table($table);
 
-  return () unless $self->dbdef->table('part_virtual_field');
+  return () unless dbdef->table('part_virtual_field');
 
   unless ( $virtual_fields_cache{$table} ) {
     my $query = 'SELECT name from part_virtual_field ' .
@@ -1589,40 +1652,11 @@ fields() and other subroutines elsewhere in FS::Record.
 sub real_fields {
   my $table = shift;
 
-  my($table_obj) = $dbdef->table($table);
+  my($table_obj) = dbdef->table($table);
   confess "Unknown table $table" unless $table_obj;
   $table_obj->columns;
 }
 
-=item reload_dbdef([FILENAME])
-
-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;
-
-  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
-
-Returns the current database definition.  See L<DBIx::DBSchema>.
-
-=cut
-
-sub dbdef { $dbdef; }
-
 =item _quote VALUE, TABLE, COLUMN
 
 This is an internal function used to construct SQL statements.  It returns
@@ -1633,7 +1667,7 @@ type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
 
 sub _quote {
   my($value, $table, $column) = @_;
-  my $column_obj = $dbdef->table($table)->column($column);
+  my $column_obj = dbdef->table($table)->column($column);
   my $column_type = $column_obj->type;
   my $nullable = $column_obj->null;
 
@@ -1668,7 +1702,7 @@ sub vfieldpart_hashref {
   my $self = shift;
   my $table = $self->table;
 
-  return {} unless $self->dbdef->table('part_virtual_field');
+  return {} unless dbdef->table('part_virtual_field');
 
   my $dbh = dbh;
   my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".