diff options
Diffstat (limited to 'FS/FS/option_Common.pm')
-rw-r--r-- | FS/FS/option_Common.pm | 345 |
1 files changed, 0 insertions, 345 deletions
diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm deleted file mode 100644 index 441e798d2..000000000 --- a/FS/FS/option_Common.pm +++ /dev/null @@ -1,345 +0,0 @@ -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 ); - -$DEBUG = 0; - -=head1 NAME - -FS::option_Common - Base class for option sub-classes - -=head1 SYNOPSIS - -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 -simple one-to-many class associated with them, used to store a hash-like data -structure of keys and values. - -=head1 METHODS - -=over 4 - -=item insert [ HASHREF | OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -If a list or hash reference of options is supplied, option records are also -created. - -=cut - -#false laziness w/queue.pm -sub insert { - my $self = shift; - my $options = - ( ref($_[0]) eq 'HASH' ) - ? shift - : { @_ }; - warn "FS::option_Common::insert called on $self with options ". - join(', ', map "$_ => ".$options->{$_}, keys %$options) - if $DEBUG; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - 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), - $namecol => $optionname, - $valuecol => ( ref($optionvalue) || $optionvalue ), - }; - - #my $option_record = eval "new FS::$option_table \$href"; - #if ( $@ ) { - # $dbh->rollback if $oldAutoCommit; - # return $@; - #} - 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(@args); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Delete this record from the database. Any associated option records are also -deleted. - -=cut - -#foreign keys would make this much less tedious... grr dumb mysql -sub delete { - my $self = shift; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - 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; - - foreach my $obj ( $self->option_objects ) { - my $error = $obj->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=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, option records are created or -modified. - -=cut - -sub replace { - my $self = shift; - - my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) - ? shift - : $self->replace_old; - - my $options = - ( ref($_[0]) eq 'HASH' ) - ? shift - : { @_ }; - - warn "FS::option_Common::replace called on $self with options ". - join(', ', map "$_ => ". $options->{$_}, keys %$options) - if $DEBUG; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - 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} ) { - - 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 = { - %oldhash, - $pkey => $self->get($pkey), - $namecol => $optionname, - $valuecol => ( ref($optionvalue) || $optionvalue ), - }; - - #my $newopt = eval "new FS::$option_table \$href"; - #if ( $@ ) { - # $dbh->rollback if $oldAutoCommit; - # return $@; - #} - 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 - - 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->{$_->$namecol()} } $old->option_objects - ) { - my $error = $opt->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item option_objects - -Returns all options as FS::I<tablename>_option objects. - -=cut - -sub option_objects { - my $self = shift; - my $pkey = $self->primary_key; - my $option_table = $self->option_table; - qsearch($option_table, { $pkey => $self->get($pkey) } ); -} - -=item options - -Returns a list of option names and values suitable for assigning to a hash. - -=cut - -sub options { - my $self = shift; - my $namecol = $self->_option_namecol; - my $valuecol = $self->_option_valuecol; - map { $_->$namecol() => $_->$valuecol() } $self->option_objects; -} - -=item option OPTIONNAME - -Returns the option value for the given name, or the empty string. - -=cut - -sub option { - my $self = shift; - my $pkey = $self->primary_key; - my $option_table = $self->option_table; - 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 option_table { - my $self = shift; - 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 - -=head1 SEE ALSO - -L<FS::Record> - -=cut - -1; - |