Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / httemplate / edit / process / cust_main.cgi
1 % if ( $error ) {
2 %   $cgi->param('error', $error);
3 %
4 <% $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string ) %>
5 %
6 % } else { 
7 %
8 <% $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new->custnum) %>
9 %
10 % }
11 <%once>
12
13 my $me = '[edit/process/cust_main.cgi]';
14 my $DEBUG = 0;
15
16 </%once>
17 <%init>
18
19 die "access denied"
20   unless $FS::CurrentUser::CurrentUser->access_right('Edit customer');
21
22 my $conf = new FS::Conf;
23
24 my $error = '';
25
26 #unmunge stuff
27
28 $cgi->param('tax','') unless defined $cgi->param('tax');
29
30 $cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] );
31
32 my $payby = $cgi->param('payby');
33
34 my %noauto = (
35   'CARD' => 'DCRD',
36   'CHEK' => 'DCHK',
37 );
38 $payby = $noauto{$payby}
39   if ! $cgi->param('payauto') && exists $noauto{$payby};
40
41 $cgi->param('payby', $payby);
42
43 if ( $payby ) {
44   if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) {
45       my $payinfo = $cgi->param('payinfo1'). '@';
46       $payinfo .= $cgi->param('payinfo3').'.' 
47             if $conf->config('echeck-country') eq 'CA';
48       $payinfo .= $cgi->param('payinfo2');
49       $cgi->param('payinfo',$payinfo);
50   }
51   $cgi->param('paydate',
52     $cgi->param( 'exp_month' ). '-'. $cgi->param( 'exp_year' ) );
53 }
54
55 my @invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') );
56 push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST');
57 push @invoicing_list, 'FAX' if $cgi->param('invoicing_list_FAX');
58 $cgi->param('invoicing_list', join(',', @invoicing_list) );
59
60 # is this actually used?  if so, we need to clone locations...
61 # but I can't find anything that sets this parameter to a non-empty value
62 $cgi->param('duplicate_of_custnum') =~ /^(\d+)$/;
63 my $duplicate_of = $1;
64
65 my %locations;
66 for my $pre (qw(bill ship)) {
67
68   my %hash;
69   foreach ( FS::cust_main->location_fields ) {
70     $hash{$_} = scalar($cgi->param($pre.'_'.$_));
71   }
72   $hash{'custnum'} = $cgi->param('custnum');
73   warn Dumper \%hash if $DEBUG;
74   # if we can qsearchs it, then it's unchanged, so use that
75   $locations{$pre} = qsearchs('cust_location', \%hash)
76                      || FS::cust_location->new( \%hash );
77
78 }
79
80 if ( ($cgi->param('same') || '') eq 'Y' ) {
81   $locations{ship} = $locations{bill};
82 }
83
84 #create new record object
85 # but explicitly avoid setting ship_ fields
86
87 my $new = new FS::cust_main ( {
88   map { ( $_, scalar($cgi->param($_)) ) } (fields('cust_main')),
89   map { ( "ship_$_", '' ) } (FS::cust_main->location_fields)
90 } );
91
92 $new->invoice_noemail( ($cgi->param('invoice_email') eq 'Y') ? '' : 'Y' );
93
94 if ( $duplicate_of ) {
95   # then negate all changes to the customer; the only change we should
96   # make is to order a package, if requested
97   $new = qsearchs('cust_main', { 'custnum' => $duplicate_of })
98   # this should never happen
99     or die "nonexistent existing customer (custnum $duplicate_of)";
100 }
101
102 for my $pre (qw(bill ship)) {
103   $new->set($pre.'_location', $locations{$pre});
104   $new->set($pre.'_locationnum', $locations{$pre}->locationnum);
105 }
106
107 if ( $cgi->param('no_credit_limit') ) {
108   $new->setfield('credit_limit', '');
109 }
110
111 $new->tagnum( [ $cgi->param('tagnum') ] );
112
113 my %usedatetime = ( 'birthdate'        => 1,
114                     'spouse_birthdate' => 1,
115                     'anniversary_date' => 1,
116                   );
117
118 foreach my $dfield (qw(
119   signupdate birthdate spouse_birthdate anniversary_date
120 )) {
121
122   if ( $cgi->param($dfield) && $cgi->param($dfield) =~ /^([ 0-9\-\/]{0,10})$/) {
123
124     my $value = $1;
125     my $parsed = '';
126
127     if ( exists $usedatetime{$dfield} && $usedatetime{$dfield} ) {
128
129       my $format = $conf->config('date_format') || "%m/%d/%Y";
130       my $parser = DateTime::Format::Strptime->new( pattern   => $format,
131                                                     time_zone => 'floating',
132                                                   );
133       my $dt = $parser->parse_datetime($value);
134       if ( $dt ) {
135         $parsed = $dt->epoch;
136       } else {
137         $error ||= "Invalid $dfield: $value";
138       }
139
140     } else {
141
142       $parsed = parse_datetime($value)
143         or $error ||= "Invalid $dfield: $value";
144
145     }
146
147     $new->setfield( $dfield, $parsed );
148     $cgi->param(    $dfield, $parsed );
149
150   }
151
152 }
153
154 $new->setfield('paid', $cgi->param('paid') )
155   if $cgi->param('paid');
156
157 my @exempt_groups = grep /\S/, $conf->config('tax-cust_exempt-groups');
158 my @tax_exempt = grep { $cgi->param("tax_$_") eq 'Y' } @exempt_groups;
159 my %tax_exempt = map { $_ => scalar($cgi->param("tax_$_".'_num')) } @tax_exempt;
160
161 #perhaps this stuff should go to cust_main.pm
162 if ( $new->custnum eq '' or $duplicate_of ) {
163
164   my $cust_pkg = '';
165   my $svc;
166
167   if ( $cgi->param('pkgpart_svcpart') ) {
168
169     my $x = $cgi->param('pkgpart_svcpart');
170     $x =~ /^(\d+)_(\d+)$/ or die "illegal pkgpart_svcpart $x\n";
171     my($pkgpart, $svcpart) = ($1, $2);
172     my $part_pkg = qsearchs('part_pkg', { 'pkgpart' => $pkgpart } );
173     #false laziness: copied from FS::cust_pkg::order (which should become a
174     #FS::cust_main method)
175     my(%part_pkg);
176     # generate %part_pkg
177     # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
178     my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum });
179
180     if ( $agent ) {
181       # $pkgpart_href->{PKGPART} is true iff $custnum may purchase $pkgpart
182       my $pkgpart_href = $agent->pkgpart_hashref
183         if $agent;
184       #eslaf
185
186       # this should wind up in FS::cust_pkg!
187       $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum.
188                  ") can't purchase pkgpart ". $pkgpart
189         #unless $part_pkg{ $pkgpart };
190         unless $pkgpart_href->{ $pkgpart }
191             || $agent->agentnum == $part_pkg->agentnum;
192     } else {
193       $error = 'Select agent';
194     }
195
196     $cust_pkg = new FS::cust_pkg ( {
197       #later         'custnum' => $custnum,
198       'pkgpart'     => $pkgpart,
199       'locationnum' => scalar($cgi->param('locationnum')),
200     } );
201
202
203     my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
204     my $svcdb = $part_svc->svcdb;
205
206     if ( $svcdb eq 'svc_acct' ) {
207
208       my %svc_acct = (
209                        'svcpart'   => $svcpart,
210                        'username'  => scalar($cgi->param('username')),
211                        '_password' => scalar($cgi->param('_password')),
212                        'popnum'    => scalar($cgi->param('popnum')),
213                      );
214       $svc_acct{'domsvc'} = $cgi->param('domsvc')
215         if $cgi->param('domsvc');
216
217       $svc = new FS::svc_acct \%svc_acct;
218
219       #and just in case you were silly
220       $svc->svcpart($svcpart);
221       $svc->username($cgi->param('username'));
222       $svc->_password($cgi->param('_password'));
223       $svc->popnum($cgi->param('popnum'));
224
225     } elsif ( $svcdb eq 'svc_phone' ) {
226
227       my %svc_phone = (
228         'svcpart' => $svcpart,
229         map { $_ => scalar($cgi->param($_)) }
230             qw( countrycode phonenum sip_password pin phone_name )
231       );
232
233       $svc = new FS::svc_phone \%svc_phone;
234
235     } elsif ( $svcdb eq 'svc_dsl' ) {
236
237       my %svc_dsl = (
238         'svcpart' => $svcpart,
239         ( map { $_ => scalar($cgi->param("ship_$_")) || scalar($cgi->param($_))}
240               qw( first last company )
241         ),
242         ( map { $_ => scalar($cgi->param($_)) }
243               qw( loop_type phonenum password isp_chg isp_prev vendor_qual_id )
244         ),
245         'desired_due_date'  => time, #XXX enter?
246         'vendor_order_type' => 'NEW',
247       );
248       $svc = new FS::svc_dsl \%svc_dsl;
249
250     } else {
251       die "$svcdb not handled on new customer yet";
252     }
253
254   }
255
256
257   use Tie::RefHash;
258   tie my %hash, 'Tie::RefHash';
259   %hash = ( $cust_pkg => [ $svc ] ) if $cust_pkg;
260   if ( $duplicate_of ) {
261     # order the package and service normally
262     $error ||= $new->order_pkgs( \%hash ) if $cust_pkg;
263   }
264   else {
265     # create the customer
266     $error ||= $new->insert( \%hash, \@invoicing_list,
267                            'tax_exemption'=> \%tax_exempt,
268                            'prospectnum'  => scalar($cgi->param('prospectnum')),
269                            );
270
271     my $conf = new FS::Conf;
272     if ( $conf->exists('backend-realtime') && ! $error ) {
273
274       my $berror =    $new->bill
275                    || $new->apply_payments_and_credits
276                    || $new->collect( 'realtime' => 1 );
277       warn "Warning, error billing during backend-realtime: $berror" if $berror;
278
279     }
280   } #if $duplicate_of
281   
282 } else { #create old record object
283
284   my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } ); 
285   $error ||= "Old record not found!" unless $old;
286
287   if ( length($old->paycvv) && $new->paycvv =~ /^\s*\*+\s*$/ ) {
288     $new->paycvv($old->paycvv);
289   }
290   if ($new->ss =~ /xx/) {
291     $new->ss($old->ss);
292   }
293   if ($new->stateid =~ /^xxx/) {
294     $new->stateid($old->stateid);
295   }
296   if ( $new->payby =~ /^(CARD|DCRD)$/
297        && (    $new->payinfo =~ /xx/
298             || $new->payinfo =~ /^\s*N\/A\s+\(tokenized\)\s*$/
299           )
300      )
301   {
302     $new->payinfo($old->payinfo);
303
304   } elsif ( $new->payby =~ /^(CHEK|DCHK)$/ && $new->payinfo =~ /xx/ ) {
305     #fix for #3085 "edit of customer's routing code only surprisingly causes
306     #nothing to happen...
307     # this probably won't do the right thing when we don't have the
308     # public key (can't actually get the real $old->payinfo)
309     my($new_account, $new_aba) = split('@', $new->payinfo);
310     my($old_account, $old_aba) = split('@', $old->payinfo);
311     $new_account = $old_account if $new_account =~ /xx/;
312     $new_aba     = $old_aba     if $new_aba     =~ /xx/;
313     $new->payinfo($new_account.'@'.$new_aba);
314   }
315
316   if ( ! $conf->exists('cust_main-edit_signupdate') or
317        ! $new->signupdate ) {
318     $new->signupdate($old->signupdate);
319   }
320
321   warn "$me calling $new -> replace( $old, \ @invoicing_list )" if $DEBUG;
322   local($FS::cust_main::DEBUG) = $DEBUG if $DEBUG;
323   local($FS::Record::DEBUG)    = $DEBUG if $DEBUG;
324
325   local($Data::Dumper::Sortkeys) = 1;
326   warn Dumper({ new => $new, old => $old }) if $DEBUG;
327
328   $error ||= $new->replace( $old, \@invoicing_list,
329                             'tax_exemption' => \%tax_exempt,
330                           );
331
332   warn "$me returned from replace" if $DEBUG;
333   
334 }
335
336 unless ( $error ) { #XXX i guess i should be transactional... all in the insert
337                     # or replace call
338   my @contact_fields = qw( classnum first last title comment emailaddress );
339   foreach my $phone_type ( qsearch({table=>'phone_type', order_by=>'weight'}) ) {
340     push @contact_fields, 'phonetypenum'.$phone_type->phonetypenum;
341   }
342
343   $error = $new->process_o2m( 'table'  => 'contact',
344                               'fields' => \@contact_fields,
345                               'params' => scalar($cgi->Vars),
346                             );
347 }
348
349 </%init>