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