use strict;
use vars qw( @ISA $DEBUG );
+use Scalar::Util qw( blessed );
use FS::Record qw( qsearch qsearchs dbh );
@ISA = qw( FS::Record );
@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
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";
# $dbh->rollback if $oldAutoCommit;
# return $@;
#}
- my $option_record = $option_table->new($href);
+ my $option_record = "FS::$option_table"->new($href);
+
+ my @args = ();
+ push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
- $error = $option_record->insert;
+ $error = $option_record->insert(@args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
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;
}
-=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 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;
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;
+
+ $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
- $new->optionnum($old->optionnum) if $old;
- my $error = $old ? $new->replace($old) : $new->insert;
+ 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;
#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 ) {
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) } );
}
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
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