FS/FS/option_Common.pm

   1 package FS::option_Common;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6
   7 @ISA = qw( FS::Record );
   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 =head1 DESCRIPTION
  22
  23 FS::option_Common is intended as a base class for classes which have a
  24 simple one-to-many class associated with them, used to store a hash-like data
  25 structure of keys and values.
  26
  27 =head1 METHODS
  28
  29 =over 4
  30
  31 =item insert [ HASHREF | OPTION => VALUE ... ]
  32
  33 Adds this record to the database.  If there is an error, returns the error,
  34 otherwise returns false.
  35
  36 If a list or hash reference of options is supplied, option records are also
  37 created.
  38
  39 =cut
  40
  41 #false laziness w/queue.pm
  42 sub insert {
  43   my $self = shift;
  44   my $options =
  45     ( ref($_[0]) eq 'HASH' )
  46       ? shift
  47       : { @_ };
  48   warn "FS::option_Common::insert called on $self with options ".
  49        join(', ', map "$_ => ".$options->{$_}, keys %$options)
  50     if $DEBUG;
  51
  52   local $SIG{HUP} = 'IGNORE';
  53   local $SIG{INT} = 'IGNORE';
  54   local $SIG{QUIT} = 'IGNORE';
  55   local $SIG{TERM} = 'IGNORE';
  56   local $SIG{TSTP} = 'IGNORE';
  57   local $SIG{PIPE} = 'IGNORE';
  58
  59   my $oldAutoCommit = $FS::UID::AutoCommit;
  60   local $FS::UID::AutoCommit = 0;
  61   my $dbh = dbh;
  62
  63   my $error = $self->SUPER::insert;
  64   if ( $error ) {
  65     $dbh->rollback if $oldAutoCommit;
  66     return $error;
  67   }
  68
  69   my $pkey = $self->pkey;
  70   my $option_table = $self->option_table;
  71
  72   foreach my $optionname ( keys %{$options} ) {
  73     my $href = {
  74       $pkey         => $self->get($pkey),
  75       'optionname'  => $optionname,
  76       'optionvalue' => $options->{$optionname},
  77     };
  78
  79     #my $option_record = eval "new FS::$option_table \$href";
  80     #if ( $@ ) {
  81     #  $dbh->rollback if $oldAutoCommit;
  82     #  return $@;
  83     #}
  84     my $option_record = "FS::$option_table"->new($href);
  85
  86     $error = $option_record->insert;
  87     if ( $error ) {
  88       $dbh->rollback if $oldAutoCommit;
  89       return $error;
  90     }
  91   }
  92
  93   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
  94
  95   '';
  96
  97 }
  98
  99 =item delete
 100
 101 Delete this record from the database.  Any associated option records are also
 102 deleted.
 103
 104 =cut
 105
 106 #foreign keys would make this much less tedious... grr dumb mysql
 107 sub delete {
 108   my $self = shift;
 109   local $SIG{HUP} = 'IGNORE';
 110   local $SIG{INT} = 'IGNORE';
 111   local $SIG{QUIT} = 'IGNORE';
 112   local $SIG{TERM} = 'IGNORE';
 113   local $SIG{TSTP} = 'IGNORE';
 114   local $SIG{PIPE} = 'IGNORE';
 115
 116   my $oldAutoCommit = $FS::UID::AutoCommit;
 117   local $FS::UID::AutoCommit = 0;
 118   my $dbh = dbh;
 119
 120   my $error = $self->SUPER::delete;
 121   if ( $error ) {
 122     $dbh->rollback if $oldAutoCommit;
 123     return $error;
 124   }
 125
 126   my $pkey = $self->pkey;
 127   #my $option_table = $self->option_table;
 128
 129   foreach my $obj ( $self->option_objects ) {
 130     my $error = $obj->delete;
 131     if ( $error ) {
 132       $dbh->rollback if $oldAutoCommit;
 133       return $error;
 134     }
 135   }
 136
 137   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 138
 139   '';
 140
 141 }
 142
 143 =item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
 144
 145 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 146 returns the error, otherwise returns false.
 147
 148 If a list hash reference of options is supplied, part_export_option records are
 149 created or modified (see L<FS::part_export_option>).
 150
 151 =cut
 152
 153 sub replace {
 154   my $self = shift;
 155   my $old = shift;
 156   my $options =
 157     ( ref($_[0]) eq 'HASH' )
 158       ? shift
 159       : { @_ };
 160   warn "FS::option_Common::insert called on $self with options ".
 161        join(', ', map "$_ => ". $options->{$_}, keys %$options)
 162     if $DEBUG;
 163
 164   local $SIG{HUP} = 'IGNORE';
 165   local $SIG{INT} = 'IGNORE';
 166   local $SIG{QUIT} = 'IGNORE';
 167   local $SIG{TERM} = 'IGNORE';
 168   local $SIG{TSTP} = 'IGNORE';
 169   local $SIG{PIPE} = 'IGNORE';
 170
 171   my $oldAutoCommit = $FS::UID::AutoCommit;
 172   local $FS::UID::AutoCommit = 0;
 173   my $dbh = dbh;
 174
 175   my $error = $self->SUPER::replace($old);
 176   if ( $error ) {
 177     $dbh->rollback if $oldAutoCommit;
 178     return $error;
 179   }
 180
 181   my $pkey = $self->pkey;
 182   my $option_table = $self->option_table;
 183
 184   foreach my $optionname ( keys %{$options} ) {
 185     my $old = qsearchs( $option_table, {
 186         $pkey         => $self->get($pkey),
 187         'optionname'  => $optionname,
 188     } );
 189
 190     my $href = {
 191         $pkey         => $self->get($pkey),
 192         'optionname'  => $optionname,
 193         'optionvalue' => $options->{$optionname},
 194     };
 195
 196     #my $new = eval "new FS::$option_table \$href";
 197     #if ( $@ ) {
 198     #  $dbh->rollback if $oldAutoCommit;
 199     #  return $@;
 200     #}
 201     my $new = "FS::$option_table"->new($href);
 202
 203     $new->optionnum($old->optionnum) if $old;
 204     my $error = $old ? $new->replace($old) : $new->insert;
 205     if ( $error ) {
 206       $dbh->rollback if $oldAutoCommit;
 207       return $error;
 208     }
 209   }
 210
 211   #remove extraneous old options
 212   foreach my $opt (
 213     grep { !exists $options->{$_->optionname} } $old->option_objects
 214   ) {
 215     my $error = $opt->delete;
 216     if ( $error ) {
 217       $dbh->rollback if $oldAutoCommit;
 218       return $error;
 219     }
 220   }
 221
 222   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 223
 224   '';
 225
 226 }
 227
 228 =item option_objects
 229
 230 Returns all options as FS::I<tablename>_option objects.
 231
 232 =cut
 233
 234 sub option_objects {
 235   my $self = shift;
 236   my $pkey = $self->pkey;
 237   my $option_table = $self->option_table;
 238   qsearch($option_table, { $pkey => $self->get($pkey) } );
 239 }
 240
 241 =item options
 242
 243 Returns a list of option names and values suitable for assigning to a hash.
 244
 245 =cut
 246
 247 sub options {
 248   my $self = shift;
 249   map { $_->optionname => $_->optionvalue } $self->option_objects;
 250 }
 251
 252 =item option OPTIONNAME
 253
 254 Returns the option value for the given name, or the empty string.
 255
 256 =cut
 257
 258 sub option {
 259   my $self = shift;
 260   my $pkey = $self->pkey;
 261   my $option_table = $self->option_table;
 262   my $obj =
 263     qsearchs($option_table, {
 264       $pkey      => $self->get($pkey),
 265       optionname => shift,
 266   } );
 267   $obj ? $obj->optionvalue : '';
 268 }
 269
 270
 271 sub pkey {
 272   my $self = shift;
 273   my $pkey = $self->dbdef_table->primary_key;
 274 }
 275
 276 sub option_table {
 277   my $self = shift;
 278   my $option_table = $self->table . '_option';
 279   eval "use FS::$option_table";
 280   die $@ if $@;
 281   $option_table;
 282 }
 283
 284 =back
 285
 286 =head1 BUGS
 287
 288 =head1 SEE ALSO
 289
 290 L<FS::Record>
 291
 292 =cut
 293
 294 1;
 295