FS/FS/m2name_Common.pm

   1 package FS::m2name_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( qsearchs ); #qsearch dbh );
   8
   9 $DEBUG = 0;
  10
  11 $me = '[FS::m2name_Common]';
  12
  13 =head1 NAME
  14
  15 FS::m2name_Common - Mixin class for tables with a related table listing names
  16
  17 =head1 SYNOPSIS
  18
  19 use FS::m2name_Common;
  20
  21 @ISA = qw( FS::m2name_Common FS::Record );
  22
  23 =head1 DESCRIPTION
  24
  25 FS::m2name_Common is intended as a mixin class for classes which have a
  26 related table that lists names.
  27
  28 =head1 METHODS
  29
  30 =over 4
  31
  32 =item process_m2name OPTION => VALUE, ...
  33
  34 Available options:
  35
  36 link_table (required) - Table into which the records are inserted.
  37
  38 num_col (optional) - Column in link_table which links to the primary key of the base table.  If not specified, it is assumed this has the same name.
  39
  40 name_col (required) - Name of the column in link_table that stores the string names.
  41
  42 names_list (required) - List reference of the possible string name values.
  43
  44 params (required) - Hashref of keys and values, often passed as C<scalar($cgi->Vars)> from a form.  Processing is controlled by the B<param_style param> option.
  45
  46 param_style (required) - Controls processing of B<params>.  I<'link_table.value checkboxes'> specifies that parameters keys are in the form C<link_table.name>, and the values are booleans controlling whether or not to insert that name into link_table.  I<'name_colN values'> specifies that parameter keys are in the form C<name_col0>, C<name_col1>, and so on, and values are the names inserted into link_table.
  47
  48 args_callback (optional) - Coderef.  Optional callback that may modify arguments for insert and replace operations.  The callback is run with four arguments: the first argument is object being inserted or replaced (i.e. FS::I<link_table> object), the second argument is a prefix to use when retreiving CGI arguements from the params hashref, the third argument is the params hashref (see above), and the final argument is a listref of arguments that the callback should modify.
  49
  50 =cut
  51
  52 sub process_m2name {
  53   my( $self, %opt ) = @_;
  54
  55   my $self_pkey = $self->dbdef_table->primary_key;
  56   my $link_sourcekey = $opt{'num_col'} || $self_pkey;
  57
  58   my $link_table = $self->_load_table($opt{'link_table'});
  59
  60   my $link_static = $opt{'link_static'} || {};
  61
  62   warn "$me processing m2name from ". $self->table. ".$link_sourcekey".
  63        " to $link_table\n"
  64     if $DEBUG;
  65
  66   foreach my $name ( @{ $opt{'names_list'} } ) {
  67
  68     warn "$me   checking $name\n" if $DEBUG;
  69
  70     my $name_col = $opt{'name_col'};
  71
  72     my $obj = qsearchs( $link_table, {
  73         $link_sourcekey  => $self->$self_pkey(),
  74         $name_col        => $name,
  75         %$link_static,
  76     });
  77
  78     my $param = '';
  79     my $prefix = '';
  80     if ( $opt{'param_style'} =~ /link_table.value\s+checkboxes/i ) {
  81       #access_group.html style
  82       my $paramname = "$link_table.$name";
  83       $param = $opt{'params'}->{$paramname};
  84     } elsif ( $opt{'param_style'} =~ /name_colN values/i ) {
  85       #part_event.html style
  86
  87       my @fields = grep { /^$name_col\d+$/ }
  88                         keys %{$opt{'params'}};
  89
  90       $param = grep { $name eq $opt{'params'}->{$_} } @fields;
  91
  92       if ( $param ) {
  93         #this depends on their being one condition per name...
  94         #which needs to be enforced on the edit page...
  95         #(it is on part_event and access_group edit)
  96         foreach my $field (@fields) {
  97           $prefix = "$field." if $name eq $opt{'params'}->{$field};
  98         }
  99         warn "$me     prefix $prefix\n" if $DEBUG;
 100       }
 101     } else { #??
 102       croak "unknown param_style: ". $opt{'param_style'};
 103       $param = $opt{'params'}->{$name};
 104     }
 105
 106     if ( $obj && ! $param ) {
 107
 108       warn "$me   deleting $name\n" if $DEBUG;
 109
 110       my $d_obj = $obj; #need to save $obj for below.
 111       my $error = $d_obj->delete;
 112       die "error deleting $d_obj for $link_table.$name: $error" if $error;
 113
 114     } elsif ( $param && ! $obj ) {
 115
 116       warn "$me   inserting $name\n" if $DEBUG;
 117
 118       #ok to clobber it now (but bad form nonetheless?)
 119       #$obj = new "FS::$link_table" ( {
 120       $obj = "FS::$link_table"->new( {
 121         $link_sourcekey  => $self->$self_pkey(),
 122         $opt{'name_col'} => $name,
 123         %$link_static,
 124       });
 125
 126       my @args = ();
 127       if ( $opt{'args_callback'} ) { #edit/process/part_event.html
 128         &{ $opt{'args_callback'} }( $obj,
 129                                     $prefix,
 130                                     $opt{'params'},
 131                                     \@args
 132                                   );
 133       }
 134
 135       my $error = $obj->insert( @args );
 136       die "error inserting $obj for $link_table.$name: $error" if $error;
 137
 138     } elsif ( $param && $obj && $opt{'args_callback'} ) {
 139
 140       my @args = ();
 141       if ( $opt{'args_callback'} ) { #edit/process/part_event.html
 142         &{ $opt{'args_callback'} }( $obj,
 143                                     $prefix,
 144                                     $opt{'params'},
 145                                     \@args
 146                                   );
 147       }
 148
 149       my $error = $obj->replace( $obj, @args );
 150       die "error replacing $obj for $link_table.$name: $error" if $error;
 151
 152     }
 153
 154   }
 155
 156   '';
 157 }
 158
 159 sub _load_table {
 160   my( $self, $table ) = @_;
 161   eval "use FS::$table";
 162   die $@ if $@;
 163   $table;
 164 }
 165
 166 =back
 167
 168 =head1 BUGS
 169
 170 =head1 SEE ALSO
 171
 172 L<FS::Record>
 173
 174 =cut
 175
 176 1;
 177