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 base qw( FS::m2name_Common FS::Record );
  20
  21 =head1 DESCRIPTION
  22
  23 FS::m2name_Common is intended as a mixin class for classes which have a
  24 related table that lists names.
  25
  26 =head1 METHODS
  27
  28 =over 4
  29
  30 =item process_m2name OPTION => VALUE, ...
  31
  32 Available options:
  33
  34 link_table (required) - Table into which the records are inserted.
  35
  36 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.
  37
  38 name_col (required) - Name of the column in link_table that stores the string names.
  39
  40 names_list (required) - List reference of the possible string name values.
  41
  42 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.
  43
  44 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.
  45
  46 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.
  47
  48 =cut
  49
  50 sub process_m2name {
  51   my( $self, %opt ) = @_;
  52
  53   my $self_pkey = $self->dbdef_table->primary_key;
  54   my $link_sourcekey = $opt{'num_col'} || $self_pkey;
  55
  56   my $link_table = $self->_load_table($opt{'link_table'});
  57
  58   my $link_static = $opt{'link_static'} || {};
  59
  60   warn "$me processing m2name from ". $self->table. ".$link_sourcekey".
  61        " to $link_table\n"
  62     if $DEBUG;
  63
  64   foreach my $name ( @{ $opt{'names_list'} } ) {
  65
  66     warn "$me   checking $name\n" if $DEBUG;
  67
  68     my $name_col = $opt{'name_col'};
  69
  70     my $obj = qsearchs( $link_table, {
  71         $link_sourcekey  => $self->$self_pkey(),
  72         $name_col        => $name,
  73         %$link_static,
  74     });
  75
  76     my $param = '';
  77     my $prefix = '';
  78     if ( $opt{'param_style'} =~ /link_table.value\s+checkboxes/i ) {
  79       #access_group.html style
  80       my $paramname = "$link_table.$name";
  81       $param = $opt{'params'}->{$paramname};
  82     } elsif ( $opt{'param_style'} =~ /name_colN values/i ) {
  83       #part_event.html style
  84
  85       my @fields = grep { /^$name_col\d+$/ }
  86                         keys %{$opt{'params'}};
  87
  88       $param = grep { $name eq $opt{'params'}->{$_} } @fields;
  89
  90       if ( $param ) {
  91         #this depends on their being one condition per name...
  92         #which needs to be enforced on the edit page...
  93         #(it is on part_event and access_group edit)
  94         foreach my $field (@fields) {
  95           $prefix = "$field." if $name eq $opt{'params'}->{$field};
  96         }
  97         warn "$me     prefix $prefix\n" if $DEBUG;
  98       }
  99     } else { #??
 100       croak "unknown param_style: ". $opt{'param_style'};
 101       $param = $opt{'params'}->{$name};
 102     }
 103
 104     if ( $obj && ! $param ) {
 105
 106       warn "$me   deleting $name\n" if $DEBUG;
 107
 108       my $d_obj = $obj; #need to save $obj for below.
 109       my $error = $d_obj->delete;
 110       die "error deleting $d_obj for $link_table.$name: $error" if $error;
 111
 112     } elsif ( $param && ! $obj ) {
 113
 114       warn "$me   inserting $name\n" if $DEBUG;
 115
 116       #ok to clobber it now (but bad form nonetheless?)
 117       #$obj = new "FS::$link_table" ( {
 118       $obj = "FS::$link_table"->new( {
 119         $link_sourcekey  => $self->$self_pkey(),
 120         $opt{'name_col'} => $name,
 121         %$link_static,
 122       });
 123
 124       my @args = ();
 125       if ( $opt{'args_callback'} ) { #edit/process/part_event.html
 126         &{ $opt{'args_callback'} }( $obj,
 127                                     $prefix,
 128                                     $opt{'params'},
 129                                     \@args
 130                                   );
 131       }
 132
 133       my $error = $obj->insert( @args );
 134       die "error inserting $obj for $link_table.$name: $error" if $error;
 135
 136     } elsif ( $param && $obj && $opt{'args_callback'} ) {
 137
 138       my @args = ();
 139       if ( $opt{'args_callback'} ) { #edit/process/part_event.html
 140         &{ $opt{'args_callback'} }( $obj,
 141                                     $prefix,
 142                                     $opt{'params'},
 143                                     \@args
 144                                   );
 145       }
 146
 147       my $error = $obj->replace( $obj, @args );
 148       die "error replacing $obj for $link_table.$name: $error" if $error;
 149
 150     }
 151
 152   }
 153
 154   '';
 155 }
 156
 157 sub _load_table {
 158   my( $self, $table ) = @_;
 159   eval "use FS::$table";
 160   die $@ if $@;
 161   $table;
 162 }
 163
 164 =back
 165
 166 =head1 BUGS
 167
 168 =head1 SEE ALSO
 169
 170 L<FS::Record>
 171
 172 =cut
 173
 174 1;
 175