FS/FS/o2m_Common.pm

   1 package FS::o2m_Common;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me );
   5 use Carp;
   6 use FS::Schema qw( dbdef );
   7 use FS::Record qw( qsearch qsearchs dbh );
   8
   9 $DEBUG = 0;
  10
  11 $me = '[FS::o2m_Common]';
  12
  13 =head1 NAME
  14
  15 FS::o2m_Common - Mixin class for tables with a related table
  16
  17 =head1 SYNOPSIS
  18
  19 use FS::o2m_Common;
  20
  21 @ISA = qw( FS::o2m_Common FS::Record );
  22
  23 =head1 DESCRIPTION
  24
  25 FS::o2m_Common is intended as a mixin class for classes which have a
  26 related table.
  27
  28 =head1 METHODS
  29
  30 =over 4
  31
  32 =item process_o2m OPTION => VALUE, ...
  33
  34 Available options:
  35
  36 table (required) - Table into which the records are inserted.
  37
  38 fields (required) - Arrayref of the field names in the "many" table.
  39
  40 params (required) - Hashref of keys and values, often passed as
  41 C<scalar($cgi->Vars)> from a form. This will be scanned for keys of the form
  42 "pkeyNN" (where pkey is the primary key column name, and NN is an integer).
  43 Each of these designates one record in the "many" table. The contents of
  44 that record will be taken from other parameters with the names
  45 "pkeyNN_myfield" (where myfield is one of the fields in the 'fields'
  46 array).
  47
  48 num_col (optional) - Name of the foreign key column in the "many" table, which
  49 links to the primary key of the base table. If not specified, it is assumed
  50 this has the same name as in the base table.
  51
  52 =cut
  53
  54 #a little more false laziness w/m2m_Common.pm than m2_name_Common.pm
  55 # still, far from the worse of it.  at least we're a reuable mixin!
  56 sub process_o2m {
  57   my( $self, %opt ) = @_;
  58
  59   my $self_pkey = $self->dbdef_table->primary_key;
  60   my $link_sourcekey = $opt{'num_col'} || $self_pkey;
  61
  62   my $hashref = {}; #$opt{'hashref'} || {};
  63   $hashref->{$link_sourcekey} = $self->$self_pkey();
  64
  65   my $table = $self->_load_table($opt{'table'});
  66   my $table_pkey = dbdef->table($table)->primary_key;
  67
  68 #  my $link_static = $opt{'link_static'} || {};
  69
  70   warn "$me processing o2m from ". $self->table. ".$link_sourcekey".
  71        " to $table\n"
  72     if $DEBUG;
  73
  74   #if ( ref($opt{'params'}) eq 'ARRAY' ) {
  75   #  $opt{'params'} = { map { $_=>1 } @{$opt{'params'}} };
  76   #}
  77
  78   local $SIG{HUP} = 'IGNORE';
  79   local $SIG{INT} = 'IGNORE';
  80   local $SIG{QUIT} = 'IGNORE';
  81   local $SIG{TERM} = 'IGNORE';
  82   local $SIG{TSTP} = 'IGNORE';
  83   local $SIG{PIPE} = 'IGNORE';
  84
  85   my $oldAutoCommit = $FS::UID::AutoCommit;
  86   local $FS::UID::AutoCommit = 0;
  87   my $dbh = dbh;
  88
  89   my @fields = grep { /^$table_pkey\d+$/ }
  90                keys %{ $opt{'params'} };
  91
  92   my %edits = map  { $opt{'params'}->{$_} => $_ }
  93               grep { $opt{'params'}->{$_} }
  94               @fields;
  95
  96   foreach my $del_obj (
  97     grep { ! $edits{$_->$table_pkey()} }
  98          qsearch( $table, $hashref )
  99   ) {
 100     my $error = $del_obj->delete;
 101     if ( $error ) {
 102       $dbh->rollback if $oldAutoCommit;
 103       return $error;
 104     }
 105   }
 106
 107   foreach my $pkey_value ( keys %edits ) {
 108     my $old_obj = qsearchs( $table, { %$hashref, $table_pkey => $pkey_value } ),
 109     my $add_param = $edits{$pkey_value};
 110     my %hash = ( $table_pkey => $pkey_value,
 111                  map { $_ => $opt{'params'}->{$add_param."_$_"} }
 112                      @{ $opt{'fields'} }
 113                );
 114     #next unless grep { $_ =~ /\S/ } values %hash;
 115
 116     my $new_obj = "FS::$table"->new( { %$hashref, %hash } );
 117     my $error = $new_obj->replace($old_obj);
 118     if ( $error ) {
 119       $dbh->rollback if $oldAutoCommit;
 120       return $error;
 121     }
 122   }
 123
 124   foreach my $add_param ( grep { ! $opt{'params'}->{$_} } @fields ) {
 125
 126     my %hash = map { $_ => $opt{'params'}->{$add_param."_$_"} }
 127                @{ $opt{'fields'} };
 128     next unless grep { $_ =~ /\S/ } values %hash;
 129
 130     my $add_obj = "FS::$table"->new( { %$hashref, %hash } );
 131     my $error = $add_obj->insert;
 132     if ( $error ) {
 133       $dbh->rollback if $oldAutoCommit;
 134       return $error;
 135     }
 136   }
 137
 138   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 139   '';
 140 }
 141
 142 sub _load_table {
 143   my( $self, $table ) = @_;
 144   eval "use FS::$table";
 145   die $@ if $@;
 146   $table;
 147 }
 148
 149 =back
 150
 151 =head1 BUGS
 152
 153 =head1 SEE ALSO
 154
 155 L<FS::Record>
 156
 157 =cut
 158
 159 1;
 160