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 num_col (optional) - Column in table which links to the primary key of the base table.  If not specified, it is assumed this has the same name.
  39
  40 params (required) - Hashref of keys and values, often passed as C<scalar($cgi->Vars)> from a form.
  41
  42 fields (required) - Arrayref of field names for each record in table.  Pulled from params as "pkeyNN_field" where pkey is table's primary key and NN is the entry's numeric identifier.
  43
  44 =cut
  45
  46 #a little more false laziness w/m2m_Common.pm than m2_name_Common.pm
  47 # still, far from the worse of it.  at least we're a reuable mixin!
  48 sub process_o2m {
  49   my( $self, %opt ) = @_;
  50
  51   my $self_pkey = $self->dbdef_table->primary_key;
  52   my $link_sourcekey = $opt{'num_col'} || $self_pkey;
  53
  54   my $hashref = {}; #$opt{'hashref'} || {};
  55   $hashref->{$link_sourcekey} = $self->$self_pkey();
  56
  57   my $table = $self->_load_table($opt{'table'});
  58   my $table_pkey = dbdef->table($table)->primary_key;
  59
  60 #  my $link_static = $opt{'link_static'} || {};
  61
  62   warn "$me processing o2m from ". $self->table. ".$link_sourcekey".
  63        " to $table\n"
  64     if $DEBUG;
  65
  66   #if ( ref($opt{'params'}) eq 'ARRAY' ) {
  67   #  $opt{'params'} = { map { $_=>1 } @{$opt{'params'}} };
  68   #}
  69
  70   local $SIG{HUP} = 'IGNORE';
  71   local $SIG{INT} = 'IGNORE';
  72   local $SIG{QUIT} = 'IGNORE';
  73   local $SIG{TERM} = 'IGNORE';
  74   local $SIG{TSTP} = 'IGNORE';
  75   local $SIG{PIPE} = 'IGNORE';
  76
  77   my $oldAutoCommit = $FS::UID::AutoCommit;
  78   local $FS::UID::AutoCommit = 0;
  79   my $dbh = dbh;
  80
  81   my @fields = grep { /^$table_pkey\d+$/ }
  82                keys %{ $opt{'params'} };
  83
  84   my %edits = map  { $opt{'params'}->{$_} => $_ }
  85               grep { $opt{'params'}->{$_} }
  86               @fields;
  87
  88   foreach my $del_obj (
  89     grep { ! $edits{$_->$table_pkey()} }
  90          qsearch( $table, $hashref )
  91   ) {
  92     my $error = $del_obj->delete;
  93     if ( $error ) {
  94       $dbh->rollback if $oldAutoCommit;
  95       return $error;
  96     }
  97   }
  98
  99   foreach my $pkey_value ( keys %edits ) {
 100     my $old_obj = qsearchs( $table, { %$hashref, $table_pkey => $pkey_value } ),
 101     my $add_param = $edits{$pkey_value};
 102     my %hash = ( $table_pkey => $pkey_value,
 103                  map { $_ => $opt{'params'}->{$add_param."_$_"} }
 104                      @{ $opt{'fields'} }
 105                );
 106     #next unless grep { $_ =~ /\S/ } values %hash;
 107
 108     my $new_obj = "FS::$table"->new( { %$hashref, %hash } );
 109     my $error = $new_obj->replace($old_obj);
 110     if ( $error ) {
 111       $dbh->rollback if $oldAutoCommit;
 112       return $error;
 113     }
 114   }
 115
 116   foreach my $add_param ( grep { ! $opt{'params'}->{$_} } @fields ) {
 117
 118     my %hash = map { $_ => $opt{'params'}->{$add_param."_$_"} }
 119                @{ $opt{'fields'} };
 120     next unless grep { $_ =~ /\S/ } values %hash;
 121
 122     my $add_obj = "FS::$table"->new( { %$hashref, %hash } );
 123     my $error = $add_obj->insert;
 124     if ( $error ) {
 125       $dbh->rollback if $oldAutoCommit;
 126       return $error;
 127     }
 128   }
 129
 130   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 131   '';
 132 }
 133
 134 sub _load_table {
 135   my( $self, $table ) = @_;
 136   eval "use FS::$table";
 137   die $@ if $@;
 138   $table;
 139 }
 140
 141 =back
 142
 143 =head1 BUGS
 144
 145 =head1 SEE ALSO
 146
 147 L<FS::Record>
 148
 149 =cut
 150
 151 1;
 152