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