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     ( ref($_[0]) eq 'HASH' )
 178       ? shift
 179       : { @_ };
 180
 181   warn "FS::option_Common::replace called on $self with options ".
 182        join(', ', map "$_ => ". $options->{$_}, keys %$options)
 183     if $DEBUG;
 184
 185   local $SIG{HUP} = 'IGNORE';
 186   local $SIG{INT} = 'IGNORE';
 187   local $SIG{QUIT} = 'IGNORE';
 188   local $SIG{TERM} = 'IGNORE';
 189   local $SIG{TSTP} = 'IGNORE';
 190   local $SIG{PIPE} = 'IGNORE';
 191
 192   my $oldAutoCommit = $FS::UID::AutoCommit;
 193   local $FS::UID::AutoCommit = 0;
 194   my $dbh = dbh;
 195
 196   my $error = $self->SUPER::replace($old);
 197   if ( $error ) {
 198     $dbh->rollback if $oldAutoCommit;
 199     return $error;
 200   }
 201
 202   my $pkey = $self->primary_key;
 203   my $option_table = $self->option_table;
 204
 205   my $namecol = $self->_option_namecol;
 206   my $valuecol = $self->_option_valuecol;
 207
 208   foreach my $optionname ( keys %{$options} ) {
 209
 210     warn "FS::option_Common::replace: inserting or replacing option: $optionname"
 211       if $DEBUG > 1;
 212
 213     my $oldopt = qsearchs( $option_table, {
 214         $pkey    => $self->get($pkey),
 215         $namecol => $optionname,
 216     } );
 217
 218     my $optionvalue = $options->{$optionname};
 219
 220     my %oldhash = $oldopt ? $oldopt->hash : ();
 221
 222     my $href = {
 223         %oldhash,
 224         $pkey     => $self->get($pkey),
 225         $namecol  => $optionname,
 226         $valuecol => ( ref($optionvalue) || $optionvalue ),
 227     };
 228
 229     #my $newopt = eval "new FS::$option_table \$href";
 230     #if ( $@ ) {
 231     #  $dbh->rollback if $oldAutoCommit;
 232     #  return $@;
 233     #}
 234     my $newopt = "FS::$option_table"->new($href);
 235
 236     my $opt_pkey = $newopt->primary_key;
 237
 238     $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
 239
 240     my @args = ();
 241     push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
 242
 243     warn "FS::option_Common::replace: ".
 244          ( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
 245       if $DEBUG > 2;
 246     my $error = $oldopt ? $newopt->replace($oldopt, @args)
 247                         : $newopt->insert( @args);
 248     if ( $error ) {
 249       $dbh->rollback if $oldAutoCommit;
 250       return $error;
 251     }
 252   }
 253
 254   #remove extraneous old options
 255   foreach my $opt (
 256     grep { !exists $options->{$_->$namecol()} } $old->option_objects
 257   ) {
 258     my $error = $opt->delete;
 259     if ( $error ) {
 260       $dbh->rollback if $oldAutoCommit;
 261       return $error;
 262     }
 263   }
 264
 265   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 266
 267   '';
 268
 269 }
 270
 271 =item option_objects
 272
 273 Returns all options as FS::I<tablename>_option objects.
 274
 275 =cut
 276
 277 sub option_objects {
 278   my $self = shift;
 279   my $pkey = $self->primary_key;
 280   my $option_table = $self->option_table;
 281   qsearch($option_table, { $pkey => $self->get($pkey) } );
 282 }
 283
 284 =item options
 285
 286 Returns a list of option names and values suitable for assigning to a hash.
 287
 288 =cut
 289
 290 sub options {
 291   my $self = shift;
 292   my $namecol = $self->_option_namecol;
 293   my $valuecol = $self->_option_valuecol;
 294   map { $_->$namecol() => $_->$valuecol() } $self->option_objects;
 295 }
 296
 297 =item option OPTIONNAME
 298
 299 Returns the option value for the given name, or the empty string.
 300
 301 =cut
 302
 303 sub option {
 304   my $self = shift;
 305   my $pkey = $self->primary_key;
 306   my $option_table = $self->option_table;
 307   my $namecol = $self->_option_namecol;
 308   my $valuecol = $self->_option_valuecol;
 309   my $hashref = {
 310       $pkey    => $self->get($pkey),
 311       $namecol => shift,
 312   };
 313   warn "$self -> option: searching for ".
 314          join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref )
 315     if $DEBUG;
 316   my $obj = qsearchs($option_table, $hashref);
 317   $obj ? $obj->$valuecol() : '';
 318 }
 319
 320
 321 sub option_table {
 322   my $self = shift;
 323   my $option_table = $self->_option_table;
 324   eval "use FS::$option_table";
 325   die $@ if $@;
 326   $option_table;
 327 }
 328
 329 #defaults
 330 sub _option_table    { shift->table .'_option'; }
 331 sub _option_namecol  { 'optionname'; }
 332 sub _option_valuecol { 'optionvalue'; }
 333
 334 =back
 335
 336 =head1 BUGS
 337
 338 =head1 SEE ALSO
 339
 340 L<FS::Record>
 341
 342 =cut
 343
 344 1;
 345