FS/FS/m2m_Common.pm

   1 package FS::m2m_Common;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG $me );
   5 use FS::Schema qw( dbdef );
   6 use FS::Record qw( qsearch qsearchs dbh );
   7
   8 #hmm.  well.  we seem to be used as a mixin.
   9 #@ISA = qw( FS::Record );
  10
  11 $DEBUG = 0;
  12 $me = '[FS::m2m_Common]';
  13
  14 =head1 NAME
  15
  16 FS::m2m_Common - Mixin class for classes in a many-to-many relationship
  17
  18 =head1 SYNOPSIS
  19
  20 use FS::m2m_Common;
  21
  22 @ISA = qw( FS::m2m_Common FS::Record );
  23
  24 =head1 DESCRIPTION
  25
  26 FS::m2m_Common is intended as a mixin class for classes which have a
  27 many-to-many relationship with another table (via a linking table).
  28
  29 It is currently assumed that the link table contains two fields named the same
  30 as the primary keys of the base and target tables, but you can ovverride this
  31 assumption if your table is different.
  32
  33 =head1 METHODS
  34
  35 =over 4
  36
  37 =item process_m2m OPTION => VALUE, ...
  38
  39 Available options:
  40
  41 =over 4
  42
  43 =item link_table (required)
  44
  45 =item target_table (required)
  46
  47 =item params (required)
  48
  49 hashref; keys are primary key values in target_table (values are boolean).  For convenience, keys may optionally be prefixed with the name
  50 of the primary key, as in "agentnum54" instead of "54", or passed as an arrayref
  51 of values.
  52
  53 =item base_field (optional)
  54
  55 base field, defaults to primary key of this base table
  56
  57 =item target_field (optional)
  58
  59 target field, defaults to the primary key of the target table
  60
  61 =item hashref (optional)
  62
  63 static hashref further qualifying the m2m fields
  64
  65 =cut
  66
  67 sub process_m2m {
  68   my( $self, %opt ) = @_;
  69
  70   #use Data::Dumper;
  71   #warn "$me process_m2m called on $self with options:\n". Dumper(%opt)
  72   warn "$me process_m2m called on $self"
  73     if $DEBUG;
  74
  75   my $self_pkey = $self->dbdef_table->primary_key;
  76   my $base_field = $opt{'base_field'} || $self_pkey;
  77   my $hashref = $opt{'hashref'} || {};
  78   $hashref->{$base_field} = $self->$self_pkey();
  79
  80   my $link_table = $self->_load_table($opt{'link_table'});
  81
  82   my $target_table = $self->_load_table($opt{'target_table'});
  83   my $target_field = $opt{'target_field'}
  84                      || dbdef->table($target_table)->primary_key;
  85
  86   if ( ref($opt{'params'}) eq 'ARRAY' ) {
  87     $opt{'params'} = { map { $_=>1 } @{$opt{'params'}} };
  88   }
  89
  90   local $SIG{HUP} = 'IGNORE';
  91   local $SIG{INT} = 'IGNORE';
  92   local $SIG{QUIT} = 'IGNORE';
  93   local $SIG{TERM} = 'IGNORE';
  94   local $SIG{TSTP} = 'IGNORE';
  95   local $SIG{PIPE} = 'IGNORE';
  96
  97   my $oldAutoCommit = $FS::UID::AutoCommit;
  98   local $FS::UID::AutoCommit = 0;
  99   my $dbh = dbh;
 100
 101   foreach my $del_obj (
 102     grep {
 103            my $targetnum = $_->$target_field();
 104            (    ! $opt{'params'}->{$targetnum}
 105              && ! $opt{'params'}->{"$target_field$targetnum"}
 106            );
 107          }
 108          qsearch( $link_table, $hashref )
 109   ) {
 110     my $error = $del_obj->delete;
 111     if ( $error ) {
 112       $dbh->rollback if $oldAutoCommit;
 113       return $error;
 114     }
 115   }
 116
 117   foreach my $add_targetnum (
 118     grep { ! qsearchs( $link_table, { %$hashref, $target_field => $_ } ) }
 119     map  { /^($target_field)?(\d+)$/; $2; }
 120     grep { /^($target_field)?(\d+)$/ }
 121     grep { $opt{'params'}->{$_} }
 122     keys %{ $opt{'params'} }
 123   ) {
 124
 125     my $add_obj = "FS::$link_table"->new( {
 126       %$hashref,
 127       $target_field => $add_targetnum,
 128     });
 129     my $error = $add_obj->insert;
 130     if ( $error ) {
 131       $dbh->rollback if $oldAutoCommit;
 132       return $error;
 133     }
 134   }
 135
 136   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 137   '';
 138 }
 139
 140 sub _load_table {
 141   my( $self, $table ) = @_;
 142   eval "use FS::$table";
 143   die $@ if $@;
 144   $table;
 145 }
 146
 147 #=item target_table
 148 #
 149 #=cut
 150 #
 151 #sub target_table {
 152 #  my $self = shift;
 153 #  my $target_table = $self->_target_table;
 154 #  eval "use FS::$target_table";
 155 #  die $@ if $@;
 156 #  $target_table;
 157 #}
 158
 159 =back
 160
 161 =head1 BUGS
 162
 163 =head1 SEE ALSO
 164
 165 L<FS::Record>
 166
 167 =cut
 168
 169 1;
 170