X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Foption_Common.pm;h=8c690890f69cbfe8ce19bb418900824c6d3ea32e;hp=441e798d2356796edb078d2860d40c86113dc451;hb=389b6f1116c3309c2ee57a6c295ed1a793503095;hpb=c648976f0b7975f2328ebd7ba8c711fad0ca4195 diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm index 441e798d2..8c690890f 100644 --- a/FS/FS/option_Common.pm +++ b/FS/FS/option_Common.pm @@ -1,12 +1,12 @@ package FS::option_Common; use strict; -use vars qw( @ISA $DEBUG ); +use base qw( FS::Record ); +use vars qw( $DEBUG ); +use Carp qw( cluck ); use Scalar::Util qw( blessed ); use FS::Record qw( qsearch qsearchs dbh ); -@ISA = qw( FS::Record ); - $DEBUG = 0; =head1 NAME @@ -66,7 +66,10 @@ sub insert { 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; @@ -132,13 +135,7 @@ sub delete { 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; @@ -150,6 +147,12 @@ sub delete { } } + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -161,8 +164,8 @@ sub delete { 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, option records are created or -modified. +If a list or hash reference of options is supplied, option records are created +or modified. =cut @@ -173,10 +176,15 @@ sub replace { ? 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) @@ -193,7 +201,17 @@ sub replace { 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; @@ -252,13 +270,15 @@ sub replace { } #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; + } } } @@ -268,6 +288,21 @@ sub replace { } +=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_option objects. @@ -310,13 +345,26 @@ sub option { $pkey => $self->get($pkey), $namecol => shift, }; - warn "$self -> option: searching for ". + cluck "$self -> option: searching for ". join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref ) if $DEBUG; my $obj = qsearchs($option_table, $hashref); $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;