FS/FS/option_Common.pm

   1 package FS::option_Common;
   2
   3 use strict;
   4 use base qw( FS::Record );
   5 use vars qw( $DEBUG );
   6 use Scalar::Util qw( blessed );
   7 use FS::Record qw( qsearch qsearchs dbh );
   8
   9 $DEBUG = 0;
  10
  11 =head1 NAME
  12
  13 FS::option_Common - Base class for option sub-classes
  14
  15 =head1 SYNOPSIS
  16
  17 use FS::option_Common;
  18
  19 @ISA = qw( FS::option_Common );
  20
  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
  25
  26 =head1 DESCRIPTION
  27
  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.
  31
  32 =head1 METHODS
  33
  34 =over 4
  35
  36 =item insert [ HASHREF | OPTION => VALUE ... ]
  37
  38 Adds this record to the database.  If there is an error, returns the error,
  39 otherwise returns false.
  40
  41 If a list or hash reference of options is supplied, option records are also
  42 created.
  43
  44 =cut
  45
  46 #false laziness w/queue.pm
  47 sub insert {
  48   my $self = shift;
  49   my $options =
  50     ( ref($_[0]) eq 'HASH' )
  51       ? shift
  52       : { @_ };
  53   warn "FS::option_Common::insert called on $self with options ".
  54        join(', ', map "$_ => ".$options->{$_}, keys %$options)
  55     if $DEBUG;
  56
  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';
  63
  64   my $oldAutoCommit = $FS::UID::AutoCommit;
  65   local $FS::UID::AutoCommit = 0;
  66   my $dbh = dbh;
  67
  68   my $error;
  69
  70   $error = $self->check_options($options);
  71   if ( $error ) {
  72     $dbh->rollback if $oldAutoCommit;
  73     return $error;
  74   }
  75
  76   $error = $self->SUPER::insert;
  77   if ( $error ) {
  78     $dbh->rollback if $oldAutoCommit;
  79     return $error;
  80   }
  81
  82   my $pkey = $self->primary_key;
  83   my $option_table = $self->option_table;
  84
  85   my $namecol = $self->_option_namecol;
  86   my $valuecol = $self->_option_valuecol;
  87
  88   foreach my $optionname ( keys %{$options} ) {
  89
  90     my $optionvalue = $options->{$optionname};
  91
  92     my $href = {
  93       $pkey     => $self->get($pkey),
  94       $namecol  => $optionname,
  95       $valuecol => ( ref($optionvalue) || $optionvalue ),
  96     };
  97
  98     #my $option_record = eval "new FS::$option_table \$href";
  99     #if ( $@ ) {
 100     #  $dbh->rollback if $oldAutoCommit;
 101     #  return $@;
 102     #}
 103     my $option_record = "FS::$option_table"->new($href);
 104
 105     my @args = ();
 106     push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
 107
 108     $error = $option_record->insert(@args);
 109     if ( $error ) {
 110       $dbh->rollback if $oldAutoCommit;
 111       return $error;
 112     }
 113
 114   }
 115
 116   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 117
 118   '';
 119
 120 }
 121
 122 =item delete
 123
 124 Delete this record from the database.  Any associated option records are also
 125 deleted.
 126
 127 =cut
 128
 129 #foreign keys would make this much less tedious... grr dumb mysql
 130 sub delete {
 131   my $self = shift;
 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';
 138
 139   my $oldAutoCommit = $FS::UID::AutoCommit;
 140   local $FS::UID::AutoCommit = 0;
 141   my $dbh = dbh;
 142
 143   my $error = $self->SUPER::delete;
 144   if ( $error ) {
 145     $dbh->rollback if $oldAutoCommit;
 146     return $error;
 147   }
 148
 149   my $pkey = $self->primary_key;
 150   #my $option_table = $self->option_table;
 151
 152   foreach my $obj ( $self->option_objects ) {
 153     my $error = $obj->delete;
 154     if ( $error ) {
 155       $dbh->rollback if $oldAutoCommit;
 156       return $error;
 157     }
 158   }
 159
 160   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 161
 162   '';
 163
 164 }
 165
 166 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 167
 168 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 169 returns the error, otherwise returns false.
 170
 171 If a list or hash reference of options is supplied, option records are created
 172 or modified.
 173
 174 =cut
 175
 176 sub replace {
 177   my $self = shift;
 178
 179   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 180               ? shift
 181               : $self->replace_old;
 182
 183   my $options;
 184   my $options_supplied = 0;
 185   if ( ref($_[0]) eq 'HASH' ) {
 186     $options = shift;
 187     $options_supplied = 1;
 188   } else {
 189     $options = { @_ };
 190     $options_supplied = scalar(@_) ? 1 : 0;
 191   }
 192
 193   warn "FS::option_Common::replace called on $self with options ".
 194        join(', ', map "$_ => ". $options->{$_}, keys %$options)
 195     if $DEBUG;
 196
 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';
 203
 204   my $oldAutoCommit = $FS::UID::AutoCommit;
 205   local $FS::UID::AutoCommit = 0;
 206   my $dbh = dbh;
 207
 208   my $error;
 209
 210   if ($options_supplied) {
 211         $error = $self->check_options($options);
 212         if ( $error ) {
 213       $dbh->rollback if $oldAutoCommit;
 214       return $error;
 215     }
 216   }
 217
 218   $error = $self->SUPER::replace($old);
 219   if ( $error ) {
 220     $dbh->rollback if $oldAutoCommit;
 221     return $error;
 222   }
 223
 224   my $pkey = $self->primary_key;
 225   my $option_table = $self->option_table;
 226
 227   my $namecol = $self->_option_namecol;
 228   my $valuecol = $self->_option_valuecol;
 229
 230   foreach my $optionname ( keys %{$options} ) {
 231
 232     warn "FS::option_Common::replace: inserting or replacing option: $optionname"
 233       if $DEBUG > 1;
 234
 235     my $oldopt = qsearchs( $option_table, {
 236         $pkey    => $self->get($pkey),
 237         $namecol => $optionname,
 238     } );
 239
 240     my $optionvalue = $options->{$optionname};
 241
 242     my %oldhash = $oldopt ? $oldopt->hash : ();
 243
 244     my $href = {
 245         %oldhash,
 246         $pkey     => $self->get($pkey),
 247         $namecol  => $optionname,
 248         $valuecol => ( ref($optionvalue) || $optionvalue ),
 249     };
 250
 251     #my $newopt = eval "new FS::$option_table \$href";
 252     #if ( $@ ) {
 253     #  $dbh->rollback if $oldAutoCommit;
 254     #  return $@;
 255     #}
 256     my $newopt = "FS::$option_table"->new($href);
 257
 258     my $opt_pkey = $newopt->primary_key;
 259
 260     $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
 261
 262     my @args = ();
 263     push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
 264
 265     warn "FS::option_Common::replace: ".
 266          ( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
 267       if $DEBUG > 2;
 268     my $error = $oldopt ? $newopt->replace($oldopt, @args)
 269                         : $newopt->insert( @args);
 270     if ( $error ) {
 271       $dbh->rollback if $oldAutoCommit;
 272       return $error;
 273     }
 274   }
 275
 276   #remove extraneous old options
 277   if ( $options_supplied ) {
 278     foreach my $opt (
 279       grep { !exists $options->{$_->$namecol()} } $old->option_objects
 280     ) {
 281       my $error = $opt->delete;
 282       if ( $error ) {
 283         $dbh->rollback if $oldAutoCommit;
 284         return $error;
 285       }
 286     }
 287   }
 288
 289   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 290
 291   '';
 292
 293 }
 294
 295 =item check_options HASHREF
 296
 297 This method is called by 'insert' and 'replace' to check the options that were supplied.
 298
 299 Return error-message, or false.
 300
 301 (In this class, this is a do-nothing routine that always returns false.  Override as necessary.  No need to call superclass.)
 302
 303 =cut
 304
 305 sub check_options {
 306         my ($self, $options) = @_;
 307         '';
 308 }
 309
 310 =item option_objects
 311
 312 Returns all options as FS::I<tablename>_option objects.
 313
 314 =cut
 315
 316 sub option_objects {
 317   my $self = shift;
 318   my $pkey = $self->primary_key;
 319   my $option_table = $self->option_table;
 320   qsearch($option_table, { $pkey => $self->get($pkey) } );
 321 }
 322
 323 =item options
 324
 325 Returns a list of option names and values suitable for assigning to a hash.
 326
 327 =cut
 328
 329 sub options {
 330   my $self = shift;
 331   my $namecol = $self->_option_namecol;
 332   my $valuecol = $self->_option_valuecol;
 333   map { $_->$namecol() => $_->$valuecol() } $self->option_objects;
 334 }
 335
 336 =item option OPTIONNAME
 337
 338 Returns the option value for the given name, or the empty string.
 339
 340 =cut
 341
 342 sub option {
 343   my $self = shift;
 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;
 348   my $hashref = {
 349       $pkey    => $self->get($pkey),
 350       $namecol => shift,
 351   };
 352   warn "$self -> option: searching for ".
 353          join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref )
 354     if $DEBUG;
 355   my $obj = qsearchs($option_table, $hashref);
 356   $obj ? $obj->$valuecol() : '';
 357 }
 358
 359 =item option_cacheable OPTIONNAME
 360
 361 Same as the option method, but may cache and return a cached value.
 362 Good for use within loops; otherwise, probably avoid.
 363
 364 =cut
 365
 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);
 370 }
 371
 372
 373 sub option_table {
 374   my $self = shift;
 375   my $option_table = $self->_option_table;
 376   eval "use FS::$option_table";
 377   die $@ if $@;
 378   $option_table;
 379 }
 380
 381 #defaults
 382 sub _option_table    { shift->table .'_option'; }
 383 sub _option_namecol  { 'optionname'; }
 384 sub _option_valuecol { 'optionvalue'; }
 385
 386 =back
 387
 388 =head1 BUGS
 389
 390 =head1 SEE ALSO
 391
 392 L<FS::Record>
 393
 394 =cut
 395
 396 1;
 397