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
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->SUPER::insert;
+ my $error;
+
+ $error = $self->check_options($options)
+ || $self->SUPER::insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
my $valuecol = $self->_option_valuecol;
foreach my $optionname ( keys %{$options} ) {
+
+ my $optionvalue = $options->{$optionname};
+
my $href = {
$pkey => $self->get($pkey),
$namecol => $optionname,
- $valuecol => $options->{$optionname},
+ $valuecol => ( ref($optionvalue) || $optionvalue ),
};
#my $option_record = eval "new FS::$option_table \$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;
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
-
- my $error = $self->SUPER::delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
+
my $pkey = $self->primary_key;
#my $option_table = $self->option_table;
}
}
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
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 = ( ref($_[0]) eq ref($self) )
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
? shift
: $self->replace_old;
- my $options =
- ( ref($_[0]) eq 'HASH' )
- ? shift
- : { @_ };
+ 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;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->SUPER::replace($old);
+ my $error;
+
+ if ($options_supplied) {
+ $error = $self->check_options($options);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $error = $self->SUPER::replace($old);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
$namecol => $optionname,
} );
+ my $optionvalue = $options->{$optionname};
+
+ my %oldhash = $oldopt ? $oldopt->hash : ();
+
my $href = {
+ %oldhash,
$pkey => $self->get($pkey),
$namecol => $optionname,
- $valuecol => $options->{$optionname},
+ $valuecol => ( ref($optionvalue) || $optionvalue ),
};
#my $newopt = eval "new FS::$option_table \$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
+
warn "FS::option_Common::replace: ".
( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
if $DEBUG > 2;
- my $error = $oldopt ? $newopt->replace($oldopt) : $newopt->insert;
+ 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->{$_->$namecol()} } $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;
+ }
}
}
}
+=item check_options HASHREF
+
+This method is called by 'insert' and 'replace' to check the options that were supplied.
+
+Return error-message, or false.
+
+(In this class, this is a do-nothing routine that always returns false. Override as necessary. No need to call superclass.)
+
+=cut
+
+sub check_options {
+ my ($self, $options) = @_;
+ '';
+}
+
=item option_objects
Returns all options as FS::I<tablename>_option objects.
$obj ? $obj->$valuecol() : '';
}
+=item option_cacheable OPTIONNAME
+
+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;