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