patch from rjbs to add by_key contructor to Record.pm

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

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index e2efd17..f806e4f 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -2,14 +2,14 @@ package FS::Record;
 
 use strict;
 use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $me %dbdef_cache %virtual_fields_cache );
+             $me %dbdef_cache %virtual_fields_cache $nowarn_identical );
 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.23;
+use DBIx::DBSchema 0.25;
 use FS::UID qw(dbh getotaker datasrc driver_name);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
@@ -25,6 +25,8 @@ use Tie::IxHash;
 $DEBUG = 0;
 $me = '[FS::Record]';
 
+$nowarn_identical = 0;
+
 my $conf;
 my $rsa_module;
 my $rsa_loaded;
@@ -33,6 +35,7 @@ my $rsa_decrypt;
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = 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?
@@ -424,6 +427,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
@@ -882,8 +913,6 @@ sub replace {
   my $new = shift;
   my $old = shift;  
 
-  my $saved = {};
-
   if (!defined($old)) { 
     warn "[debug]$me replace called with no arguments; autoloading old record\n"
      if $DEBUG;
@@ -902,7 +931,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) );
 
@@ -910,6 +941,7 @@ sub replace {
   return $error if $error;
   
   # Encrypt for replace
+  my $saved = {};
   if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . 'encrypted_fields')) {
     foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
       $saved->{$field} = $new->getfield($field);
@@ -922,7 +954,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 '';
   }
 
@@ -1100,7 +1133,9 @@ sub check {
 }
 
 sub _h_statement {
-  my( $self, $action ) = @_;
+  my( $self, $action, $time ) = @_;
+
+  $time ||= time;
 
   my @fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
@@ -1111,7 +1146,7 @@ sub _h_statement {
   "INSERT INTO h_". $self->table. " ( ".
       join(', ', qw(history_date history_user history_action), @fields ).
     ") VALUES (".
-      join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values).
+      join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
     ")"
   ;
 }
@@ -1707,13 +1742,21 @@ sub _dump {
 sub encrypt {
   my ($self, $value) = @_;
   my $encrypted;
-  if ($conf->exists('encryption') && !$self->is_encrypted($value)) {
-    $self->loadRSA;
-    if (ref($rsa_encrypt) =~ /::RSA/) { # We Can Encrypt
-      # RSA doesn't like the empty string so let's pack it up
-      # The database doesn't like the RSA data so uuencode it
-      my $length = length($value)+1;
-      $encrypted = pack("u*",$rsa_encrypt->encrypt(pack("Z$length",$value)));
+
+  if ($conf->exists('encryption')) {
+    if ($self->is_encrypted($value)) {
+      # Return the original value if it isn't plaintext.
+      $encrypted = $value;
+    } else {
+      $self->loadRSA;
+      if (ref($rsa_encrypt) =~ /::RSA/) { # We Can Encrypt
+        # RSA doesn't like the empty string so let's pack it up
+        # The database doesn't like the RSA data so uuencode it
+        my $length = length($value)+1;
+        $encrypted = pack("u*",$rsa_encrypt->encrypt(pack("Z$length",$value)));
+      } else {
+        die ("You can't encrypt w/o a valid RSA engine - Check your installation or disable encryption");
+      }
     }
   }
   return $encrypted;
@@ -1744,13 +1787,14 @@ sub decrypt {
 }
 
 sub loadRSA {
-    my $self = shift;;
+    my $self = shift;
     #Initialize the Module
-    if (!$conf->exists('encryptionmodule')) {
-       carp "warning: There is no Encryption Module Defined!";
-       return;
+    $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
+
+    if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
+      $rsa_module = $conf->config('encryptionmodule');
     }
-    $rsa_module = $conf->config('encryptionmodule');
+
     if (!$rsa_loaded) {
        eval ("require $rsa_module"); # No need to import the namespace
        $rsa_loaded++;