FS/FS/option_Common.pm

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