1 package FS::option_Common;
4 use vars qw( @ISA $DEBUG );
5 use Scalar::Util qw( blessed );
6 use FS::Record qw( qsearch qsearchs dbh );
8 @ISA = qw( FS::Record );
14 FS::option_Common - Base class for option sub-classes
18 use FS::option_Common;
20 @ISA = qw( FS::option_Common );
22 #optional for non-standard names
23 sub _option_table { 'table_name'; } #defaults to ${table}_option
24 sub _option_namecol { 'column_name'; } #defaults to optionname
25 sub _option_valuecol { 'column_name'; } #defaults to optionvalue
29 FS::option_Common is intended as a base class for classes which have a
30 simple one-to-many class associated with them, used to store a hash-like data
31 structure of keys and values.
37 =item insert [ HASHREF | OPTION => VALUE ... ]
39 Adds this record to the database. If there is an error, returns the error,
40 otherwise returns false.
42 If a list or hash reference of options is supplied, option records are also
47 #false laziness w/queue.pm
51 ( ref($_[0]) eq 'HASH' )
54 warn "FS::option_Common::insert called on $self with options ".
55 join(', ', map "$_ => ".$options->{$_}, keys %$options)
58 local $SIG{HUP} = 'IGNORE';
59 local $SIG{INT} = 'IGNORE';
60 local $SIG{QUIT} = 'IGNORE';
61 local $SIG{TERM} = 'IGNORE';
62 local $SIG{TSTP} = 'IGNORE';
63 local $SIG{PIPE} = 'IGNORE';
65 my $oldAutoCommit = $FS::UID::AutoCommit;
66 local $FS::UID::AutoCommit = 0;
71 $error = $self->check_options($options)
72 || $self->SUPER::insert;
74 $dbh->rollback if $oldAutoCommit;
78 my $pkey = $self->primary_key;
79 my $option_table = $self->option_table;
81 my $namecol = $self->_option_namecol;
82 my $valuecol = $self->_option_valuecol;
84 foreach my $optionname ( keys %{$options} ) {
86 my $optionvalue = $options->{$optionname};
89 $pkey => $self->get($pkey),
90 $namecol => $optionname,
91 $valuecol => ( ref($optionvalue) || $optionvalue ),
94 #my $option_record = eval "new FS::$option_table \$href";
96 # $dbh->rollback if $oldAutoCommit;
99 my $option_record = "FS::$option_table"->new($href);
102 push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
104 $error = $option_record->insert(@args);
106 $dbh->rollback if $oldAutoCommit;
112 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
120 Delete this record from the database. Any associated option records are also
125 #foreign keys would make this much less tedious... grr dumb mysql
128 local $SIG{HUP} = 'IGNORE';
129 local $SIG{INT} = 'IGNORE';
130 local $SIG{QUIT} = 'IGNORE';
131 local $SIG{TERM} = 'IGNORE';
132 local $SIG{TSTP} = 'IGNORE';
133 local $SIG{PIPE} = 'IGNORE';
135 my $oldAutoCommit = $FS::UID::AutoCommit;
136 local $FS::UID::AutoCommit = 0;
139 my $error = $self->SUPER::delete;
141 $dbh->rollback if $oldAutoCommit;
145 my $pkey = $self->primary_key;
146 #my $option_table = $self->option_table;
148 foreach my $obj ( $self->option_objects ) {
149 my $error = $obj->delete;
151 $dbh->rollback if $oldAutoCommit;
156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
162 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
164 Replaces the OLD_RECORD with this one in the database. If there is an error,
165 returns the error, otherwise returns false.
167 If a list or hash reference of options is supplied, option records are created
175 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
177 : $self->replace_old;
180 my $options_supplied = 0;
181 if ( ref($_[0]) eq 'HASH' ) {
183 $options_supplied = 1;
186 $options_supplied = scalar(@_) ? 1 : 0;
189 warn "FS::option_Common::replace called on $self with options ".
190 join(', ', map "$_ => ". $options->{$_}, keys %$options)
193 local $SIG{HUP} = 'IGNORE';
194 local $SIG{INT} = 'IGNORE';
195 local $SIG{QUIT} = 'IGNORE';
196 local $SIG{TERM} = 'IGNORE';
197 local $SIG{TSTP} = 'IGNORE';
198 local $SIG{PIPE} = 'IGNORE';
200 my $oldAutoCommit = $FS::UID::AutoCommit;
201 local $FS::UID::AutoCommit = 0;
206 if ($options_supplied) {
207 $error = $self->check_options($options);
209 $dbh->rollback if $oldAutoCommit;
214 $error = $self->SUPER::replace($old);
216 $dbh->rollback if $oldAutoCommit;
220 my $pkey = $self->primary_key;
221 my $option_table = $self->option_table;
223 my $namecol = $self->_option_namecol;
224 my $valuecol = $self->_option_valuecol;
226 foreach my $optionname ( keys %{$options} ) {
228 warn "FS::option_Common::replace: inserting or replacing option: $optionname"
231 my $oldopt = qsearchs( $option_table, {
232 $pkey => $self->get($pkey),
233 $namecol => $optionname,
236 my $optionvalue = $options->{$optionname};
238 my %oldhash = $oldopt ? $oldopt->hash : ();
242 $pkey => $self->get($pkey),
243 $namecol => $optionname,
244 $valuecol => ( ref($optionvalue) || $optionvalue ),
247 #my $newopt = eval "new FS::$option_table \$href";
249 # $dbh->rollback if $oldAutoCommit;
252 my $newopt = "FS::$option_table"->new($href);
254 my $opt_pkey = $newopt->primary_key;
256 $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
259 push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
261 warn "FS::option_Common::replace: ".
262 ( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
264 my $error = $oldopt ? $newopt->replace($oldopt, @args)
265 : $newopt->insert( @args);
267 $dbh->rollback if $oldAutoCommit;
272 #remove extraneous old options
273 if ( $options_supplied ) {
275 grep { !exists $options->{$_->$namecol()} } $old->option_objects
277 my $error = $opt->delete;
279 $dbh->rollback if $oldAutoCommit;
285 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
291 =item check_options HASHREF
293 This method is called by 'insert' and 'replace' to check the options that were supplied.
295 Return error-message, or false.
297 (In this class, this is a do-nothing routine that always returns false. Override as necessary. No need to call superclass.)
302 my ($self, $options) = @_;
308 Returns all options as FS::I<tablename>_option objects.
314 my $pkey = $self->primary_key;
315 my $option_table = $self->option_table;
316 qsearch($option_table, { $pkey => $self->get($pkey) } );
321 Returns a list of option names and values suitable for assigning to a hash.
327 my $namecol = $self->_option_namecol;
328 my $valuecol = $self->_option_valuecol;
329 map { $_->$namecol() => $_->$valuecol() } $self->option_objects;
332 =item option OPTIONNAME
334 Returns the option value for the given name, or the empty string.
340 my $pkey = $self->primary_key;
341 my $option_table = $self->option_table;
342 my $namecol = $self->_option_namecol;
343 my $valuecol = $self->_option_valuecol;
345 $pkey => $self->get($pkey),
348 warn "$self -> option: searching for ".
349 join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref )
351 my $obj = qsearchs($option_table, $hashref);
352 $obj ? $obj->$valuecol() : '';
358 my $option_table = $self->_option_table;
359 eval "use FS::$option_table";
365 sub _option_table { shift->table .'_option'; }
366 sub _option_namecol { 'optionname'; }
367 sub _option_valuecol { 'optionvalue'; }