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          $self->process_o2m_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 = $self->process_o2m_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     &{ $opt{'hash_callback'} }( \%hash, $old_obj ) if $opt{'hash_callback'};
 115     #next unless grep { $_ =~ /\S/ } values %hash;
 116
 117     my $new_obj = "FS::$table"->new( { %$hashref, %hash } );
 118     my $error = $new_obj->replace($old_obj);
 119     if ( $error ) {
 120       $dbh->rollback if $oldAutoCommit;
 121       return $error;
 122     }
 123   }
 124
 125   foreach my $add_param ( grep { ! $opt{'params'}->{$_} } @fields ) {
 126
 127     my %hash = map { $_ => $opt{'params'}->{$add_param."_$_"} }
 128                @{ $opt{'fields'} };
 129     &{ $opt{'hash_callback'} }( \%hash ) if $opt{'hash_callback'};
 130     next unless grep { $_ =~ /\S/ } values %hash;
 131
 132     my $add_obj = "FS::$table"->new( { %$hashref, %hash } );
 133     my $error = $add_obj->insert;
 134     if ( $error ) {
 135       $dbh->rollback if $oldAutoCommit;
 136       return $error;
 137     }
 138   }
 139
 140   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 141   '';
 142 }
 143
 144 sub process_o2m_qsearch  { my $self = shift; qsearch(  @_ ); }
 145 sub process_o2m_qsearchs { my $self = shift; qsearchs( @_ ); }
 146
 147 sub _load_table {
 148   my( $self, $table ) = @_;
 149   eval "use FS::$table";
 150   die $@ if $@;
 151   $table;
 152 }
 153
 154 =back
 155
 156 =head1 BUGS
 157
 158 =head1 SEE ALSO
 159
 160 L<FS::Record>
 161
 162 =cut
 163
 164 1;
 165