X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Foption_Common.pm;h=968dcdf798ea68901db5906b37fa4f01d6d10518;hp=c57e55b6168a3af5159d666f1681b77fdba1d5db;hb=5b73387992a96f7b80e40b5ecb2fedabd8a78d6b;hpb=feef0e4c2b4bd6b776b25f5a1bd6fdbf63fd08b2

diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm
index c57e55b61..968dcdf79 100644
--- a/FS/FS/option_Common.pm
+++ b/FS/FS/option_Common.pm
@@ -1,11 +1,11 @@
 package FS::option_Common;
 
 use strict;
-use vars qw( @ISA $DEBUG );
+use base qw( FS::Record );
+use vars qw( $DEBUG );
+use Scalar::Util qw( blessed );
 use FS::Record qw( qsearch qsearchs dbh );
 
-@ISA = qw( FS::Record );
-
 $DEBUG = 0;
 
 =head1 NAME
@@ -18,6 +18,11 @@ use FS::option_Common;
 
 @ISA = qw( FS::option_Common );
 
+#optional for non-standard names
+sub _option_table    { 'table_name'; }  #defaults to ${table}_option
+sub _option_namecol  { 'column_name'; } #defaults to optionname
+sub _option_valuecol { 'column_name'; } #defaults to optionvalue
+
 =head1 DESCRIPTION
 
 FS::option_Common is intended as a base class for classes which have a
@@ -66,14 +71,20 @@ sub insert {
     return $error;
   }
 
-  my $pkey = $self->pkey;
+  my $pkey = $self->primary_key;
   my $option_table = $self->option_table;
 
