1 package FS::option_Common;
4 use base qw( FS::Record );
6 use Scalar::Util qw( blessed );
7 use FS::Record qw( qsearch qsearchs dbh );
13 FS::option_Common - Base class for option sub-classes
17 use FS::option_Common;
19 @ISA = qw( FS::option_Common );
21 #optional for non-standard names
22 sub _option_table { 'table_name'; } #defaults to ${table}_option
23 sub _option_namecol { 'column_name'; } #defaults to optionname
24 sub _option_valuecol { 'column_name'; } #defaults to optionvalue
28 FS::option_Common is intended as a base class for classes which have a
29 simple one-to-many class associated with them, used to store a hash-like data
30 structure of keys and values.
36 =item insert [ HASHREF | OPTION => VALUE ... ]
38 Adds this record to the database. If there is an error, returns the error,
39 otherwise returns false.
41 If a list or hash reference of options is supplied, option records are also
46 #false laziness w/queue.pm
50 ( ref($_[0]) eq 'HASH' )
53 warn "FS::option_Common::insert called on $self with options ".
54 join(', ', map "$_ => ".$options->{$_}, keys %$options)
57 local $SIG{HUP} = 'IGNORE';
58 local $SIG{INT} = 'IGNORE';
59 local $SIG{QUIT} = 'IGNORE';
60 local $SIG{TERM} = 'IGNORE';
61 local $SIG{TSTP} = 'IGNORE';
62 local $SIG{PIPE} = 'IGNORE';
64 my $oldAutoCommit = $FS::UID::AutoCommit;
65 local $FS::UID::AutoCommit = 0;
70 $error = $self->check_options($options);
72 $dbh->rollback if $oldAutoCommit;
76 $error = $self->SUPER::insert;
78 $dbh->rollback if $oldAutoCommit;
82 my $pkey = $self->primary_key;
83 my $option_table = $self->option_table;
85 my $namecol = $self->_option_namecol;
86 my $valuecol = $self->_option_valuecol;
88 foreach my $optionname ( keys %{$options} ) {
90 my $optionvalue = $options->{$optionname};
93 $pkey => $self->get($pkey),
94 $namecol => $optionname,
95 $valuecol => ( ref($optionvalue) || $optionvalue ),
98 #my $option_record = eval "new FS::$option_table \$href";
100 # $dbh->rollback if $oldAutoCommit;
103 my $option_record = "FS::$option_table"->new($href);
106 push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
108 $error = $option_record->insert(@args);
110 $dbh->rollback if $oldAutoCommit;
116 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
124 Delete this record from the database. Any associated option records are also
129 #foreign keys would make this much less tedious... grr dumb mysql
132 local $SIG{HUP} = 'IGNORE';
133 local $SIG{INT} = 'IGNORE';
134 local $SIG{QUIT} = 'IGNORE';
135 local $SIG{TERM} = 'IGNORE';
136 local $SIG{TSTP} = 'IGNORE';
137 local $SIG{PIPE} = 'IGNORE';
139 my $oldAutoCommit = $FS::UID::AutoCommit;
140 local $FS::UID::AutoCommit = 0;
143 my $error = $self->SUPER::delete;
145 $dbh->rollback if $oldAutoCommit;
149 my $pkey = $self->primary_key;
150 #my $option_table = $self->option_table;
152 foreach my $obj ( $self->option_objects ) {
153 my $error = $obj->delete;
155 $dbh->rollback if $oldAutoCommit;
160 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
166 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
168 Replaces the OLD_RECORD with this one in the database. If there is an error,
169 returns the error, otherwise returns false.
171 If a list or hash reference of options is supplied, option records are created
179 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
181 : $self->replace_old;
184 my $options_supplied = 0;
185 if ( ref($_[0]) eq 'HASH' ) {
187 $options_supplied = 1;
190 $options_supplied = scalar(@_) ? 1 : 0;
193 warn "FS::option_Common::replace called on $self with options ".
194 join(', ', map "$_ => ". $options->{$_}, keys %$options)
197 local $SIG{HUP} = 'IGNORE';
198 local $SIG{INT} = 'IGNORE';
199 local $SIG{QUIT} = 'IGNORE';
200 local $SIG{TERM} = 'IGNORE';
201 local $SIG{TSTP} = 'IGNORE';
202 local $SIG{PIPE} = 'IGNORE';
204 my $oldAutoCommit = $FS::UID::AutoCommit;
205 local $FS::UID::AutoCommit = 0;
210 if ($options_supplied) {
211 $error = $self->check_options($options);
213 $dbh->rollback if $oldAutoCommit;
218 $error = $self->SUPER::replace($old);
220 $dbh->rollback if $oldAutoCommit;
224 my $pkey = $self->primary_key;
225 my $option_table = $self->option_table;
227 my $namecol = $self->_option_namecol;
228 my $valuecol = $self->_option_valuecol;
230 foreach my $optionname ( keys %{$options} ) {
232 warn "FS::option_Common::replace: inserting or replacing option: $optionname"
235 my $oldopt = qsearchs( $option_table, {
236 $pkey => $self->get($pkey),
237 $namecol => $optionname,
240 my $optionvalue = $options->{$optionname};
242 my %oldhash = $oldopt ? $oldopt->hash : ();
246 $pkey => $self->get($pkey),
247 $namecol => $optionname,
248 $valuecol => ( ref($optionvalue) || $optionvalue ),
251 #my $newopt = eval "new FS::$option_table \$href";
253 # $dbh->rollback if $oldAutoCommit;
256 my $newopt = "FS::$option_table"->new($href);
258 my $opt_pkey = $newopt->primary_key;
260 $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
263 push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
265 warn "FS::option_Common::replace: ".
266 ( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
268 my $error = $oldopt ? $newopt->replace($oldopt, @args)
269 : $newopt->insert( @args);
271 $dbh->rollback if $oldAutoCommit;
276 #remove extraneous old options
277 if ( $options_supplied ) {
279 grep { !exists $options->{$_->$namecol()} } $old->option_objects
281 my $error = $opt->delete;
283 $dbh->rollback if $oldAutoCommit;
289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
295 =item check_options HASHREF
297 This method is called by 'insert' and 'replace' to check the options that were supplied.
299 Return error-message, or false.
301 (In this class, this is a do-nothing routine that always returns false. Override as necessary. No need to call superclass.)
306 my ($self, $options) = @_;
312 Returns all options as FS::I<tablename>_option objects.
318 my $pkey = $self->primary_key;
319 my $option_table = $self->option_table;
320 qsearch($option_table, { $pkey => $self->get($pkey) } );
325 Returns a list of option names and values suitable for assigning to a hash.
331 my $namecol = $self->_option_namecol;
332 my $valuecol = $self->_option_valuecol;
333 map { $_->$namecol() => $_->$valuecol() } $self->option_objects;
336 =item option OPTIONNAME
338 Returns the option value for the given name, or the empty string.
344 my $pkey = $self->primary_key;
345 my $option_table = $self->option_table;
346 my $namecol = $self->_option_namecol;
347 my $valuecol = $self->_option_valuecol;
349 $pkey => $self->get($pkey),
352 warn "$self -> option: searching for ".
353 join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref )
355 my $obj = qsearchs($option_table, $hashref);
356 $obj ? $obj->$valuecol() : '';
359 =item option_cacheable OPTIONNAME
361 Same as the option method, but may cache and return a cached value.
362 Good for use within loops; otherwise, probably avoid.
366 sub option_cacheable {
367 my( $self, $name ) = @_;
368 return $self->{option_cache}{$name} if exists $self->{option_cache}{$name};
369 $self->{option_cache}{$name} = $self->option($name,1);
375 my $option_table = $self->_option_table;
376 eval "use FS::$option_table";
382 sub _option_table { shift->table .'_option'; }
383 sub _option_namecol { 'optionname'; }
384 sub _option_valuecol { 'optionvalue'; }