X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Foption_Common.pm;h=a786ae3fa07889039a4d2eaec8a70bbc27346275;hp=ad3c269587bd3afaa656ece05f3ac1e922c9815c;hb=20f38e4c256094bd938b732950e8f93319f851a5;hpb=c8cccb4a92adceb943c635fe62dad0d034462ce0

diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm
index ad3c26958..a786ae3fa 100644
--- a/FS/FS/option_Common.pm
+++ b/FS/FS/option_Common.pm
@@ -2,6 +2,7 @@ package FS::option_Common;
 
 use strict;
 use vars qw( @ISA $DEBUG );
+use Scalar::Util qw( blessed );
 use FS::Record qw( qsearch qsearchs dbh );
 
 @ISA = qw( FS::Record );
@@ -18,6 +19,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 +72,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";
@@ -83,11 +95,15 @@ sub insert {
     #}
     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,7 +139,7 @@ sub delete {
     return $error;
   }
   
-  my $pkey = $self->pkey;
+  my $pkey = $self->primary_key;
   #my $option_table = $self->option_table;
 
   foreach my $obj ( $self->option_objects ) {
@@ -140,24 +156,29 @@ sub delete {
 
 }
 
-=item replace OLD_RECORD [ 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 $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+              ? shift
+              : $self->replace_old;
+
   my $options = 
     ( ref($_[0]) eq 'HASH' )
       ? shift
       : { @_ };
-  warn "FS::option_Common::insert called on $self with options ".
+
+  warn "FS::option_Common::replace called on $self with options ".
        join(', ', map "$_ => ". $options->{$_}, keys %$options)
     if $DEBUG;
 
@@ -178,30 +199,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 = "FS::$option_table"->new($href);
+    my $newopt = "FS::$option_table"->new($href);
+
+    my $opt_pkey = $newopt->primary_key;
+
+    $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
+
+    my @args = ();
+    push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
 
-    $new->optionnum($old->optionnum) if $old;
-    my $error = $old ? $new->replace($old) : $new->insert;
+    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;
@@ -210,7 +253,7 @@ sub replace {
 
   #remove extraneous old options
   foreach my $opt (
-    grep { !exists $options->{$_->optionname} } $old->option_objects
+    grep { !exists $options->{$_->$namecol()} } $old->option_objects
   ) {
     my $error = $opt->delete;
     if ( $error ) {
@@ -233,7 +276,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 +289,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 +302,35 @@ 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() : '';
 }
 
 
-sub pkey {
-  my $self = shift;
-  my $pkey = $self->dbdef_table->primary_key;
-}
-
 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