+  my $namecol = $self->_option_namecol;
+  my $valuecol = $self->_option_valuecol;
+
   foreach my $optionname ( keys %{$options} ) {
+
+    my $optionvalue = $options->{$optionname};
+
     my $href = {
-      $pkey         => $self->get($pkey),
-      'optionname'  => $optionname,
-      'optionvalue' => $options->{$optionname},
+      $pkey     => $self->get($pkey),
+      $namecol  => $optionname,
+      $valuecol => ( ref($optionvalue) || $optionvalue ),
     };
 
     #my $option_record = eval "new FS::$option_table \$href";
@@ -81,13 +92,17 @@ sub insert {
     #  $dbh->rollback if $oldAutoCommit;
     #  return $@;
     #}
-    my $option_record = $option_table->new($href);
+    my $option_record = "FS::$option_table"->new($href);
 
-    $error = $option_record->insert;
+    my @args = ();
+    push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
+
+    $error = $option_record->insert(@args);
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
     }
+
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -123,8 +138,8 @@ sub delete {
     return $error;
   }
   
-  my $pkey = $self->pkey;
-  my $option_table = $self->option_table;
+  my $pkey = $self->primary_key;
+  #my $option_table = $self->option_table;
 
   foreach my $obj ( $self->option_objects ) {
     my $error = $obj->delete;
@@ -140,24 +155,34 @@ sub delete {
 
 }
 
-=item replace [ HASHREF | OPTION => VALUE ... ]
+=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
-If a list hash reference of options is supplied, part_export_option records are
-created or modified (see L<FS::part_export_option>).
+If a list or hash reference of options is supplied, option records are created
+or modified.
 
 =cut
 
 sub replace {
   my $self = shift;
-  my $old = shift;
-  my $options = 
-    ( ref($_[0]) eq 'HASH' )
-      ? shift
-      : { @_ };
-  warn "FS::option_Common::insert called on $self with options ".
+
+  my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+              ? shift
+              : $self->replace_old;
+
+  my $options;
+  my $options_supplied = 0;
+  if ( ref($_[0]) eq 'HASH' ) {
+    $options = shift;
+    $options_supplied = 1;
+  } else {
+    $options = { @_ };
+    $options_supplied = scalar(@_) ? 1 : 0;
+  }
+
+  warn "FS::option_Common::replace called on $self with options ".
        join(', ', map "$_ => ". $options->{$_}, keys %$options)
     if $DEBUG;
 
@@ -178,30 +203,52 @@ sub replace {
     return $error;
   }
 
-  my $pkey = $self->pkey;
+  my $pkey = $self->primary_key;
   my $option_table = $self->option_table;
 
+  my $namecol = $self->_option_namecol;
+  my $valuecol = $self->_option_valuecol;
+
   foreach my $optionname ( keys %{$options} ) {
-    my $old = qsearchs( $option_table, {
-        $pkey         => $self->get($pkey),
-        'optionname'  => $optionname,
+
+    warn "FS::option_Common::replace: inserting or replacing option: $optionname"
+      if $DEBUG > 1;
+
+    my $oldopt = qsearchs( $option_table, {
+        $pkey    => $self->get($pkey),
+        $namecol => $optionname,
     } );
 
+    my $optionvalue = $options->{$optionname};
+
+    my %oldhash = $oldopt ? $oldopt->hash : ();
+
     my $href = {
-        $pkey         => $self->get($pkey),
-        'optionname'  => $optionname,
-        'optionvalue' => $options->{$optionname},
+        %oldhash,
+        $pkey     => $self->get($pkey),
+        $namecol  => $optionname,
+        $valuecol => ( ref($optionvalue) || $optionvalue ),
     };
 
-    #my $new = eval "new FS::$option_table \$href";
+    #my $newopt = eval "new FS::$option_table \$href";
     #if ( $@ ) {
     #  $dbh->rollback if $oldAutoCommit;
     #  return $@;
     #}
-    my $new = $option_table->new($href);
+    my $newopt = "FS::$option_table"->new($href);
+
+    my $opt_pkey = $newopt->primary_key;
 
-    $new->optionnum($old->optionnum) if $old;
-    my $error = $old ? $new->replace($old) : $new->insert;
+    $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
+
+    my @args = ();
+    push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
+
+    warn "FS::option_Common::replace: ".
+         ( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
+      if $DEBUG > 2;
+    my $error = $oldopt ? $newopt->replace($oldopt, @args)
+                        : $newopt->insert( @args);
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
@@ -209,13 +256,15 @@ sub replace {
   }
 
   #remove extraneous old options
-  foreach my $opt (
-    grep { !exists $options->{$_->optionname} } $old->option_objects
-  ) {
-    my $error = $opt->delete;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
+  if ( $options_supplied ) {
+    foreach my $opt (
+      grep { !exists $options->{$_->$namecol()} } $old->option_objects
+    ) {
+      my $error = $opt->delete;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
     }
   }
 
@@ -233,7 +282,7 @@ Returns all options as FS::I<tablename>_option objects.
 
 sub option_objects {
   my $self = shift;
-  my $pkey = $self->pkey;
+  my $pkey = $self->primary_key;
   my $option_table = $self->option_table;
   qsearch($option_table, { $pkey => $self->get($pkey) } );
 }
@@ -246,7 +295,9 @@ Returns a list of option names and values suitable for assigning to a hash.
 
 sub options {
   my $self = shift;
-  map { $_->optionname => $_->optionvalue } $self->option_objects;
+  my $namecol = $self->_option_namecol;
+  my $valuecol = $self->_option_valuecol;
+  map { $_->$namecol() => $_->$valuecol() } $self->option_objects;
 }
 
 =item option OPTIONNAME
@@ -257,30 +308,48 @@ Returns the option value for the given name, or the empty string.
 
 sub option {
   my $self = shift;
-  my $pkey = $self->pkey;
+  my $pkey = $self->primary_key;
   my $option_table = $self->option_table;
-  my $obj =
-    qsearchs($option_table, {
-      $pkey      => $self->get($pkey),
-      optionname => shift,
-  } );
-  $obj ? $obj->optionvalue : '';
+  my $namecol = $self->_option_namecol;
+  my $valuecol = $self->_option_valuecol;
+  my $hashref = {
+      $pkey    => $self->get($pkey),
+      $namecol => shift,
+  };
+  warn "$self -> option: searching for ".
+         join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref )
+    if $DEBUG;
+  my $obj = qsearchs($option_table, $hashref);
+  $obj ? $obj->$valuecol() : '';
 }
 
+=item option_cacheable OPTIONNAME
 
-sub pkey {
-  my $self = shift;
-  my $pkey = $self->dbdef_table->primary_key;
+Same as the option method, but may cache and return a cached value.
+Good for use within loops; otherwise, probably avoid.
+
+=cut
+
+sub option_cacheable {
+  my( $self, $name ) = @_;
+  return $self->{option_cache}{$name} if exists $self->{option_cache}{$name};
+  $self->{option_cache}{$name} = $self->option($name,1);
 }
 
+
 sub option_table {
   my $self = shift;
-  my $option_table = $self->table . '_option';
+  my $option_table = $self->_option_table;
   eval "use FS::$option_table";
   die $@ if $@;
   $option_table;
 }
 
+#defaults
+sub _option_table    { shift->table .'_option'; }
+sub _option_namecol  { 'optionname'; }
+sub _option_valuecol { 'optionvalue'; }
+
 =back
 
 =head1 BUGS