a1bb926b3216a79780a529318bfb2f34390a3ea9
[freeside.git] / FS / FS / cust_main.pm
1 package FS::cust_main;
2
3 require 5.006;
4 use strict;
5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
6              $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
7 use vars qw( $realtime_bop_decline_quiet ); #ugh
8 use Safe;
9 use Carp;
10 use Exporter;
11 use Scalar::Util qw( blessed );
12 use Time::Local qw(timelocal);
13 use Data::Dumper;
14 use Tie::IxHash;
15 use Digest::MD5 qw(md5_base64);
16 use Date::Format;
17 #use Date::Manip;
18 use File::Temp qw( tempfile );
19 use String::Approx qw(amatch);
20 use Business::CreditCard 0.28;
21 use Locale::Country;
22 use FS::UID qw( getotaker dbh driver_name );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( generate_email send_email generate_ps do_print );
25 use FS::Msgcat qw(gettext);
26 use FS::payby;
27 use FS::cust_pkg;
28 use FS::cust_svc;
29 use FS::cust_bill;
30 use FS::cust_bill_pkg;
31 use FS::cust_bill_pkg_display;
32 use FS::cust_bill_pkg_tax_location;
33 use FS::cust_bill_pkg_tax_rate_location;
34 use FS::cust_pay;
35 use FS::cust_pay_pending;
36 use FS::cust_pay_void;
37 use FS::cust_pay_batch;
38 use FS::cust_credit;
39 use FS::cust_refund;
40 use FS::part_referral;
41 use FS::cust_main_county;
42 use FS::cust_location;
43 use FS::tax_rate;
44 use FS::tax_rate_location;
45 use FS::cust_tax_location;
46 use FS::part_pkg_taxrate;
47 use FS::agent;
48 use FS::cust_main_invoice;
49 use FS::cust_credit_bill;
50 use FS::cust_bill_pay;
51 use FS::prepay_credit;
52 use FS::queue;
53 use FS::part_pkg;
54 use FS::part_event;
55 use FS::part_event_condition;
56 #use FS::cust_event;
57 use FS::type_pkgs;
58 use FS::payment_gateway;
59 use FS::agent_payment_gateway;
60 use FS::banned_pay;
61 use FS::payinfo_Mixin;
62 use FS::TicketSystem;
63
64 @ISA = qw( FS::payinfo_Mixin FS::Record );
65
66 @EXPORT_OK = qw( smart_search );
67
68 $realtime_bop_decline_quiet = 0;
69
70 # 1 is mostly method/subroutine entry and options
71 # 2 traces progress of some operations
72 # 3 is even more information including possibly sensitive data
73 $DEBUG = 0;
74 $me = '[FS::cust_main]';
75
76 $import = 0;
77 $skip_fuzzyfiles = 0;
78 $ignore_expired_card = 0;
79
80 @encrypted_fields = ('payinfo', 'paycvv');
81 sub nohistory_fields { ('paycvv'); }
82
83 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
84
85 #ask FS::UID to run this stuff for us later
86 #$FS::UID::callback{'FS::cust_main'} = sub { 
87 install_callback FS::UID sub { 
88   $conf = new FS::Conf;
89   #yes, need it for stuff below (prolly should be cached)
90 };
91
92 sub _cache {
93   my $self = shift;
94   my ( $hashref, $cache ) = @_;
95   if ( exists $hashref->{'pkgnum'} ) {
96     #@{ $self->{'_pkgnum'} } = ();
97     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
98     $self->{'_pkgnum'} = $subcache;
99     #push @{ $self->{'_pkgnum'} },
100     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
101   }
102 }
103
104 =head1 NAME
105
106 FS::cust_main - Object methods for cust_main records
107
108 =head1 SYNOPSIS
109
110   use FS::cust_main;
111
112   $record = new FS::cust_main \%hash;
113   $record = new FS::cust_main { 'column' => 'value' };
114
115   $error = $record->insert;
116
117   $error = $new_record->replace($old_record);
118
119   $error = $record->delete;
120
121   $error = $record->check;
122
123   @cust_pkg = $record->all_pkgs;
124
125   @cust_pkg = $record->ncancelled_pkgs;
126
127   @cust_pkg = $record->suspended_pkgs;
128
129   $error = $record->bill;
130   $error = $record->bill %options;
131   $error = $record->bill 'time' => $time;
132
133   $error = $record->collect;
134   $error = $record->collect %options;
135   $error = $record->collect 'invoice_time'   => $time,
136                           ;
137
138 =head1 DESCRIPTION
139
140 An FS::cust_main object represents a customer.  FS::cust_main inherits from 
141 FS::Record.  The following fields are currently supported:
142
143 =over 4
144
145 =item custnum
146
147 Primary key (assigned automatically for new customers)
148
149 =item agentnum
150
151 Agent (see L<FS::agent>)
152
153 =item refnum
154
155 Advertising source (see L<FS::part_referral>)
156
157 =item first
158
159 First name
160
161 =item last
162
163 Last name
164
165 =item ss
166
167 Cocial security number (optional)
168
169 =item company
170
171 (optional)
172
173 =item address1
174
175 =item address2
176
177 (optional)
178
179 =item city
180
181 =item county
182
183 (optional, see L<FS::cust_main_county>)
184
185 =item state
186
187 (see L<FS::cust_main_county>)
188
189 =item zip
190
191 =item country
192
193 (see L<FS::cust_main_county>)
194
195 =item daytime
196
197 phone (optional)
198
199 =item night
200
201 phone (optional)
202
203 =item fax
204
205 phone (optional)
206
207 =item ship_first
208
209 Shipping first name
210
211 =item ship_last
212
213 Shipping last name
214
215 =item ship_company
216
217 (optional)
218
219 =item ship_address1
220
221 =item ship_address2
222
223 (optional)
224
225 =item ship_city
226
227 =item ship_county
228
229 (optional, see L<FS::cust_main_county>)
230
231 =item ship_state
232
233 (see L<FS::cust_main_county>)
234
235 =item ship_zip
236
237 =item ship_country
238
239 (see L<FS::cust_main_county>)
240
241 =item ship_daytime
242
243 phone (optional)
244
245 =item ship_night
246
247 phone (optional)
248
249 =item ship_fax
250
251 phone (optional)
252
253 =item payby
254
255 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
256
257 =item payinfo
258
259 Payment Information (See L<FS::payinfo_Mixin> for data format)
260
261 =item paymask
262
263 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
264
265 =item paycvv
266
267 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
268
269 =item paydate
270
271 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
272
273 =item paystart_month
274
275 Start date month (maestro/solo cards only)
276
277 =item paystart_year
278
279 Start date year (maestro/solo cards only)
280
281 =item payissue
282
283 Issue number (maestro/solo cards only)
284
285 =item payname
286
287 Name on card or billing name
288
289 =item payip
290
291 IP address from which payment information was received
292
293 =item tax
294
295 Tax exempt, empty or `Y'
296
297 =item otaker
298
299 Order taker (assigned automatically, see L<FS::UID>)
300
301 =item comments
302
303 Comments (optional)
304
305 =item referral_custnum
306
307 Referring customer number
308
309 =item spool_cdr
310
311 Enable individual CDR spooling, empty or `Y'
312
313 =item dundate
314
315 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
316
317 =item squelch_cdr
318
319 Discourage individual CDR printing, empty or `Y'
320
321 =back
322
323 =head1 METHODS
324
325 =over 4
326
327 =item new HASHREF
328
329 Creates a new customer.  To add the customer to the database, see L<"insert">.
330
331 Note that this stores the hash reference, not a distinct copy of the hash it
332 points to.  You can ask the object for a copy with the I<hash> method.
333
334 =cut
335
336 sub table { 'cust_main'; }
337
338 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
339
340 Adds this customer to the database.  If there is an error, returns the error,
341 otherwise returns false.
342
343 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
344 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
345 are inserted atomicly, or the transaction is rolled back.  Passing an empty
346 hash reference is equivalent to not supplying this parameter.  There should be
347 a better explanation of this, but until then, here's an example:
348
349   use Tie::RefHash;
350   tie %hash, 'Tie::RefHash'; #this part is important
351   %hash = (
352     $cust_pkg => [ $svc_acct ],
353     ...
354   );
355   $cust_main->insert( \%hash );
356
357 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
358 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
359 expected and rollback the entire transaction; it is not necessary to call 
360 check_invoicing_list first.  The invoicing_list is set after the records in the
361 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
362 invoicing_list destination to the newly-created svc_acct.  Here's an example:
363
364   $cust_main->insert( {}, [ $email, 'POST' ] );
365
366 Currently available options are: I<depend_jobnum> and I<noexport>.
367
368 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
369 on the supplied jobnum (they will not run until the specific job completes).
370 This can be used to defer provisioning until some action completes (such
371 as running the customer's credit card successfully).
372
373 The I<noexport> option is deprecated.  If I<noexport> is set true, no
374 provisioning jobs (exports) are scheduled.  (You can schedule them later with
375 the B<reexport> method.)
376
377 =cut
378
379 sub insert {
380   my $self = shift;
381   my $cust_pkgs = @_ ? shift : {};
382   my $invoicing_list = @_ ? shift : '';
383   my %options = @_;
384   warn "$me insert called with options ".
385        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
386     if $DEBUG;
387
388   local $SIG{HUP} = 'IGNORE';
389   local $SIG{INT} = 'IGNORE';
390   local $SIG{QUIT} = 'IGNORE';
391   local $SIG{TERM} = 'IGNORE';
392   local $SIG{TSTP} = 'IGNORE';
393   local $SIG{PIPE} = 'IGNORE';
394
395   my $oldAutoCommit = $FS::UID::AutoCommit;
396   local $FS::UID::AutoCommit = 0;
397   my $dbh = dbh;
398
399   my $prepay_identifier = '';
400   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
401   my $payby = '';
402   if ( $self->payby eq 'PREPAY' ) {
403
404     $self->payby('BILL');
405     $prepay_identifier = $self->payinfo;
406     $self->payinfo('');
407
408     warn "  looking up prepaid card $prepay_identifier\n"
409       if $DEBUG > 1;
410
411     my $error = $self->get_prepay( $prepay_identifier,
412                                    'amount_ref'     => \$amount,
413                                    'seconds_ref'    => \$seconds,
414                                    'upbytes_ref'    => \$upbytes,
415                                    'downbytes_ref'  => \$downbytes,
416                                    'totalbytes_ref' => \$totalbytes,
417                                  );
418     if ( $error ) {
419       $dbh->rollback if $oldAutoCommit;
420       #return "error applying prepaid card (transaction rolled back): $error";
421       return $error;
422     }
423
424     $payby = 'PREP' if $amount;
425
426   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
427
428     $payby = $1;
429     $self->payby('BILL');
430     $amount = $self->paid;
431
432   }
433
434   warn "  inserting $self\n"
435     if $DEBUG > 1;
436
437   $self->signupdate(time) unless $self->signupdate;
438
439   $self->auto_agent_custid()
440     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
441
442   my $error = $self->SUPER::insert;
443   if ( $error ) {
444     $dbh->rollback if $oldAutoCommit;
445     #return "inserting cust_main record (transaction rolled back): $error";
446     return $error;
447   }
448
449   warn "  setting invoicing list\n"
450     if $DEBUG > 1;
451
452   if ( $invoicing_list ) {
453     $error = $self->check_invoicing_list( $invoicing_list );
454     if ( $error ) {
455       $dbh->rollback if $oldAutoCommit;
456       #return "checking invoicing_list (transaction rolled back): $error";
457       return $error;
458     }
459     $self->invoicing_list( $invoicing_list );
460   }
461
462   if (    $conf->config('cust_main-skeleton_tables')
463        && $conf->config('cust_main-skeleton_custnum') ) {
464
465     warn "  inserting skeleton records\n"
466       if $DEBUG > 1;
467
468     my $error = $self->start_copy_skel;
469     if ( $error ) {
470       $dbh->rollback if $oldAutoCommit;
471       return $error;
472     }
473
474   }
475
476   warn "  ordering packages\n"
477     if $DEBUG > 1;
478
479   $error = $self->order_pkgs( $cust_pkgs,
480                               %options,
481                               'seconds_ref'    => \$seconds,
482                               'upbytes_ref'    => \$upbytes,
483                               'downbytes_ref'  => \$downbytes,
484                               'totalbytes_ref' => \$totalbytes,
485                             );
486   if ( $error ) {
487     $dbh->rollback if $oldAutoCommit;
488     return $error;
489   }
490
491   if ( $seconds ) {
492     $dbh->rollback if $oldAutoCommit;
493     return "No svc_acct record to apply pre-paid time";
494   }
495   if ( $upbytes || $downbytes || $totalbytes ) {
496     $dbh->rollback if $oldAutoCommit;
497     return "No svc_acct record to apply pre-paid data";
498   }
499
500   if ( $amount ) {
501     warn "  inserting initial $payby payment of $amount\n"
502       if $DEBUG > 1;
503     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
504     if ( $error ) {
505       $dbh->rollback if $oldAutoCommit;
506       return "inserting payment (transaction rolled back): $error";
507     }
508   }
509
510   unless ( $import || $skip_fuzzyfiles ) {
511     warn "  queueing fuzzyfiles update\n"
512       if $DEBUG > 1;
513     $error = $self->queue_fuzzyfiles_update;
514     if ( $error ) {
515       $dbh->rollback if $oldAutoCommit;
516       return "updating fuzzy search cache: $error";
517     }
518   }
519
520   warn "  insert complete; committing transaction\n"
521     if $DEBUG > 1;
522
523   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
524   '';
525
526 }
527
528 use File::CounterFile;
529 sub auto_agent_custid {
530   my $self = shift;
531
532   my $format = $conf->config('cust_main-auto_agent_custid');
533   my $agent_custid;
534   if ( $format eq '1YMMXXXXXXXX' ) {
535
536     my $counter = new File::CounterFile 'cust_main.agent_custid';
537     $counter->lock;
538
539     my $ym = 100000000000 + time2str('%y%m00000000', time);
540     if ( $ym > $counter->value ) {
541       $counter->{'value'} = $agent_custid = $ym;
542       $counter->{'updated'} = 1;
543     } else {
544       $agent_custid = $counter->inc;
545     }
546
547     $counter->unlock;
548
549   } else {
550     die "Unknown cust_main-auto_agent_custid format: $format";
551   }
552
553   $self->agent_custid($agent_custid);
554
555 }
556
557 sub start_copy_skel {
558   my $self = shift;
559
560   #'mg_user_preference' => {},
561   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
562   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
563   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
564   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
565   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
566   die $@ if $@;
567
568   _copy_skel( 'cust_main',                                 #tablename
569               $conf->config('cust_main-skeleton_custnum'), #sourceid
570               $self->custnum,                              #destid
571               @tables,                                     #child tables
572             );
573 }
574
575 #recursive subroutine, not a method
576 sub _copy_skel {
577   my( $table, $sourceid, $destid, %child_tables ) = @_;
578
579   my $primary_key;
580   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
581     ( $table, $primary_key ) = ( $1, $2 );
582   } else {
583     my $dbdef_table = dbdef->table($table);
584     $primary_key = $dbdef_table->primary_key
585       or return "$table has no primary key".
586                 " (or do you need to run dbdef-create?)";
587   }
588
589   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
590        join (', ', keys %child_tables). "\n"
591     if $DEBUG > 2;
592
593   foreach my $child_table_def ( keys %child_tables ) {
594
595     my $child_table;
596     my $child_pkey = '';
597     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
598       ( $child_table, $child_pkey ) = ( $1, $2 );
599     } else {
600       $child_table = $child_table_def;
601
602       $child_pkey = dbdef->table($child_table)->primary_key;
603       #  or return "$table has no primary key".
604       #            " (or do you need to run dbdef-create?)\n";
605     }
606
607     my $sequence = '';
608     if ( keys %{ $child_tables{$child_table_def} } ) {
609
610       return "$child_table has no primary key".
611              " (run dbdef-create or try specifying it?)\n"
612         unless $child_pkey;
613
614       #false laziness w/Record::insert and only works on Pg
615       #refactor the proper last-inserted-id stuff out of Record::insert if this
616       # ever gets use for anything besides a quick kludge for one customer
617       my $default = dbdef->table($child_table)->column($child_pkey)->default;
618       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
619         or return "can't parse $child_table.$child_pkey default value ".
620                   " for sequence name: $default";
621       $sequence = $1;
622
623     }
624   
625     my @sel_columns = grep { $_ ne $primary_key }
626                            dbdef->table($child_table)->columns;
627     my $sel_columns = join(', ', @sel_columns );
628
629     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
630     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
631     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
632
633     my $sel_st = "SELECT $sel_columns FROM $child_table".
634                  " WHERE $primary_key = $sourceid";
635     warn "    $sel_st\n"
636       if $DEBUG > 2;
637     my $sel_sth = dbh->prepare( $sel_st )
638       or return dbh->errstr;
639   
640     $sel_sth->execute or return $sel_sth->errstr;
641
642     while ( my $row = $sel_sth->fetchrow_hashref ) {
643
644       warn "    selected row: ".
645            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
646         if $DEBUG > 2;
647
648       my $statement =
649         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
650       my $ins_sth =dbh->prepare($statement)
651           or return dbh->errstr;
652       my @param = ( $destid, map $row->{$_}, @ins_columns );
653       warn "    $statement: [ ". join(', ', @param). " ]\n"
654         if $DEBUG > 2;
655       $ins_sth->execute( @param )
656         or return $ins_sth->errstr;
657
658       #next unless keys %{ $child_tables{$child_table} };
659       next unless $sequence;
660       
661       #another section of that laziness
662       my $seq_sql = "SELECT currval('$sequence')";
663       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
664       $seq_sth->execute or return $seq_sth->errstr;
665       my $insertid = $seq_sth->fetchrow_arrayref->[0];
666   
667       # don't drink soap!  recurse!  recurse!  okay!
668       my $error =
669         _copy_skel( $child_table_def,
670                     $row->{$child_pkey}, #sourceid
671                     $insertid, #destid
672                     %{ $child_tables{$child_table_def} },
673                   );
674       return $error if $error;
675
676     }
677
678   }
679
680   return '';
681
682 }
683
684 =item order_pkg HASHREF | OPTION => VALUE ... 
685
686 Orders a single package.
687
688 Options may be passed as a list of key/value pairs or as a hash reference.
689 Options are:
690
691 =over 4
692
693 =item cust_pkg
694
695 FS::cust_pkg object
696
697 =item cust_location
698
699 Optional FS::cust_location object
700
701 =item svcs
702
703 Optional arryaref of FS::svc_* service objects.
704
705 =item depend_jobnum
706
707 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
708 jobs will have a dependancy on the supplied job (they will not run until the
709 specific job completes).  This can be used to defer provisioning until some
710 action completes (such as running the customer's credit card successfully).
711
712 =back
713
714 =cut
715
716 sub order_pkg {
717   my $self = shift;
718   my $opt = ref($_[0]) ? shift : { @_ };
719
720   warn "$me order_pkg called with options ".
721        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
722     if $DEBUG;
723
724   my $cust_pkg = $opt->{'cust_pkg'};
725   my $svcs     = $opt->{'svcs'} || [];
726
727   my %svc_options = ();
728   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
729     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
730
731   local $SIG{HUP} = 'IGNORE';
732   local $SIG{INT} = 'IGNORE';
733   local $SIG{QUIT} = 'IGNORE';
734   local $SIG{TERM} = 'IGNORE';
735   local $SIG{TSTP} = 'IGNORE';
736   local $SIG{PIPE} = 'IGNORE';
737
738   my $oldAutoCommit = $FS::UID::AutoCommit;
739   local $FS::UID::AutoCommit = 0;
740   my $dbh = dbh;
741
742   if ( $opt->{'cust_location'} &&
743        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
744     my $error = $opt->{'cust_location'}->insert;
745     if ( $error ) {
746       $dbh->rollback if $oldAutoCommit;
747       return "inserting cust_location (transaction rolled back): $error";
748     }
749     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
750   }
751
752   $cust_pkg->custnum( $self->custnum );
753
754   my $error = $cust_pkg->insert;
755   if ( $error ) {
756     $dbh->rollback if $oldAutoCommit;
757     return "inserting cust_pkg (transaction rolled back): $error";
758   }
759
760   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
761     if ( $svc_something->svcnum ) {
762       my $old_cust_svc = $svc_something->cust_svc;
763       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
764       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
765       $error = $new_cust_svc->replace($old_cust_svc);
766     } else {
767       $svc_something->pkgnum( $cust_pkg->pkgnum );
768       if ( $svc_something->isa('FS::svc_acct') ) {
769         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
770                        qw( seconds upbytes downbytes totalbytes )      ) {
771           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
772           ${ $opt->{$_.'_ref'} } = 0;
773         }
774       }
775       $error = $svc_something->insert(%svc_options);
776     }
777     if ( $error ) {
778       $dbh->rollback if $oldAutoCommit;
779       return "inserting svc_ (transaction rolled back): $error";
780     }
781   }
782
783   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
784   ''; #no error
785
786 }
787
788 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
789 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
790
791 Like the insert method on an existing record, this method orders multiple
792 packages and included services atomicaly.  Pass a Tie::RefHash data structure
793 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
794 There should be a better explanation of this, but until then, here's an
795 example:
796
797   use Tie::RefHash;
798   tie %hash, 'Tie::RefHash'; #this part is important
799   %hash = (
800     $cust_pkg => [ $svc_acct ],
801     ...
802   );
803   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
804
805 Services can be new, in which case they are inserted, or existing unaudited
806 services, in which case they are linked to the newly-created package.
807
808 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
809 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
810
811 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
812 on the supplied jobnum (they will not run until the specific job completes).
813 This can be used to defer provisioning until some action completes (such
814 as running the customer's credit card successfully).
815
816 The I<noexport> option is deprecated.  If I<noexport> is set true, no
817 provisioning jobs (exports) are scheduled.  (You can schedule them later with
818 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
819 on the cust_main object is not recommended, as existing services will also be
820 reexported.)
821
822 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
823 provided, the scalars (provided by references) will be incremented by the
824 values of the prepaid card.`
825
826 =cut
827
828 sub order_pkgs {
829   my $self = shift;
830   my $cust_pkgs = shift;
831   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
832   my %options = @_;
833   $seconds_ref ||= $options{'seconds_ref'};
834
835   warn "$me order_pkgs called with options ".
836        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
837     if $DEBUG;
838
839   local $SIG{HUP} = 'IGNORE';
840   local $SIG{INT} = 'IGNORE';
841   local $SIG{QUIT} = 'IGNORE';
842   local $SIG{TERM} = 'IGNORE';
843   local $SIG{TSTP} = 'IGNORE';
844   local $SIG{PIPE} = 'IGNORE';
845
846   my $oldAutoCommit = $FS::UID::AutoCommit;
847   local $FS::UID::AutoCommit = 0;
848   my $dbh = dbh;
849
850   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
851
852   foreach my $cust_pkg ( keys %$cust_pkgs ) {
853
854     my $error = $self->order_pkg(
855       'cust_pkg'     => $cust_pkg,
856       'svcs'         => $cust_pkgs->{$cust_pkg},
857       'seconds_ref'  => $seconds_ref,
858       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
859                                      depend_jobnum
860                                    )
861     );
862     if ( $error ) {
863       $dbh->rollback if $oldAutoCommit;
864       return $error;
865     }
866
867   }
868
869   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
870   ''; #no error
871 }
872
873 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
874
875 Recharges this (existing) customer with the specified prepaid card (see
876 L<FS::prepay_credit>), specified either by I<identifier> or as an
877 FS::prepay_credit object.  If there is an error, returns the error, otherwise
878 returns false.
879
880 Optionally, five scalar references can be passed as well.  They will have their
881 values filled in with the amount, number of seconds, and number of upload,
882 download, and total bytes applied by this prepaid card.
883
884 =cut
885
886 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
887 #the only place that uses these args
888 sub recharge_prepay { 
889   my( $self, $prepay_credit, $amountref, $secondsref, 
890       $upbytesref, $downbytesref, $totalbytesref ) = @_;
891
892   local $SIG{HUP} = 'IGNORE';
893   local $SIG{INT} = 'IGNORE';
894   local $SIG{QUIT} = 'IGNORE';
895   local $SIG{TERM} = 'IGNORE';
896   local $SIG{TSTP} = 'IGNORE';
897   local $SIG{PIPE} = 'IGNORE';
898
899   my $oldAutoCommit = $FS::UID::AutoCommit;
900   local $FS::UID::AutoCommit = 0;
901   my $dbh = dbh;
902
903   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
904
905   my $error = $self->get_prepay( $prepay_credit,
906                                  'amount_ref'     => \$amount,
907                                  'seconds_ref'    => \$seconds,
908                                  'upbytes_ref'    => \$upbytes,
909                                  'downbytes_ref'  => \$downbytes,
910                                  'totalbytes_ref' => \$totalbytes,
911                                )
912            || $self->increment_seconds($seconds)
913            || $self->increment_upbytes($upbytes)
914            || $self->increment_downbytes($downbytes)
915            || $self->increment_totalbytes($totalbytes)
916            || $self->insert_cust_pay_prepay( $amount,
917                                              ref($prepay_credit)
918                                                ? $prepay_credit->identifier
919                                                : $prepay_credit
920                                            );
921
922   if ( $error ) {
923     $dbh->rollback if $oldAutoCommit;
924     return $error;
925   }
926
927   if ( defined($amountref)  ) { $$amountref  = $amount;  }
928   if ( defined($secondsref) ) { $$secondsref = $seconds; }
929   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
930   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
931   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
932
933   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
934   '';
935
936 }
937
938 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
939
940 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
941 specified either by I<identifier> or as an FS::prepay_credit object.
942
943 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.  The scalars (provided by references) will be
944 incremented by the values of the prepaid card.
945
946 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
947 check or set this customer's I<agentnum>.
948
949 If there is an error, returns the error, otherwise returns false.
950
951 =cut
952
953
954 sub get_prepay {
955   my( $self, $prepay_credit, %opt ) = @_;
956
957   local $SIG{HUP} = 'IGNORE';
958   local $SIG{INT} = 'IGNORE';
959   local $SIG{QUIT} = 'IGNORE';
960   local $SIG{TERM} = 'IGNORE';
961   local $SIG{TSTP} = 'IGNORE';
962   local $SIG{PIPE} = 'IGNORE';
963
964   my $oldAutoCommit = $FS::UID::AutoCommit;
965   local $FS::UID::AutoCommit = 0;
966   my $dbh = dbh;
967
968   unless ( ref($prepay_credit) ) {
969
970     my $identifier = $prepay_credit;
971
972     $prepay_credit = qsearchs(
973       'prepay_credit',
974       { 'identifier' => $prepay_credit },
975       '',
976       'FOR UPDATE'
977     );
978
979     unless ( $prepay_credit ) {
980       $dbh->rollback if $oldAutoCommit;
981       return "Invalid prepaid card: ". $identifier;
982     }
983
984   }
985
986   if ( $prepay_credit->agentnum ) {
987     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
988       $dbh->rollback if $oldAutoCommit;
989       return "prepaid card not valid for agent ". $self->agentnum;
990     }
991     $self->agentnum($prepay_credit->agentnum);
992   }
993
994   my $error = $prepay_credit->delete;
995   if ( $error ) {
996     $dbh->rollback if $oldAutoCommit;
997     return "removing prepay_credit (transaction rolled back): $error";
998   }
999
1000   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1001     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1002
1003   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1004   '';
1005
1006 }
1007
1008 =item increment_upbytes SECONDS
1009
1010 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1011 the specified number of upbytes.  If there is an error, returns the error,
1012 otherwise returns false.
1013
1014 =cut
1015
1016 sub increment_upbytes {
1017   _increment_column( shift, 'upbytes', @_);
1018 }
1019
1020 =item increment_downbytes SECONDS
1021
1022 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1023 the specified number of downbytes.  If there is an error, returns the error,
1024 otherwise returns false.
1025
1026 =cut
1027
1028 sub increment_downbytes {
1029   _increment_column( shift, 'downbytes', @_);
1030 }
1031
1032 =item increment_totalbytes SECONDS
1033
1034 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1035 the specified number of totalbytes.  If there is an error, returns the error,
1036 otherwise returns false.
1037
1038 =cut
1039
1040 sub increment_totalbytes {
1041   _increment_column( shift, 'totalbytes', @_);
1042 }
1043
1044 =item increment_seconds SECONDS
1045
1046 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1047 the specified number of seconds.  If there is an error, returns the error,
1048 otherwise returns false.
1049
1050 =cut
1051
1052 sub increment_seconds {
1053   _increment_column( shift, 'seconds', @_);
1054 }
1055
1056 =item _increment_column AMOUNT
1057
1058 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1059 the specified number of seconds or bytes.  If there is an error, returns
1060 the error, otherwise returns false.
1061
1062 =cut
1063
1064 sub _increment_column {
1065   my( $self, $column, $amount ) = @_;
1066   warn "$me increment_column called: $column, $amount\n"
1067     if $DEBUG;
1068
1069   return '' unless $amount;
1070
1071   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1072                       $self->ncancelled_pkgs;
1073
1074   if ( ! @cust_pkg ) {
1075     return 'No packages with primary or single services found'.
1076            ' to apply pre-paid time';
1077   } elsif ( scalar(@cust_pkg) > 1 ) {
1078     #maybe have a way to specify the package/account?
1079     return 'Multiple packages found to apply pre-paid time';
1080   }
1081
1082   my $cust_pkg = $cust_pkg[0];
1083   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1084     if $DEBUG > 1;
1085
1086   my @cust_svc =
1087     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1088
1089   if ( ! @cust_svc ) {
1090     return 'No account found to apply pre-paid time';
1091   } elsif ( scalar(@cust_svc) > 1 ) {
1092     return 'Multiple accounts found to apply pre-paid time';
1093   }
1094   
1095   my $svc_acct = $cust_svc[0]->svc_x;
1096   warn "  found service svcnum ". $svc_acct->pkgnum.
1097        ' ('. $svc_acct->email. ")\n"
1098     if $DEBUG > 1;
1099
1100   $column = "increment_$column";
1101   $svc_acct->$column($amount);
1102
1103 }
1104
1105 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1106
1107 Inserts a prepayment in the specified amount for this customer.  An optional
1108 second argument can specify the prepayment identifier for tracking purposes.
1109 If there is an error, returns the error, otherwise returns false.
1110
1111 =cut
1112
1113 sub insert_cust_pay_prepay {
1114   shift->insert_cust_pay('PREP', @_);
1115 }
1116
1117 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1118
1119 Inserts a cash payment in the specified amount for this customer.  An optional
1120 second argument can specify the payment identifier for tracking purposes.
1121 If there is an error, returns the error, otherwise returns false.
1122
1123 =cut
1124
1125 sub insert_cust_pay_cash {
1126   shift->insert_cust_pay('CASH', @_);
1127 }
1128
1129 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1130
1131 Inserts a Western Union payment in the specified amount for this customer.  An
1132 optional second argument can specify the prepayment identifier for tracking
1133 purposes.  If there is an error, returns the error, otherwise returns false.
1134
1135 =cut
1136
1137 sub insert_cust_pay_west {
1138   shift->insert_cust_pay('WEST', @_);
1139 }
1140
1141 sub insert_cust_pay {
1142   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1143   my $payinfo = scalar(@_) ? shift : '';
1144
1145   my $cust_pay = new FS::cust_pay {
1146     'custnum' => $self->custnum,
1147     'paid'    => sprintf('%.2f', $amount),
1148     #'_date'   => #date the prepaid card was purchased???
1149     'payby'   => $payby,
1150     'payinfo' => $payinfo,
1151   };
1152   $cust_pay->insert;
1153
1154 }
1155
1156 =item reexport
1157
1158 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1159 order_pkgs methods for a better way to defer provisioning.
1160
1161 Re-schedules all exports by calling the B<reexport> method of all associated
1162 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1163 otherwise returns false.
1164
1165 =cut
1166
1167 sub reexport {
1168   my $self = shift;
1169
1170   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1171        "use the depend_jobnum option to insert or order_pkgs to delay export";
1172
1173   local $SIG{HUP} = 'IGNORE';
1174   local $SIG{INT} = 'IGNORE';
1175   local $SIG{QUIT} = 'IGNORE';
1176   local $SIG{TERM} = 'IGNORE';
1177   local $SIG{TSTP} = 'IGNORE';
1178   local $SIG{PIPE} = 'IGNORE';
1179
1180   my $oldAutoCommit = $FS::UID::AutoCommit;
1181   local $FS::UID::AutoCommit = 0;
1182   my $dbh = dbh;
1183
1184   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1185     my $error = $cust_pkg->reexport;
1186     if ( $error ) {
1187       $dbh->rollback if $oldAutoCommit;
1188       return $error;
1189     }
1190   }
1191
1192   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1193   '';
1194
1195 }
1196
1197 =item delete NEW_CUSTNUM
1198
1199 This deletes the customer.  If there is an error, returns the error, otherwise
1200 returns false.
1201
1202 This will completely remove all traces of the customer record.  This is not
1203 what you want when a customer cancels service; for that, cancel all of the
1204 customer's packages (see L</cancel>).
1205
1206 If the customer has any uncancelled packages, you need to pass a new (valid)
1207 customer number for those packages to be transferred to.  Cancelled packages
1208 will be deleted.  Did I mention that this is NOT what you want when a customer
1209 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1210
1211 You can't delete a customer with invoices (see L<FS::cust_bill>),
1212 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1213 refunds (see L<FS::cust_refund>).
1214
1215 =cut
1216
1217 sub delete {
1218   my $self = shift;
1219
1220   local $SIG{HUP} = 'IGNORE';
1221   local $SIG{INT} = 'IGNORE';
1222   local $SIG{QUIT} = 'IGNORE';
1223   local $SIG{TERM} = 'IGNORE';
1224   local $SIG{TSTP} = 'IGNORE';
1225   local $SIG{PIPE} = 'IGNORE';
1226
1227   my $oldAutoCommit = $FS::UID::AutoCommit;
1228   local $FS::UID::AutoCommit = 0;
1229   my $dbh = dbh;
1230
1231   if ( $self->cust_bill ) {
1232     $dbh->rollback if $oldAutoCommit;
1233     return "Can't delete a customer with invoices";
1234   }
1235   if ( $self->cust_credit ) {
1236     $dbh->rollback if $oldAutoCommit;
1237     return "Can't delete a customer with credits";
1238   }
1239   if ( $self->cust_pay ) {
1240     $dbh->rollback if $oldAutoCommit;
1241     return "Can't delete a customer with payments";
1242   }
1243   if ( $self->cust_refund ) {
1244     $dbh->rollback if $oldAutoCommit;
1245     return "Can't delete a customer with refunds";
1246   }
1247
1248   my @cust_pkg = $self->ncancelled_pkgs;
1249   if ( @cust_pkg ) {
1250     my $new_custnum = shift;
1251     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1252       $dbh->rollback if $oldAutoCommit;
1253       return "Invalid new customer number: $new_custnum";
1254     }
1255     foreach my $cust_pkg ( @cust_pkg ) {
1256       my %hash = $cust_pkg->hash;
1257       $hash{'custnum'} = $new_custnum;
1258       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1259       my $error = $new_cust_pkg->replace($cust_pkg,
1260                                          options => { $cust_pkg->options },
1261                                         );
1262       if ( $error ) {
1263         $dbh->rollback if $oldAutoCommit;
1264         return $error;
1265       }
1266     }
1267   }
1268   my @cancelled_cust_pkg = $self->all_pkgs;
1269   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1270     my $error = $cust_pkg->delete;
1271     if ( $error ) {
1272       $dbh->rollback if $oldAutoCommit;
1273       return $error;
1274     }
1275   }
1276
1277   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1278     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1279   ) {
1280     my $error = $cust_main_invoice->delete;
1281     if ( $error ) {
1282       $dbh->rollback if $oldAutoCommit;
1283       return $error;
1284     }
1285   }
1286
1287   my $error = $self->SUPER::delete;
1288   if ( $error ) {
1289     $dbh->rollback if $oldAutoCommit;
1290     return $error;
1291   }
1292
1293   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1294   '';
1295
1296 }
1297
1298 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1299
1300 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1301 returns the error, otherwise returns false.
1302
1303 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1304 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1305 expected and rollback the entire transaction; it is not necessary to call 
1306 check_invoicing_list first.  Here's an example:
1307
1308   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1309
1310 =cut
1311
1312 sub replace {
1313   my $self = shift;
1314
1315   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1316               ? shift
1317               : $self->replace_old;
1318
1319   my @param = @_;
1320
1321   warn "$me replace called\n"
1322     if $DEBUG;
1323
1324   my $curuser = $FS::CurrentUser::CurrentUser;
1325   if (    $self->payby eq 'COMP'
1326        && $self->payby ne $old->payby
1327        && ! $curuser->access_right('Complimentary customer')
1328      )
1329   {
1330     return "You are not permitted to create complimentary accounts.";
1331   }
1332
1333   local($ignore_expired_card) = 1
1334     if $old->payby  =~ /^(CARD|DCRD)$/
1335     && $self->payby =~ /^(CARD|DCRD)$/
1336     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1337
1338   local $SIG{HUP} = 'IGNORE';
1339   local $SIG{INT} = 'IGNORE';
1340   local $SIG{QUIT} = 'IGNORE';
1341   local $SIG{TERM} = 'IGNORE';
1342   local $SIG{TSTP} = 'IGNORE';
1343   local $SIG{PIPE} = 'IGNORE';
1344
1345   my $oldAutoCommit = $FS::UID::AutoCommit;
1346   local $FS::UID::AutoCommit = 0;
1347   my $dbh = dbh;
1348
1349   my $error = $self->SUPER::replace($old);
1350
1351   if ( $error ) {
1352     $dbh->rollback if $oldAutoCommit;
1353     return $error;
1354   }
1355
1356   if ( @param ) { # INVOICING_LIST_ARYREF
1357     my $invoicing_list = shift @param;
1358     $error = $self->check_invoicing_list( $invoicing_list );
1359     if ( $error ) {
1360       $dbh->rollback if $oldAutoCommit;
1361       return $error;
1362     }
1363     $self->invoicing_list( $invoicing_list );
1364   }
1365
1366   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1367        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1368     # card/check/lec info has changed, want to retry realtime_ invoice events
1369     my $error = $self->retry_realtime;
1370     if ( $error ) {
1371       $dbh->rollback if $oldAutoCommit;
1372       return $error;
1373     }
1374   }
1375
1376   unless ( $import || $skip_fuzzyfiles ) {
1377     $error = $self->queue_fuzzyfiles_update;
1378     if ( $error ) {
1379       $dbh->rollback if $oldAutoCommit;
1380       return "updating fuzzy search cache: $error";
1381     }
1382   }
1383
1384   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1385   '';
1386
1387 }
1388
1389 =item queue_fuzzyfiles_update
1390
1391 Used by insert & replace to update the fuzzy search cache
1392
1393 =cut
1394
1395 sub queue_fuzzyfiles_update {
1396   my $self = shift;
1397
1398   local $SIG{HUP} = 'IGNORE';
1399   local $SIG{INT} = 'IGNORE';
1400   local $SIG{QUIT} = 'IGNORE';
1401   local $SIG{TERM} = 'IGNORE';
1402   local $SIG{TSTP} = 'IGNORE';
1403   local $SIG{PIPE} = 'IGNORE';
1404
1405   my $oldAutoCommit = $FS::UID::AutoCommit;
1406   local $FS::UID::AutoCommit = 0;
1407   my $dbh = dbh;
1408
1409   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1410   my $error = $queue->insert( map $self->getfield($_),
1411                                   qw(first last company)
1412                             );
1413   if ( $error ) {
1414     $dbh->rollback if $oldAutoCommit;
1415     return "queueing job (transaction rolled back): $error";
1416   }
1417
1418   if ( $self->ship_last ) {
1419     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1420     $error = $queue->insert( map $self->getfield("ship_$_"),
1421                                  qw(first last company)
1422                            );
1423     if ( $error ) {
1424       $dbh->rollback if $oldAutoCommit;
1425       return "queueing job (transaction rolled back): $error";
1426     }
1427   }
1428
1429   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1430   '';
1431
1432 }
1433
1434 =item check
1435
1436 Checks all fields to make sure this is a valid customer record.  If there is
1437 an error, returns the error, otherwise returns false.  Called by the insert
1438 and replace methods.
1439
1440 =cut
1441
1442 sub check {
1443   my $self = shift;
1444
1445   warn "$me check BEFORE: \n". $self->_dump
1446     if $DEBUG > 2;
1447
1448   my $error =
1449     $self->ut_numbern('custnum')
1450     || $self->ut_number('agentnum')
1451     || $self->ut_textn('agent_custid')
1452     || $self->ut_number('refnum')
1453     || $self->ut_textn('custbatch')
1454     || $self->ut_name('last')
1455     || $self->ut_name('first')
1456     || $self->ut_snumbern('birthdate')
1457     || $self->ut_snumbern('signupdate')
1458     || $self->ut_textn('company')
1459     || $self->ut_text('address1')
1460     || $self->ut_textn('address2')
1461     || $self->ut_text('city')
1462     || $self->ut_textn('county')
1463     || $self->ut_textn('state')
1464     || $self->ut_country('country')
1465     || $self->ut_anything('comments')
1466     || $self->ut_numbern('referral_custnum')
1467     || $self->ut_textn('stateid')
1468     || $self->ut_textn('stateid_state')
1469     || $self->ut_textn('invoice_terms')
1470     || $self->ut_alphan('geocode')
1471   ;
1472
1473   #barf.  need message catalogs.  i18n.  etc.
1474   $error .= "Please select an advertising source."
1475     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1476   return $error if $error;
1477
1478   return "Unknown agent"
1479     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1480
1481   return "Unknown refnum"
1482     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1483
1484   return "Unknown referring custnum: ". $self->referral_custnum
1485     unless ! $self->referral_custnum 
1486            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1487
1488   if ( $self->ss eq '' ) {
1489     $self->ss('');
1490   } else {
1491     my $ss = $self->ss;
1492     $ss =~ s/\D//g;
1493     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1494       or return "Illegal social security number: ". $self->ss;
1495     $self->ss("$1-$2-$3");
1496   }
1497
1498
1499 # bad idea to disable, causes billing to fail because of no tax rates later
1500 #  unless ( $import ) {
1501     unless ( qsearch('cust_main_county', {
1502       'country' => $self->country,
1503       'state'   => '',
1504      } ) ) {
1505       return "Unknown state/county/country: ".
1506         $self->state. "/". $self->county. "/". $self->country
1507         unless qsearch('cust_main_county',{
1508           'state'   => $self->state,
1509           'county'  => $self->county,
1510           'country' => $self->country,
1511         } );
1512     }
1513 #  }
1514
1515   $error =
1516     $self->ut_phonen('daytime', $self->country)
1517     || $self->ut_phonen('night', $self->country)
1518     || $self->ut_phonen('fax', $self->country)
1519     || $self->ut_zip('zip', $self->country)
1520   ;
1521   return $error if $error;
1522
1523   if ( $conf->exists('cust_main-require_phone')
1524        && ! length($self->daytime) && ! length($self->night)
1525      ) {
1526
1527     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1528                           ? 'Day Phone'
1529                           : FS::Msgcat::_gettext('daytime');
1530     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1531                         ? 'Night Phone'
1532                         : FS::Msgcat::_gettext('night');
1533   
1534     return "$daytime_label or $night_label is required"
1535   
1536   }
1537
1538   if ( $self->has_ship_address
1539        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1540                         $self->addr_fields )
1541      )
1542   {
1543     my $error =
1544       $self->ut_name('ship_last')
1545       || $self->ut_name('ship_first')
1546       || $self->ut_textn('ship_company')
1547       || $self->ut_text('ship_address1')
1548       || $self->ut_textn('ship_address2')
1549       || $self->ut_text('ship_city')
1550       || $self->ut_textn('ship_county')
1551       || $self->ut_textn('ship_state')
1552       || $self->ut_country('ship_country')
1553     ;
1554     return $error if $error;
1555
1556     #false laziness with above
1557     unless ( qsearchs('cust_main_county', {
1558       'country' => $self->ship_country,
1559       'state'   => '',
1560      } ) ) {
1561       return "Unknown ship_state/ship_county/ship_country: ".
1562         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1563         unless qsearch('cust_main_county',{
1564           'state'   => $self->ship_state,
1565           'county'  => $self->ship_county,
1566           'country' => $self->ship_country,
1567         } );
1568     }
1569     #eofalse
1570
1571     $error =
1572       $self->ut_phonen('ship_daytime', $self->ship_country)
1573       || $self->ut_phonen('ship_night', $self->ship_country)
1574       || $self->ut_phonen('ship_fax', $self->ship_country)
1575       || $self->ut_zip('ship_zip', $self->ship_country)
1576     ;
1577     return $error if $error;
1578
1579     return "Unit # is required."
1580       if $self->ship_address2 =~ /^\s*$/
1581       && $conf->exists('cust_main-require_address2');
1582
1583   } else { # ship_ info eq billing info, so don't store dup info in database
1584
1585     $self->setfield("ship_$_", '')
1586       foreach $self->addr_fields;
1587
1588     return "Unit # is required."
1589       if $self->address2 =~ /^\s*$/
1590       && $conf->exists('cust_main-require_address2');
1591
1592   }
1593
1594   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1595   #  or return "Illegal payby: ". $self->payby;
1596   #$self->payby($1);
1597   FS::payby->can_payby($self->table, $self->payby)
1598     or return "Illegal payby: ". $self->payby;
1599
1600   $error =    $self->ut_numbern('paystart_month')
1601            || $self->ut_numbern('paystart_year')
1602            || $self->ut_numbern('payissue')
1603            || $self->ut_textn('paytype')
1604   ;
1605   return $error if $error;
1606
1607   if ( $self->payip eq '' ) {
1608     $self->payip('');
1609   } else {
1610     $error = $self->ut_ip('payip');
1611     return $error if $error;
1612   }
1613
1614   # If it is encrypted and the private key is not availaible then we can't
1615   # check the credit card.
1616
1617   my $check_payinfo = 1;
1618
1619   if ($self->is_encrypted($self->payinfo)) {
1620     $check_payinfo = 0;
1621   }
1622
1623   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1624
1625     my $payinfo = $self->payinfo;
1626     $payinfo =~ s/\D//g;
1627     $payinfo =~ /^(\d{13,16})$/
1628       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1629     $payinfo = $1;
1630     $self->payinfo($payinfo);
1631     validate($payinfo)
1632       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1633
1634     return gettext('unknown_card_type')
1635       if cardtype($self->payinfo) eq "Unknown";
1636
1637     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1638     if ( $ban ) {
1639       return 'Banned credit card: banned on '.
1640              time2str('%a %h %o at %r', $ban->_date).
1641              ' by '. $ban->otaker.
1642              ' (ban# '. $ban->bannum. ')';
1643     }
1644
1645     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1646       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1647         $self->paycvv =~ /^(\d{4})$/
1648           or return "CVV2 (CID) for American Express cards is four digits.";
1649         $self->paycvv($1);
1650       } else {
1651         $self->paycvv =~ /^(\d{3})$/
1652           or return "CVV2 (CVC2/CID) is three digits.";
1653         $self->paycvv($1);
1654       }
1655     } else {
1656       $self->paycvv('');
1657     }
1658
1659     my $cardtype = cardtype($payinfo);
1660     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1661
1662       return "Start date or issue number is required for $cardtype cards"
1663         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1664
1665       return "Start month must be between 1 and 12"
1666         if $self->paystart_month
1667            and $self->paystart_month < 1 || $self->paystart_month > 12;
1668
1669       return "Start year must be 1990 or later"
1670         if $self->paystart_year
1671            and $self->paystart_year < 1990;
1672
1673       return "Issue number must be beween 1 and 99"
1674         if $self->payissue
1675           and $self->payissue < 1 || $self->payissue > 99;
1676
1677     } else {
1678       $self->paystart_month('');
1679       $self->paystart_year('');
1680       $self->payissue('');
1681     }
1682
1683   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1684
1685     my $payinfo = $self->payinfo;
1686     $payinfo =~ s/[^\d\@]//g;
1687     if ( $conf->exists('echeck-nonus') ) {
1688       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1689       $payinfo = "$1\@$2";
1690     } else {
1691       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1692       $payinfo = "$1\@$2";
1693     }
1694     $self->payinfo($payinfo);
1695     $self->paycvv('');
1696
1697     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1698     if ( $ban ) {
1699       return 'Banned ACH account: banned on '.
1700              time2str('%a %h %o at %r', $ban->_date).
1701              ' by '. $ban->otaker.
1702              ' (ban# '. $ban->bannum. ')';
1703     }
1704
1705   } elsif ( $self->payby eq 'LECB' ) {
1706
1707     my $payinfo = $self->payinfo;
1708     $payinfo =~ s/\D//g;
1709     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1710     $payinfo = $1;
1711     $self->payinfo($payinfo);
1712     $self->paycvv('');
1713
1714   } elsif ( $self->payby eq 'BILL' ) {
1715
1716     $error = $self->ut_textn('payinfo');
1717     return "Illegal P.O. number: ". $self->payinfo if $error;
1718     $self->paycvv('');
1719
1720   } elsif ( $self->payby eq 'COMP' ) {
1721
1722     my $curuser = $FS::CurrentUser::CurrentUser;
1723     if (    ! $self->custnum
1724          && ! $curuser->access_right('Complimentary customer')
1725        )
1726     {
1727       return "You are not permitted to create complimentary accounts."
1728     }
1729
1730     $error = $self->ut_textn('payinfo');
1731     return "Illegal comp account issuer: ". $self->payinfo if $error;
1732     $self->paycvv('');
1733
1734   } elsif ( $self->payby eq 'PREPAY' ) {
1735
1736     my $payinfo = $self->payinfo;
1737     $payinfo =~ s/\W//g; #anything else would just confuse things
1738     $self->payinfo($payinfo);
1739     $error = $self->ut_alpha('payinfo');
1740     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1741     return "Unknown prepayment identifier"
1742       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1743     $self->paycvv('');
1744
1745   }
1746
1747   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1748     return "Expiration date required"
1749       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1750     $self->paydate('');
1751   } else {
1752     my( $m, $y );
1753     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1754       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1755     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1756       ( $m, $y ) = ( $3, "20$2" );
1757     } else {
1758       return "Illegal expiration date: ". $self->paydate;
1759     }
1760     $self->paydate("$y-$m-01");
1761     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1762     return gettext('expired_card')
1763       if !$import
1764       && !$ignore_expired_card 
1765       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1766   }
1767
1768   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1769        ( ! $conf->exists('require_cardname')
1770          || $self->payby !~ /^(CARD|DCRD)$/  ) 
1771   ) {
1772     $self->payname( $self->first. " ". $self->getfield('last') );
1773   } else {
1774     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1775       or return gettext('illegal_name'). " payname: ". $self->payname;
1776     $self->payname($1);
1777   }
1778
1779   foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) {
1780     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1781     $self->$flag($1);
1782   }
1783
1784   $self->otaker(getotaker) unless $self->otaker;
1785
1786   warn "$me check AFTER: \n". $self->_dump
1787     if $DEBUG > 2;
1788
1789   $self->SUPER::check;
1790 }
1791
1792 =item addr_fields 
1793
1794 Returns a list of fields which have ship_ duplicates.
1795
1796 =cut
1797
1798 sub addr_fields {
1799   qw( last first company
1800       address1 address2 city county state zip country
1801       daytime night fax
1802     );
1803 }
1804
1805 =item has_ship_address
1806
1807 Returns true if this customer record has a separate shipping address.
1808
1809 =cut
1810
1811 sub has_ship_address {
1812   my $self = shift;
1813   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1814 }
1815
1816 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1817
1818 Returns all packages (see L<FS::cust_pkg>) for this customer.
1819
1820 =cut
1821
1822 sub all_pkgs {
1823   my $self = shift;
1824   my $extra_qsearch = ref($_[0]) ? shift : {};
1825
1826   return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
1827
1828   my @cust_pkg = ();
1829   if ( $self->{'_pkgnum'} ) {
1830     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1831   } else {
1832     @cust_pkg = $self->_cust_pkg($extra_qsearch);
1833   }
1834
1835   sort sort_packages @cust_pkg;
1836 }
1837
1838 =item cust_pkg
1839
1840 Synonym for B<all_pkgs>.
1841
1842 =cut
1843
1844 sub cust_pkg {
1845   shift->all_pkgs(@_);
1846 }
1847
1848 =item cust_location
1849
1850 Returns all locations (see L<FS::cust_location>) for this customer.
1851
1852 =cut
1853
1854 sub cust_location {
1855   my $self = shift;
1856   qsearch('cust_location', { 'custnum' => $self->custnum } );
1857 }
1858
1859 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
1860
1861 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1862
1863 =cut
1864
1865 sub ncancelled_pkgs {
1866   my $self = shift;
1867   my $extra_qsearch = ref($_[0]) ? shift : {};
1868
1869   return $self->num_ncancelled_pkgs unless wantarray;
1870
1871   my @cust_pkg = ();
1872   if ( $self->{'_pkgnum'} ) {
1873
1874     warn "$me ncancelled_pkgs: returning cached objects"
1875       if $DEBUG > 1;
1876
1877     @cust_pkg = grep { ! $_->getfield('cancel') }
1878                 values %{ $self->{'_pkgnum'}->cache };
1879
1880   } else {
1881
1882     warn "$me ncancelled_pkgs: searching for packages with custnum ".
1883          $self->custnum. "\n"
1884       if $DEBUG > 1;
1885
1886     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
1887
1888     @cust_pkg = $self->_cust_pkg($extra_qsearch);
1889
1890   }
1891
1892   sort sort_packages @cust_pkg;
1893
1894 }
1895
1896 sub _cust_pkg {
1897   my $self = shift;
1898   my $extra_qsearch = ref($_[0]) ? shift : {};
1899
1900   $extra_qsearch->{'select'} ||= '*';
1901   $extra_qsearch->{'select'} .=
1902    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
1903      AS _num_cust_svc';
1904
1905   map {
1906         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
1907         $_;
1908       }
1909   qsearch({
1910     %$extra_qsearch,
1911     'table'   => 'cust_pkg',
1912     'hashref' => { 'custnum' => $self->custnum },
1913   });
1914
1915 }
1916
1917 # This should be generalized to use config options to determine order.
1918 sub sort_packages {
1919   
1920   if ( $a->get('cancel') xor $b->get('cancel') ) {
1921     return -1 if $b->get('cancel');
1922     return  1 if $a->get('cancel');
1923     #shouldn't get here...
1924     return 0;
1925   } else {
1926     my $a_num_cust_svc = $a->num_cust_svc;
1927     my $b_num_cust_svc = $b->num_cust_svc;
1928     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
1929     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
1930     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
1931     my @a_cust_svc = $a->cust_svc;
1932     my @b_cust_svc = $b->cust_svc;
1933     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
1934   }
1935
1936 }
1937
1938 =item suspended_pkgs
1939
1940 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1941
1942 =cut
1943
1944 sub suspended_pkgs {
1945   my $self = shift;
1946   grep { $_->susp } $self->ncancelled_pkgs;
1947 }
1948
1949 =item unflagged_suspended_pkgs
1950
1951 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1952 customer (thouse packages without the `manual_flag' set).
1953
1954 =cut
1955
1956 sub unflagged_suspended_pkgs {
1957   my $self = shift;
1958   return $self->suspended_pkgs
1959     unless dbdef->table('cust_pkg')->column('manual_flag');
1960   grep { ! $_->manual_flag } $self->suspended_pkgs;
1961 }
1962
1963 =item unsuspended_pkgs
1964
1965 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1966 this customer.
1967
1968 =cut
1969
1970 sub unsuspended_pkgs {
1971   my $self = shift;
1972   grep { ! $_->susp } $self->ncancelled_pkgs;
1973 }
1974
1975 =item num_cancelled_pkgs
1976
1977 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1978 customer.
1979
1980 =cut
1981
1982 sub num_cancelled_pkgs {
1983   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1984 }
1985
1986 sub num_ncancelled_pkgs {
1987   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1988 }
1989
1990 sub num_pkgs {
1991   my( $self ) = shift;
1992   my $sql = scalar(@_) ? shift : '';
1993   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1994   my $sth = dbh->prepare(
1995     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1996   ) or die dbh->errstr;
1997   $sth->execute($self->custnum) or die $sth->errstr;
1998   $sth->fetchrow_arrayref->[0];
1999 }
2000
2001 =item unsuspend
2002
2003 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2004 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2005 on success or a list of errors.
2006
2007 =cut
2008
2009 sub unsuspend {
2010   my $self = shift;
2011   grep { $_->unsuspend } $self->suspended_pkgs;
2012 }
2013
2014 =item suspend
2015
2016 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2017
2018 Returns a list: an empty list on success or a list of errors.
2019
2020 =cut
2021
2022 sub suspend {
2023   my $self = shift;
2024   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2025 }
2026
2027 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2028
2029 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2030 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2031 of a list of pkgparts; the hashref has the following keys:
2032
2033 =over 4
2034
2035 =item pkgparts - listref of pkgparts
2036
2037 =item (other options are passed to the suspend method)
2038
2039 =back
2040
2041
2042 Returns a list: an empty list on success or a list of errors.
2043
2044 =cut
2045
2046 sub suspend_if_pkgpart {
2047   my $self = shift;
2048   my (@pkgparts, %opt);
2049   if (ref($_[0]) eq 'HASH'){
2050     @pkgparts = @{$_[0]{pkgparts}};
2051     %opt      = %{$_[0]};
2052   }else{
2053     @pkgparts = @_;
2054   }
2055   grep { $_->suspend(%opt) }
2056     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2057       $self->unsuspended_pkgs;
2058 }
2059
2060 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2061
2062 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2063 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2064 instead of a list of pkgparts; the hashref has the following keys:
2065
2066 =over 4
2067
2068 =item pkgparts - listref of pkgparts
2069
2070 =item (other options are passed to the suspend method)
2071
2072 =back
2073
2074 Returns a list: an empty list on success or a list of errors.
2075
2076 =cut
2077
2078 sub suspend_unless_pkgpart {
2079   my $self = shift;
2080   my (@pkgparts, %opt);
2081   if (ref($_[0]) eq 'HASH'){
2082     @pkgparts = @{$_[0]{pkgparts}};
2083     %opt      = %{$_[0]};
2084   }else{
2085     @pkgparts = @_;
2086   }
2087   grep { $_->suspend(%opt) }
2088     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2089       $self->unsuspended_pkgs;
2090 }
2091
2092 =item cancel [ OPTION => VALUE ... ]
2093
2094 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2095
2096 Available options are:
2097
2098 =over 4
2099
2100 =item quiet - can be set true to supress email cancellation notices.
2101
2102 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2103
2104 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2105
2106 =back
2107
2108 Always returns a list: an empty list on success or a list of errors.
2109
2110 =cut
2111
2112 sub cancel {
2113   my( $self, %opt ) = @_;
2114
2115   warn "$me cancel called on customer ". $self->custnum. " with options ".
2116        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2117     if $DEBUG;
2118
2119   return ( 'access denied' )
2120     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2121
2122   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2123
2124     #should try decryption (we might have the private key)
2125     # and if not maybe queue a job for the server that does?
2126     return ( "Can't (yet) ban encrypted credit cards" )
2127       if $self->is_encrypted($self->payinfo);
2128
2129     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2130     my $error = $ban->insert;
2131     return ( $error ) if $error;
2132
2133   }
2134
2135   my @pkgs = $self->ncancelled_pkgs;
2136
2137   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2138        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2139     if $DEBUG;
2140
2141   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2142 }
2143
2144 sub _banned_pay_hashref {
2145   my $self = shift;
2146
2147   my %payby2ban = (
2148     'CARD' => 'CARD',
2149     'DCRD' => 'CARD',
2150     'CHEK' => 'CHEK',
2151     'DCHK' => 'CHEK'
2152   );
2153
2154   {
2155     'payby'   => $payby2ban{$self->payby},
2156     'payinfo' => md5_base64($self->payinfo),
2157     #don't ever *search* on reason! #'reason'  =>
2158   };
2159 }
2160
2161 =item notes
2162
2163 Returns all notes (see L<FS::cust_main_note>) for this customer.
2164
2165 =cut
2166
2167 sub notes {
2168   my $self = shift;
2169   #order by?
2170   qsearch( 'cust_main_note',
2171            { 'custnum' => $self->custnum },
2172            '',
2173            'ORDER BY _DATE DESC'
2174          );
2175 }
2176
2177 =item agent
2178
2179 Returns the agent (see L<FS::agent>) for this customer.
2180
2181 =cut
2182
2183 sub agent {
2184   my $self = shift;
2185   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2186 }
2187
2188 =item bill_and_collect 
2189
2190 Cancels and suspends any packages due, generates bills, applies payments and
2191 cred
2192
2193 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
2194
2195 Options are passed as name-value pairs.  Currently available options are:
2196
2197 =over 4
2198
2199 =item time
2200
2201 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
2202
2203  use Date::Parse;
2204  ...
2205  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2206
2207 =item invoice_time
2208
2209 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2210
2211 =item check_freq
2212
2213 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2214
2215 =item resetup
2216
2217 If set true, re-charges setup fees.
2218
2219 =item debug
2220
2221 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2222
2223 =back
2224
2225 =cut
2226
2227 sub bill_and_collect {
2228   my( $self, %options ) = @_;
2229
2230   #$options{actual_time} not $options{time} because freeside-daily -d is for
2231   #pre-printing invoices
2232   $self->cancel_expired_pkgs( $options{actual_time} );
2233   $self->suspend_adjourned_pkgs( $options{actual_time} );
2234
2235   my $error = $self->bill( %options );
2236   warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2237
2238   $self->apply_payments_and_credits;
2239
2240   unless ( $conf->exists('cancelled_cust-noevents')
2241            && ! $self->num_ncancelled_pkgs
2242   ) {
2243
2244     $error = $self->collect( %options );
2245     warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2246
2247   }
2248
2249 }
2250
2251 sub cancel_expired_pkgs {
2252   my ( $self, $time ) = @_;
2253
2254   my @cancel_pkgs = grep { $_->expire && $_->expire <= $time }
2255                          $self->ncancelled_pkgs;
2256
2257   foreach my $cust_pkg ( @cancel_pkgs ) {
2258     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2259     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
2260                                            'reason_otaker' => $cpr->otaker
2261                                          )
2262                                        : ()
2263                                  );
2264     warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2265          " for custnum ". $self->custnum. ": $error"
2266       if $error;
2267   }
2268
2269 }
2270
2271 sub suspend_adjourned_pkgs {
2272   my ( $self, $time ) = @_;
2273
2274   my @susp_pkgs = 
2275     grep { ! $_->susp
2276            && (    (    $_->part_pkg->is_prepaid
2277                      && $_->bill
2278                      && $_->bill < $time
2279                    )
2280                 || (    $_->adjourn
2281                     && $_->adjourn <= $time
2282                   )
2283               )
2284          }
2285          $self->ncancelled_pkgs;
2286
2287   foreach my $cust_pkg ( @susp_pkgs ) {
2288     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2289       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2290     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2291                                             'reason_otaker' => $cpr->otaker
2292                                           )
2293                                         : ()
2294                                   );
2295
2296     warn "Error suspending package ". $cust_pkg->pkgnum.
2297          " for custnum ". $self->custnum. ": $error"
2298       if $error;
2299   }
2300
2301 }
2302
2303 =item bill OPTIONS
2304
2305 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2306 conjunction with the collect method by calling B<bill_and_collect>.
2307
2308 If there is an error, returns the error, otherwise returns false.
2309
2310 Options are passed as name-value pairs.  Currently available options are:
2311
2312 =over 4
2313
2314 =item resetup
2315
2316 If set true, re-charges setup fees.
2317
2318 =item time
2319
2320 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
2321
2322  use Date::Parse;
2323  ...
2324  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2325
2326 =item pkg_list
2327
2328 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2329
2330  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2331
2332 =item invoice_time
2333
2334 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2335
2336 =back
2337
2338 =cut
2339
2340 sub bill {
2341   my( $self, %options ) = @_;
2342   return '' if $self->payby eq 'COMP';
2343   warn "$me bill customer ". $self->custnum. "\n"
2344     if $DEBUG;
2345
2346   my $time = $options{'time'} || time;
2347   my $invoice_time = $options{'invoice_time'} || $time;
2348
2349   #put below somehow?
2350   local $SIG{HUP} = 'IGNORE';
2351   local $SIG{INT} = 'IGNORE';
2352   local $SIG{QUIT} = 'IGNORE';
2353   local $SIG{TERM} = 'IGNORE';
2354   local $SIG{TSTP} = 'IGNORE';
2355   local $SIG{PIPE} = 'IGNORE';
2356
2357   my $oldAutoCommit = $FS::UID::AutoCommit;
2358   local $FS::UID::AutoCommit = 0;
2359   my $dbh = dbh;
2360
2361   $self->select_for_update; #mutex
2362
2363   my @cust_bill_pkg = ();
2364
2365   ###
2366   # find the packages which are due for billing, find out how much they are
2367   # & generate invoice database.
2368   ###
2369
2370   my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2371   my %taxlisthash;
2372   my @precommit_hooks = ();
2373
2374   my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2375   foreach my $cust_pkg (@cust_pkgs) {
2376
2377     #NO!! next if $cust_pkg->cancel;  
2378     next if $cust_pkg->getfield('cancel');  
2379
2380     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2381
2382     #? to avoid use of uninitialized value errors... ?
2383     $cust_pkg->setfield('bill', '')
2384       unless defined($cust_pkg->bill);
2385  
2386     #my $part_pkg = $cust_pkg->part_pkg;
2387
2388     my $real_pkgpart = $cust_pkg->pkgpart;
2389     my %hash = $cust_pkg->hash;
2390
2391     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2392
2393       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2394
2395       my $error =
2396         $self->_make_lines( 'part_pkg'            => $part_pkg,
2397                             'cust_pkg'            => $cust_pkg,
2398                             'precommit_hooks'     => \@precommit_hooks,
2399                             'line_items'          => \@cust_bill_pkg,
2400                             'setup'               => \$total_setup,
2401                             'recur'               => \$total_recur,
2402                             'tax_matrix'          => \%taxlisthash,
2403                             'time'                => $time,
2404                             'options'             => \%options,
2405                           );
2406       if ($error) {
2407         $dbh->rollback if $oldAutoCommit;
2408         return $error;
2409       }
2410
2411     } #foreach my $part_pkg
2412
2413   } #foreach my $cust_pkg
2414
2415   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2416     #but do commit any package date cycling that happened
2417     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2418     return '';
2419   }
2420
2421   my $postal_pkg = $self->charge_postal_fee();
2422   if ( $postal_pkg && !ref( $postal_pkg ) ) {
2423     $dbh->rollback if $oldAutoCommit;
2424     return "can't charge postal invoice fee for customer ".
2425       $self->custnum. ": $postal_pkg";
2426   }
2427   if ( $postal_pkg &&
2428        ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2429          !$conf->exists('postal_invoice-recurring_only')
2430        )
2431      )
2432   {
2433     foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2434       my $error =
2435         $self->_make_lines( 'part_pkg'            => $part_pkg,
2436                             'cust_pkg'            => $postal_pkg,
2437                             'precommit_hooks'     => \@precommit_hooks,
2438                             'line_items'          => \@cust_bill_pkg,
2439                             'setup'               => \$total_setup,
2440                             'recur'               => \$total_recur,
2441                             'tax_matrix'          => \%taxlisthash,
2442                             'time'                => $time,
2443                             'options'             => \%options,
2444                           );
2445       if ($error) {
2446         $dbh->rollback if $oldAutoCommit;
2447         return $error;
2448       }
2449     }
2450   }
2451
2452   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2453
2454   # keys are tax names (as printed on invoices / itemdesc )
2455   # values are listrefs of taxlisthash keys (internal identifiers)
2456   my %taxname = ();
2457
2458   # keys are taxlisthash keys (internal identifiers)
2459   # values are (cumulative) amounts
2460   my %tax = ();
2461
2462   # keys are taxlisthash keys (internal identifiers)
2463   # values are listrefs of cust_bill_pkg_tax_location hashrefs
2464   my %tax_location = ();
2465
2466   # keys are taxlisthash keys (internal identifiers)
2467   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2468   my %tax_rate_location = ();
2469
2470   foreach my $tax ( keys %taxlisthash ) {
2471     my $tax_object = shift @{ $taxlisthash{$tax} };
2472     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2473     warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2474     my $hashref_or_error =
2475       $tax_object->taxline( $taxlisthash{$tax},
2476                             'custnum'      => $self->custnum,
2477                             'invoice_time' => $invoice_time
2478                           );
2479     unless ( ref($hashref_or_error) ) {
2480       $dbh->rollback if $oldAutoCommit;
2481       return $hashref_or_error;
2482     }
2483     unshift @{ $taxlisthash{$tax} }, $tax_object;
2484
2485     my $name   = $hashref_or_error->{'name'};
2486     my $amount = $hashref_or_error->{'amount'};
2487
2488     #warn "adding $amount as $name\n";
2489     $taxname{ $name } ||= [];
2490     push @{ $taxname{ $name } }, $tax;
2491
2492     $tax{ $tax } += $amount;
2493
2494     $tax_location{ $tax } ||= [];
2495     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2496       push @{ $tax_location{ $tax }  },
2497         {
2498           'taxnum'      => $tax_object->taxnum, 
2499           'taxtype'     => ref($tax_object),
2500           'pkgnum'      => $tax_object->get('pkgnum'),
2501           'locationnum' => $tax_object->get('locationnum'),
2502           'amount'      => sprintf('%.2f', $amount ),
2503         };
2504     }
2505
2506     $tax_rate_location{ $tax } ||= [];
2507     if ( ref($tax_object) eq 'FS::tax_rate' ) {
2508       my $taxratelocationnum =
2509         $tax_object->tax_rate_location->taxratelocationnum;
2510       push @{ $tax_rate_location{ $tax }  },
2511         {
2512           'taxnum'             => $tax_object->taxnum, 
2513           'taxtype'            => ref($tax_object),
2514           'amount'             => sprintf('%.2f', $amount ),
2515           'locationtaxid'      => $tax_object->location,
2516           'taxratelocationnum' => $taxratelocationnum,
2517         };
2518     }
2519
2520   }
2521
2522   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2523   my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2524   foreach my $tax ( keys %taxlisthash ) {
2525     foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2526       next unless ref($_) eq 'FS::cust_bill_pkg';
2527
2528       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, 
2529         splice( @{ $_->_cust_tax_exempt_pkg } );
2530     }
2531   }
2532
2533   #consolidate and create tax line items
2534   warn "consolidating and generating...\n" if $DEBUG > 2;
2535   foreach my $taxname ( keys %taxname ) {
2536     my $tax = 0;
2537     my %seen = ();
2538     my @cust_bill_pkg_tax_location = ();
2539     my @cust_bill_pkg_tax_rate_location = ();
2540     warn "adding $taxname\n" if $DEBUG > 1;
2541     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2542       next if $seen{$taxitem}++;
2543       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2544       $tax += $tax{$taxitem};
2545       push @cust_bill_pkg_tax_location,
2546         map { new FS::cust_bill_pkg_tax_location $_ }
2547             @{ $tax_location{ $taxitem } };
2548       push @cust_bill_pkg_tax_rate_location,
2549         map { new FS::cust_bill_pkg_tax_rate_location $_ }
2550             @{ $tax_rate_location{ $taxitem } };
2551     }
2552     next unless $tax;
2553
2554     $tax = sprintf('%.2f', $tax );
2555     $total_setup = sprintf('%.2f', $total_setup+$tax );
2556   
2557     push @cust_bill_pkg, new FS::cust_bill_pkg {
2558       'pkgnum'   => 0,
2559       'setup'    => $tax,
2560       'recur'    => 0,
2561       'sdate'    => '',
2562       'edate'    => '',
2563       'itemdesc' => $taxname,
2564       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2565       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2566     };
2567
2568   }
2569
2570   my $charged = sprintf('%.2f', $total_setup + $total_recur );
2571
2572   #create the new invoice
2573   my $cust_bill = new FS::cust_bill ( {
2574     'custnum' => $self->custnum,
2575     '_date'   => ( $invoice_time ),
2576     'charged' => $charged,
2577   } );
2578   my $error = $cust_bill->insert;
2579   if ( $error ) {
2580     $dbh->rollback if $oldAutoCommit;
2581     return "can't create invoice for customer #". $self->custnum. ": $error";
2582   }
2583
2584   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2585     $cust_bill_pkg->invnum($cust_bill->invnum); 
2586     my $error = $cust_bill_pkg->insert;
2587     if ( $error ) {
2588       $dbh->rollback if $oldAutoCommit;
2589       return "can't create invoice line item: $error";
2590     }
2591   }
2592     
2593
2594   foreach my $hook ( @precommit_hooks ) { 
2595     eval {
2596       &{$hook}; #($self) ?
2597     };
2598     if ( $@ ) {
2599       $dbh->rollback if $oldAutoCommit;
2600       return "$@ running precommit hook $hook\n";
2601     }
2602   }
2603   
2604   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2605   ''; #no error
2606 }
2607
2608
2609 sub _make_lines {
2610   my ($self, %params) = @_;
2611
2612   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2613   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2614   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2615   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2616   my $total_setup = $params{setup} or die "no setup accumulator specified";
2617   my $total_recur = $params{recur} or die "no recur accumulator specified";
2618   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2619   my $time = $params{'time'} or die "no time specified";
2620   my (%options) = %{$params{options}};
2621
2622   my $dbh = dbh;
2623   my $real_pkgpart = $cust_pkg->pkgpart;
2624   my %hash = $cust_pkg->hash;
2625   my $old_cust_pkg = new FS::cust_pkg \%hash;
2626
2627   my @details = ();
2628
2629   my $lineitems = 0;
2630
2631   $cust_pkg->pkgpart($part_pkg->pkgpart);
2632
2633   ###
2634   # bill setup
2635   ###
2636
2637   my $setup = 0;
2638   my $unitsetup = 0;
2639   if ( ! $cust_pkg->setup &&
2640        (
2641          ( $conf->exists('disable_setup_suspended_pkgs') &&
2642           ! $cust_pkg->getfield('susp')
2643         ) || ! $conf->exists('disable_setup_suspended_pkgs')
2644        )
2645     || $options{'resetup'}
2646   ) {
2647     
2648     warn "    bill setup\n" if $DEBUG > 1;
2649     $lineitems++;
2650
2651     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2652     return "$@ running calc_setup for $cust_pkg\n"
2653       if $@;
2654
2655     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2656
2657     $cust_pkg->setfield('setup', $time)
2658       unless $cust_pkg->setup;
2659           #do need it, but it won't get written to the db
2660           #|| $cust_pkg->pkgpart != $real_pkgpart;
2661
2662   }
2663
2664   ###
2665   # bill recurring fee
2666   ### 
2667
2668   #XXX unit stuff here too
2669   my $recur = 0;
2670   my $unitrecur = 0;
2671   my $sdate;
2672   if ( ! $cust_pkg->getfield('susp') and
2673            ( $part_pkg->getfield('freq') ne '0' &&
2674              ( $cust_pkg->getfield('bill') || 0 ) <= $time
2675            )
2676         || ( $part_pkg->plan eq 'voip_cdr'
2677               && $part_pkg->option('bill_every_call')
2678            )
2679   ) {
2680
2681     # XXX should this be a package event?  probably.  events are called
2682     # at collection time at the moment, though...
2683     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2684       if $part_pkg->can('reset_usage');
2685       #don't want to reset usage just cause we want a line item??
2686       #&& $part_pkg->pkgpart == $real_pkgpart;
2687
2688     warn "    bill recur\n" if $DEBUG > 1;
2689     $lineitems++;
2690
2691     # XXX shared with $recur_prog
2692     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2693
2694     #over two params!  lets at least switch to a hashref for the rest...
2695     my $increment_next_bill = ( $part_pkg->freq ne '0'
2696                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2697                               );
2698     my %param = ( 'precommit_hooks'     => $precommit_hooks,
2699                   'increment_next_bill' => $increment_next_bill,
2700                 );
2701
2702     $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2703     return "$@ running calc_recur for $cust_pkg\n"
2704       if ( $@ );
2705
2706     if ( $increment_next_bill ) {
2707
2708       my $next_bill = $part_pkg->add_freq($sdate);
2709       return "unparsable frequency: ". $part_pkg->freq
2710         if $next_bill == -1;
2711   
2712       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2713       # only for figuring next bill date, nothing else, so, reset $sdate again
2714       # here
2715       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2716       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2717       $cust_pkg->last_bill($sdate);
2718
2719       $cust_pkg->setfield('bill', $next_bill );
2720
2721     }
2722
2723   }
2724
2725   warn "\$setup is undefined" unless defined($setup);
2726   warn "\$recur is undefined" unless defined($recur);
2727   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2728   
2729   ###
2730   # If there's line items, create em cust_bill_pkg records
2731   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2732   ###
2733
2734   if ( $lineitems ) {
2735
2736     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2737       # hmm.. and if just the options are modified in some weird price plan?
2738   
2739       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2740         if $DEBUG >1;
2741   
2742       my $error = $cust_pkg->replace( $old_cust_pkg,
2743                                       'options' => { $cust_pkg->options },
2744                                     );
2745       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2746         if $error; #just in case
2747     }
2748   
2749     $setup = sprintf( "%.2f", $setup );
2750     $recur = sprintf( "%.2f", $recur );
2751     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2752       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2753     }
2754     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2755       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2756     }
2757
2758     if ( $setup != 0 || $recur != 0 ) {
2759
2760       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2761         if $DEBUG > 1;
2762
2763       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2764       if ( $DEBUG > 1 ) {
2765         warn "      adding customer package invoice detail: $_\n"
2766           foreach @cust_pkg_detail;
2767       }
2768       push @details, @cust_pkg_detail;
2769
2770       my $cust_bill_pkg = new FS::cust_bill_pkg {
2771         'pkgnum'    => $cust_pkg->pkgnum,
2772         'setup'     => $setup,
2773         'unitsetup' => $unitsetup,
2774         'recur'     => $recur,
2775         'unitrecur' => $unitrecur,
2776         'quantity'  => $cust_pkg->quantity,
2777         'details'   => \@details,
2778       };
2779
2780       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2781         $cust_bill_pkg->sdate( $hash{last_bill} );
2782         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
2783       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2784         $cust_bill_pkg->sdate( $sdate );
2785         $cust_bill_pkg->edate( $cust_pkg->bill );
2786       }
2787
2788       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2789         unless $part_pkg->pkgpart == $real_pkgpart;
2790
2791       $$total_setup += $setup;
2792       $$total_recur += $recur;
2793
2794       ###
2795       # handle taxes
2796       ###
2797
2798       my $error = 
2799         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2800       return $error if $error;
2801
2802       push @$cust_bill_pkgs, $cust_bill_pkg;
2803
2804     } #if $setup != 0 || $recur != 0
2805       
2806   } #if $line_items
2807
2808   '';
2809
2810 }
2811
2812 sub _handle_taxes {
2813   my $self = shift;
2814   my $part_pkg = shift;
2815   my $taxlisthash = shift;
2816   my $cust_bill_pkg = shift;
2817   my $cust_pkg = shift;
2818   my $invoice_time = shift;
2819
2820   my %cust_bill_pkg = ();
2821   my %taxes = ();
2822     
2823   my @classes;
2824   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2825   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2826   push @classes, 'setup' if $cust_bill_pkg->setup;
2827   push @classes, 'recur' if $cust_bill_pkg->recur;
2828
2829   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2830
2831     if ( $conf->exists('enable_taxproducts')
2832          && ( scalar($part_pkg->part_pkg_taxoverride)
2833               || $part_pkg->has_taxproduct
2834             )
2835        )
2836     {
2837
2838       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2839         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
2840       }
2841
2842       foreach my $class (@classes) {
2843         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
2844         return $err_or_ref unless ref($err_or_ref);
2845         $taxes{$class} = $err_or_ref;
2846       }
2847
2848       unless (exists $taxes{''}) {
2849         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
2850         return $err_or_ref unless ref($err_or_ref);
2851         $taxes{''} = $err_or_ref;
2852       }
2853
2854     } else {
2855
2856       my @loc_keys = qw( state county country );
2857       my %taxhash;
2858       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2859         my $cust_location = $cust_pkg->cust_location;
2860         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
2861       } else {
2862         my $prefix = 
2863           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2864           ? 'ship_'
2865           : '';
2866         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
2867       }
2868
2869       $taxhash{'taxclass'} = $part_pkg->taxclass;
2870
2871       my @taxes = qsearch( 'cust_main_county', \%taxhash );
2872
2873       my %taxhash_elim = %taxhash;
2874
2875       my @elim = qw( taxclass county state );
2876       while ( !scalar(@taxes) && scalar(@elim) ) {
2877         $taxhash_elim{ shift(@elim) } = '';
2878         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
2879       }
2880
2881       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
2882         foreach (@taxes) {
2883           $_->set('pkgnum',      $cust_pkg->pkgnum );
2884           $_->set('locationnum', $cust_pkg->locationnum );
2885         }
2886       }
2887
2888       $taxes{''} = [ @taxes ];
2889       $taxes{'setup'} = [ @taxes ];
2890       $taxes{'recur'} = [ @taxes ];
2891       $taxes{$_} = [ @taxes ] foreach (@classes);
2892
2893       # maybe eliminate this entirely, along with all the 0% records
2894       unless ( @taxes ) {
2895         return
2896           "fatal: can't find tax rate for state/county/country/taxclass ".
2897           join('/', map $taxhash{$_}, qw(state county country taxclass) );
2898       }
2899
2900     } #if $conf->exists('enable_taxproducts') ...
2901
2902   }
2903  
2904   my @display = ();
2905   if ( $conf->exists('separate_usage') ) {
2906     my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2907     my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2908     push @display, new FS::cust_bill_pkg_display { type    => 'S' };
2909     push @display, new FS::cust_bill_pkg_display { type    => 'R' };
2910     push @display, new FS::cust_bill_pkg_display { type    => 'U',
2911                                                    section => $section
2912                                                  };
2913     if ($section && $summary) {
2914       $display[2]->post_total('Y');
2915       push @display, new FS::cust_bill_pkg_display { type    => 'U',
2916                                                      summary => 'Y',
2917                                                    }
2918     }
2919   }
2920   $cust_bill_pkg->set('display', \@display);
2921
2922   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2923   foreach my $key (keys %tax_cust_bill_pkg) {
2924     my @taxes = @{ $taxes{$key} || [] };
2925     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2926
2927     my %localtaxlisthash = ();
2928     foreach my $tax ( @taxes ) {
2929
2930       my $taxname = ref( $tax ). ' '. $tax->taxnum;
2931 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
2932 #                  ' locationnum'. $cust_pkg->locationnum
2933 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
2934
2935       $taxlisthash->{ $taxname } ||= [ $tax ];
2936       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
2937
2938       $localtaxlisthash{ $taxname } ||= [ $tax ];
2939       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
2940
2941     }
2942
2943     warn "finding taxed taxes...\n" if $DEBUG > 2;
2944     foreach my $tax ( keys %localtaxlisthash ) {
2945       my $tax_object = shift @{ $localtaxlisthash{$tax} };
2946       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2947         if $DEBUG > 2;
2948       next unless $tax_object->can('tax_on_tax');
2949
2950       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2951         my $totname = ref( $tot ). ' '. $tot->taxnum;
2952
2953         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2954           if $DEBUG > 2;
2955         next unless exists( $localtaxlisthash{ $totname } ); # only increase
2956                                                              # existing taxes
2957         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2958         my $hashref_or_error = 
2959           $tax_object->taxline( $localtaxlisthash{$tax},
2960                                 'custnum'      => $self->custnum,
2961                                 'invoice_time' => $invoice_time,
2962                               );
2963         return $hashref_or_error
2964           unless ref($hashref_or_error);
2965         
2966         $taxlisthash->{ $totname } ||= [ $tot ];
2967         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
2968
2969       }
2970     }
2971
2972   }
2973
2974   '';
2975 }
2976
2977 sub _gather_taxes {
2978   my $self = shift;
2979   my $part_pkg = shift;
2980   my $class = shift;
2981
2982   my @taxes = ();
2983   my $geocode = $self->geocode('cch');
2984
2985   my @taxclassnums = map { $_->taxclassnum }
2986                      $part_pkg->part_pkg_taxoverride($class);
2987
2988   unless (@taxclassnums) {
2989     @taxclassnums = map { $_->taxclassnum }
2990                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2991   }
2992   warn "Found taxclassnum values of ". join(',', @taxclassnums)
2993     if $DEBUG;
2994
2995   my $extra_sql =
2996     "AND (".
2997     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2998
2999   @taxes = qsearch({ 'table' => 'tax_rate',
3000                      'hashref' => { 'geocode' => $geocode, },
3001                      'extra_sql' => $extra_sql,
3002                   })
3003     if scalar(@taxclassnums);
3004
3005   warn "Found taxes ".
3006        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n" 
3007    if $DEBUG;
3008
3009   [ @taxes ];
3010
3011 }
3012
3013 =item collect OPTIONS
3014
3015 (Attempt to) collect money for this customer's outstanding invoices (see
3016 L<FS::cust_bill>).  Usually used after the bill method.
3017
3018 Actions are now triggered by billing events; see L<FS::part_event> and the
3019 billing events web interface.  Old-style invoice events (see
3020 L<FS::part_bill_event>) have been deprecated.
3021
3022 If there is an error, returns the error, otherwise returns false.
3023
3024 Options are passed as name-value pairs.
3025
3026 Currently available options are:
3027
3028 =over 4
3029
3030 =item invoice_time
3031
3032 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
3033
3034 =item retry
3035
3036 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3037
3038 =item quiet
3039
3040 set true to surpress email card/ACH decline notices.
3041
3042 =item check_freq
3043
3044 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3045
3046 =item payby
3047
3048 allows for one time override of normal customer billing method
3049
3050 =item debug
3051
3052 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3053
3054
3055 =back
3056
3057 =cut
3058
3059 sub collect {
3060   my( $self, %options ) = @_;
3061   my $invoice_time = $options{'invoice_time'} || time;
3062
3063   #put below somehow?
3064   local $SIG{HUP} = 'IGNORE';
3065   local $SIG{INT} = 'IGNORE';
3066   local $SIG{QUIT} = 'IGNORE';
3067   local $SIG{TERM} = 'IGNORE';
3068   local $SIG{TSTP} = 'IGNORE';
3069   local $SIG{PIPE} = 'IGNORE';
3070
3071   my $oldAutoCommit = $FS::UID::AutoCommit;
3072   local $FS::UID::AutoCommit = 0;
3073   my $dbh = dbh;
3074
3075   $self->select_for_update; #mutex
3076
3077   if ( $DEBUG ) {
3078     my $balance = $self->balance;
3079     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3080   }
3081
3082   if ( exists($options{'retry_card'}) ) {
3083     carp 'retry_card option passed to collect is deprecated; use retry';
3084     $options{'retry'} ||= $options{'retry_card'};
3085   }
3086   if ( exists($options{'retry'}) && $options{'retry'} ) {
3087     my $error = $self->retry_realtime;
3088     if ( $error ) {
3089       $dbh->rollback if $oldAutoCommit;
3090       return $error;
3091     }
3092   }
3093
3094   # false laziness w/pay_batch::import_results
3095
3096   my $due_cust_event = $self->due_cust_event(
3097     'debug'      => ( $options{'debug'} || 0 ),
3098     'time'       => $invoice_time,
3099     'check_freq' => $options{'check_freq'},
3100   );
3101   unless( ref($due_cust_event) ) {
3102     $dbh->rollback if $oldAutoCommit;
3103     return $due_cust_event;
3104   }
3105
3106   foreach my $cust_event ( @$due_cust_event ) {
3107
3108     #XXX lock event
3109     
3110     #re-eval event conditions (a previous event could have changed things)
3111     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3112       #don't leave stray "new/locked" records around
3113       my $error = $cust_event->delete;
3114       if ( $error ) {
3115         #gah, even with transactions
3116         $dbh->commit if $oldAutoCommit; #well.
3117         return $error;
3118       }
3119       next;
3120     }
3121
3122     {
3123       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3124       warn "  running cust_event ". $cust_event->eventnum. "\n"
3125         if $DEBUG > 1;
3126
3127       
3128       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3129       if ( my $error = $cust_event->do_event() ) {
3130         #XXX wtf is this?  figure out a proper dealio with return value
3131         #from do_event
3132           # gah, even with transactions.
3133           $dbh->commit if $oldAutoCommit; #well.
3134           return $error;
3135         }
3136     }
3137
3138   }
3139
3140   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3141   '';
3142
3143 }
3144
3145 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3146
3147 Inserts database records for and returns an ordered listref of new events due
3148 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
3149 events are due, an empty listref is returned.  If there is an error, returns a
3150 scalar error message.
3151
3152 To actually run the events, call each event's test_condition method, and if
3153 still true, call the event's do_event method.
3154
3155 Options are passed as a hashref or as a list of name-value pairs.  Available
3156 options are:
3157
3158 =over 4
3159
3160 =item check_freq
3161
3162 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
3163
3164 =item time
3165
3166 "Current time" for the events.
3167
3168 =item debug
3169
3170 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3171
3172 =item eventtable
3173
3174 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3175
3176 =item objects
3177
3178 Explicitly pass the objects to be tested (typically used with eventtable).
3179
3180 =item testonly
3181
3182 Set to true to return the objects, but not actually insert them into the
3183 database.
3184
3185 =back
3186
3187 =cut
3188
3189 sub due_cust_event {
3190   my $self = shift;
3191   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3192
3193   #???
3194   #my $DEBUG = $opt{'debug'}
3195   local($DEBUG) = $opt{'debug'}
3196     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3197
3198   warn "$me due_cust_event called with options ".
3199        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3200     if $DEBUG;
3201
3202   $opt{'time'} ||= time;
3203
3204   local $SIG{HUP} = 'IGNORE';
3205   local $SIG{INT} = 'IGNORE';
3206   local $SIG{QUIT} = 'IGNORE';
3207   local $SIG{TERM} = 'IGNORE';
3208   local $SIG{TSTP} = 'IGNORE';
3209   local $SIG{PIPE} = 'IGNORE';
3210
3211   my $oldAutoCommit = $FS::UID::AutoCommit;
3212   local $FS::UID::AutoCommit = 0;
3213   my $dbh = dbh;
3214
3215   $self->select_for_update #mutex
3216     unless $opt{testonly};
3217
3218   ###
3219   # 1: find possible events (initial search)
3220   ###
3221   
3222   my @cust_event = ();
3223
3224   my @eventtable = $opt{'eventtable'}
3225                      ? ( $opt{'eventtable'} )
3226                      : FS::part_event->eventtables_runorder;
3227
3228   foreach my $eventtable ( @eventtable ) {
3229
3230     my @objects;
3231     if ( $opt{'objects'} ) {
3232
3233       @objects = @{ $opt{'objects'} };
3234
3235     } else {
3236
3237       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3238       @objects = ( $eventtable eq 'cust_main' )
3239                    ? ( $self )
3240                    : ( $self->$eventtable() );
3241
3242     }
3243
3244     my @e_cust_event = ();
3245
3246     my $cross = "CROSS JOIN $eventtable";
3247     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3248       unless $eventtable eq 'cust_main';
3249
3250     foreach my $object ( @objects ) {
3251
3252       #this first search uses the condition_sql magic for optimization.
3253       #the more possible events we can eliminate in this step the better
3254
3255       my $cross_where = '';
3256       my $pkey = $object->primary_key;
3257       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3258
3259       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3260       my $extra_sql =
3261         FS::part_event_condition->where_conditions_sql( $eventtable,
3262                                                         'time'=>$opt{'time'}
3263                                                       );
3264       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3265
3266       $extra_sql = "AND $extra_sql" if $extra_sql;
3267
3268       #here is the agent virtualization
3269       $extra_sql .= " AND (    part_event.agentnum IS NULL
3270                             OR part_event.agentnum = ". $self->agentnum. ' )';
3271
3272       $extra_sql .= " $order";
3273
3274       warn "searching for events for $eventtable ". $object->$pkey. "\n"
3275         if $opt{'debug'} > 2;
3276       my @part_event = qsearch( {
3277         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
3278         'select'    => 'part_event.*',
3279         'table'     => 'part_event',
3280         'addl_from' => "$cross $join",
3281         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3282                          'eventtable' => $eventtable,
3283                          'disabled'   => '',
3284                        },
3285         'extra_sql' => "AND $cross_where $extra_sql",
3286       } );
3287
3288       if ( $DEBUG > 2 ) {
3289         my $pkey = $object->primary_key;
3290         warn "      ". scalar(@part_event).
3291              " possible events found for $eventtable ". $object->$pkey(). "\n";
3292       }
3293
3294       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3295
3296     }
3297
3298     warn "    ". scalar(@e_cust_event).
3299          " subtotal possible cust events found for $eventtable\n"
3300       if $DEBUG > 1;
3301
3302     push @cust_event, @e_cust_event;
3303
3304   }
3305
3306   warn "  ". scalar(@cust_event).
3307        " total possible cust events found in initial search\n"
3308     if $DEBUG; # > 1;
3309
3310   ##
3311   # 2: test conditions
3312   ##
3313   
3314   my %unsat = ();
3315
3316   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
3317                                           'stats_hashref' => \%unsat ),
3318                      @cust_event;
3319
3320   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
3321     if $DEBUG; # > 1;
3322
3323   warn "    invalid conditions not eliminated with condition_sql:\n".
3324        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
3325     if $DEBUG; # > 1;
3326
3327   ##
3328   # 3: insert
3329   ##
3330
3331   unless( $opt{testonly} ) {
3332     foreach my $cust_event ( @cust_event ) {
3333
3334       my $error = $cust_event->insert();
3335       if ( $error ) {
3336         $dbh->rollback if $oldAutoCommit;
3337         return $error;
3338       }
3339                                        
3340     }
3341   }
3342
3343   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3344
3345   ##
3346   # 4: return
3347   ##
3348
3349   warn "  returning events: ". Dumper(@cust_event). "\n"
3350     if $DEBUG > 2;
3351
3352   \@cust_event;
3353
3354 }
3355
3356 =item retry_realtime
3357
3358 Schedules realtime / batch  credit card / electronic check / LEC billing
3359 events for for retry.  Useful if card information has changed or manual
3360 retry is desired.  The 'collect' method must be called to actually retry
3361 the transaction.
3362
3363 Implementation details: For either this customer, or for each of this
3364 customer's open invoices, changes the status of the first "done" (with
3365 statustext error) realtime processing event to "failed".
3366
3367 =cut
3368
3369 sub retry_realtime {
3370   my $self = shift;
3371
3372   local $SIG{HUP} = 'IGNORE';
3373   local $SIG{INT} = 'IGNORE';
3374   local $SIG{QUIT} = 'IGNORE';
3375   local $SIG{TERM} = 'IGNORE';
3376   local $SIG{TSTP} = 'IGNORE';
3377   local $SIG{PIPE} = 'IGNORE';
3378
3379   my $oldAutoCommit = $FS::UID::AutoCommit;
3380   local $FS::UID::AutoCommit = 0;
3381   my $dbh = dbh;
3382
3383   #a little false laziness w/due_cust_event (not too bad, really)
3384
3385   my $join = FS::part_event_condition->join_conditions_sql;
3386   my $order = FS::part_event_condition->order_conditions_sql;
3387   my $mine = 
3388   '( '
3389    . join ( ' OR ' , map { 
3390     "( part_event.eventtable = " . dbh->quote($_) 
3391     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3392    } FS::part_event->eventtables)
3393    . ') ';
3394
3395   #here is the agent virtualization
3396   my $agent_virt = " (    part_event.agentnum IS NULL
3397                        OR part_event.agentnum = ". $self->agentnum. ' )';
3398
3399   #XXX this shouldn't be hardcoded, actions should declare it...
3400   my @realtime_events = qw(
3401     cust_bill_realtime_card
3402     cust_bill_realtime_check
3403     cust_bill_realtime_lec
3404     cust_bill_batch
3405   );
3406
3407   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3408                                                   @realtime_events
3409                                      ).
3410                           ' ) ';
3411
3412   my @cust_event = qsearchs({
3413     'table'     => 'cust_event',
3414     'select'    => 'cust_event.*',
3415     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3416     'hashref'   => { 'status' => 'done' },
3417     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3418                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3419   });
3420
3421   my %seen_invnum = ();
3422   foreach my $cust_event (@cust_event) {
3423
3424     #max one for the customer, one for each open invoice
3425     my $cust_X = $cust_event->cust_X;
3426     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3427                           ? $cust_X->invnum
3428                           : 0
3429                         }++
3430          or $cust_event->part_event->eventtable eq 'cust_bill'
3431             && ! $cust_X->owed;
3432
3433     my $error = $cust_event->retry;
3434     if ( $error ) {
3435       $dbh->rollback if $oldAutoCommit;
3436       return "error scheduling event for retry: $error";
3437     }
3438
3439   }
3440
3441   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3442   '';
3443
3444 }
3445
3446 # some horrid false laziness here to avoid refactor fallout
3447 # eventually realtime realtime_bop and realtime_refund_bop should go
3448 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3449
3450 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3451
3452 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3453 via a Business::OnlinePayment realtime gateway.  See
3454 L<http://420.am/business-onlinepayment> for supported gateways.
3455
3456 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3457
3458 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3459
3460 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3461 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3462 if set, will override the value from the customer record.
3463
3464 I<description> is a free-text field passed to the gateway.  It defaults to
3465 "Internet services".
3466
3467 If an I<invnum> is specified, this payment (if successful) is applied to the
3468 specified invoice.  If you don't specify an I<invnum> you might want to
3469 call the B<apply_payments> method.
3470
3471 I<quiet> can be set true to surpress email decline notices.
3472
3473 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
3474 resulting paynum, if any.
3475
3476 I<payunique> is a unique identifier for this payment.
3477
3478 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3479
3480 =cut
3481
3482 sub realtime_bop {
3483   my $self = shift;
3484
3485   return $self->_new_realtime_bop(@_)
3486     if $self->_new_bop_required();
3487
3488   my( $method, $amount, %options ) = @_;
3489   if ( $DEBUG ) {
3490     warn "$me realtime_bop: $method $amount\n";
3491     warn "  $_ => $options{$_}\n" foreach keys %options;
3492   }
3493
3494   $options{'description'} ||= 'Internet services';
3495
3496   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3497
3498   eval "use Business::OnlinePayment";  
3499   die $@ if $@;
3500
3501   my $payinfo = exists($options{'payinfo'})
3502                   ? $options{'payinfo'}
3503                   : $self->payinfo;
3504
3505   my %method2payby = (
3506     'CC'     => 'CARD',
3507     'ECHECK' => 'CHEK',
3508     'LEC'    => 'LECB',
3509   );
3510
3511   ###
3512   # check for banned credit card/ACH
3513   ###
3514
3515   my $ban = qsearchs('banned_pay', {
3516     'payby'   => $method2payby{$method},
3517     'payinfo' => md5_base64($payinfo),
3518   } );
3519   return "Banned credit card" if $ban;
3520
3521   ###
3522   # set taxclass and trans_is_recur based on invnum if there is one
3523   ###
3524
3525   my $taxclass = '';
3526   my $trans_is_recur = 0;
3527   if ( $options{'invnum'} ) {
3528
3529     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3530     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3531
3532     my @part_pkg =
3533       map  { $_->part_pkg }
3534       grep { $_ }
3535       map  { $_->cust_pkg }
3536       $cust_bill->cust_bill_pkg;
3537
3538     my @taxclasses = map $_->taxclass, @part_pkg;
3539     $taxclass = $taxclasses[0]
3540       unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3541                                                         #different taxclasses
3542     $trans_is_recur = 1
3543       if grep { $_->freq ne '0' } @part_pkg;
3544
3545   }
3546
3547   ###
3548   # select a gateway
3549   ###
3550
3551   #look for an agent gateway override first
3552   my $cardtype;
3553   if ( $method eq 'CC' ) {
3554     $cardtype = cardtype($payinfo);
3555   } elsif ( $method eq 'ECHECK' ) {
3556     $cardtype = 'ACH';
3557   } else {
3558     $cardtype = $method;
3559   }
3560
3561   my $override =
3562        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3563                                            cardtype => $cardtype,
3564                                            taxclass => $taxclass,       } )
3565     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3566                                            cardtype => '',
3567                                            taxclass => $taxclass,       } )
3568     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3569                                            cardtype => $cardtype,
3570                                            taxclass => '',              } )
3571     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3572                                            cardtype => '',
3573                                            taxclass => '',              } );
3574
3575   my $payment_gateway = '';
3576   my( $processor, $login, $password, $action, @bop_options );
3577   if ( $override ) { #use a payment gateway override
3578
3579     $payment_gateway = $override->payment_gateway;
3580
3581     $processor   = $payment_gateway->gateway_module;
3582     $login       = $payment_gateway->gateway_username;
3583     $password    = $payment_gateway->gateway_password;
3584     $action      = $payment_gateway->gateway_action;
3585     @bop_options = $payment_gateway->options;
3586
3587   } else { #use the standard settings from the config
3588
3589     ( $processor, $login, $password, $action, @bop_options ) =
3590       $self->default_payment_gateway($method);
3591
3592   }
3593
3594   ###
3595   # massage data
3596   ###
3597
3598   my $address = exists($options{'address1'})
3599                     ? $options{'address1'}
3600                     : $self->address1;
3601   my $address2 = exists($options{'address2'})
3602                     ? $options{'address2'}
3603                     : $self->address2;
3604   $address .= ", ". $address2 if length($address2);
3605
3606   my $o_payname = exists($options{'payname'})
3607                     ? $options{'payname'}
3608                     : $self->payname;
3609   my($payname, $payfirst, $paylast);
3610   if ( $o_payname && $method ne 'ECHECK' ) {
3611     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3612       or return "Illegal payname $payname";
3613     ($payfirst, $paylast) = ($1, $2);
3614   } else {
3615     $payfirst = $self->getfield('first');
3616     $paylast = $self->getfield('last');
3617     $payname =  "$payfirst $paylast";
3618   }
3619
3620   my @invoicing_list = $self->invoicing_list_emailonly;
3621   if ( $conf->exists('emailinvoiceautoalways')
3622        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3623        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3624     push @invoicing_list, $self->all_emails;
3625   }
3626
3627   my $email = ($conf->exists('business-onlinepayment-email-override'))
3628               ? $conf->config('business-onlinepayment-email-override')
3629               : $invoicing_list[0];
3630
3631   my %content = ();
3632
3633   my $payip = exists($options{'payip'})
3634                 ? $options{'payip'}
3635                 : $self->payip;
3636   $content{customer_ip} = $payip
3637     if length($payip);
3638
3639   $content{invoice_number} = $options{'invnum'}
3640     if exists($options{'invnum'}) && length($options{'invnum'});
3641
3642   $content{email_customer} = 
3643     (    $conf->exists('business-onlinepayment-email_customer')
3644       || $conf->exists('business-onlinepayment-email-override') );
3645       
3646   my $paydate = '';
3647   if ( $method eq 'CC' ) { 
3648
3649     $content{card_number} = $payinfo;
3650     $paydate = exists($options{'paydate'})
3651                     ? $options{'paydate'}
3652                     : $self->paydate;
3653     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3654     $content{expiration} = "$2/$1";
3655
3656     my $paycvv = exists($options{'paycvv'})
3657                    ? $options{'paycvv'}
3658                    : $self->paycvv;
3659     $content{cvv2} = $paycvv
3660       if length($paycvv);
3661
3662     my $paystart_month = exists($options{'paystart_month'})
3663                            ? $options{'paystart_month'}
3664                            : $self->paystart_month;
3665
3666     my $paystart_year  = exists($options{'paystart_year'})
3667                            ? $options{'paystart_year'}
3668                            : $self->paystart_year;
3669
3670     $content{card_start} = "$paystart_month/$paystart_year"
3671       if $paystart_month && $paystart_year;
3672
3673     my $payissue       = exists($options{'payissue'})
3674                            ? $options{'payissue'}
3675                            : $self->payissue;
3676     $content{issue_number} = $payissue if $payissue;
3677
3678     if ( $self->_bop_recurring_billing( 'payinfo'        => $payinfo,
3679                                         'trans_is_recur' => $trans_is_recur,
3680                                       )
3681        )
3682     {
3683       $content{recurring_billing} = 'YES';
3684       $content{acct_code} = 'rebill'
3685         if $conf->exists('credit_card-recurring_billing_acct_code');
3686     }
3687
3688   } elsif ( $method eq 'ECHECK' ) {
3689     ( $content{account_number}, $content{routing_code} ) =
3690       split('@', $payinfo);
3691     $content{bank_name} = $o_payname;
3692     $content{bank_state} = exists($options{'paystate'})
3693                              ? $options{'paystate'}
3694                              : $self->getfield('paystate');
3695     $content{account_type} = exists($options{'paytype'})
3696                                ? uc($options{'paytype'}) || 'CHECKING'
3697                                : uc($self->getfield('paytype')) || 'CHECKING';
3698     $content{account_name} = $payname;
3699     $content{customer_org} = $self->company ? 'B' : 'I';
3700     $content{state_id}       = exists($options{'stateid'})
3701                                  ? $options{'stateid'}
3702                                  : $self->getfield('stateid');
3703     $content{state_id_state} = exists($options{'stateid_state'})
3704                                  ? $options{'stateid_state'}
3705                                  : $self->getfield('stateid_state');
3706     $content{customer_ssn} = exists($options{'ss'})
3707                                ? $options{'ss'}
3708                                : $self->ss;
3709   } elsif ( $method eq 'LEC' ) {
3710     $content{phone} = $payinfo;
3711   }
3712
3713   ###
3714   # run transaction(s)
3715   ###
3716
3717   my $balance = exists( $options{'balance'} )
3718                   ? $options{'balance'}
3719                   : $self->balance;
3720
3721   $self->select_for_update; #mutex ... just until we get our pending record in
3722
3723   #the checks here are intended to catch concurrent payments
3724   #double-form-submission prevention is taken care of in cust_pay_pending::check
3725
3726   #check the balance
3727   return "The customer's balance has changed; $method transaction aborted."
3728     if $self->balance < $balance;
3729     #&& $self->balance < $amount; #might as well anyway?
3730
3731   #also check and make sure there aren't *other* pending payments for this cust
3732
3733   my @pending = qsearch('cust_pay_pending', {
3734     'custnum' => $self->custnum,
3735     'status'  => { op=>'!=', value=>'done' } 
3736   });
3737   return "A payment is already being processed for this customer (".
3738          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3739          "); $method transaction aborted."
3740     if scalar(@pending);
3741
3742   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3743
3744   my $cust_pay_pending = new FS::cust_pay_pending {
3745     'custnum'           => $self->custnum,
3746     #'invnum'            => $options{'invnum'},
3747     'paid'              => $amount,
3748     '_date'             => '',
3749     'payby'             => $method2payby{$method},
3750     'payinfo'           => $payinfo,
3751     'paydate'           => $paydate,
3752     'recurring_billing' => $content{recurring_billing},
3753     'status'            => 'new',
3754     'gatewaynum'        => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3755   };
3756   $cust_pay_pending->payunique( $options{payunique} )
3757     if defined($options{payunique}) && length($options{payunique});
3758   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3759   return $cpp_new_err if $cpp_new_err;
3760
3761   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3762
3763   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3764   $transaction->content(
3765     'type'           => $method,
3766     'login'          => $login,
3767     'password'       => $password,
3768     'action'         => $action1,
3769     'description'    => $options{'description'},
3770     'amount'         => $amount,
3771     #'invoice_number' => $options{'invnum'},
3772     'customer_id'    => $self->custnum,
3773     'last_name'      => $paylast,
3774     'first_name'     => $payfirst,
3775     'name'           => $payname,
3776     'address'        => $address,
3777     'city'           => ( exists($options{'city'})
3778                             ? $options{'city'}
3779                             : $self->city          ),
3780     'state'          => ( exists($options{'state'})
3781                             ? $options{'state'}
3782                             : $self->state          ),
3783     'zip'            => ( exists($options{'zip'})
3784                             ? $options{'zip'}
3785                             : $self->zip          ),
3786     'country'        => ( exists($options{'country'})
3787                             ? $options{'country'}
3788                             : $self->country          ),
3789     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3790     'email'          => $email,
3791     'phone'          => $self->daytime || $self->night,
3792     %content, #after
3793   );
3794
3795   $cust_pay_pending->status('pending');
3796   my $cpp_pending_err = $cust_pay_pending->replace;
3797   return $cpp_pending_err if $cpp_pending_err;
3798
3799   #config?
3800   my $BOP_TESTING = 0;
3801   my $BOP_TESTING_SUCCESS = 1;
3802
3803   unless ( $BOP_TESTING ) {
3804     $transaction->submit();
3805   } else {
3806     if ( $BOP_TESTING_SUCCESS ) {
3807       $transaction->is_success(1);
3808       $transaction->authorization('fake auth');
3809     } else {
3810       $transaction->is_success(0);
3811       $transaction->error_message('fake failure');
3812     }
3813   }
3814
3815   if ( $transaction->is_success() && $action2 ) {
3816
3817     $cust_pay_pending->status('authorized');
3818     my $cpp_authorized_err = $cust_pay_pending->replace;
3819     return $cpp_authorized_err if $cpp_authorized_err;
3820
3821     my $auth = $transaction->authorization;
3822     my $ordernum = $transaction->can('order_number')
3823                    ? $transaction->order_number
3824                    : '';
3825
3826     my $capture =
3827       new Business::OnlinePayment( $processor, @bop_options );
3828
3829     my %capture = (
3830       %content,
3831       type           => $method,
3832       action         => $action2,
3833       login          => $login,
3834       password       => $password,
3835       order_number   => $ordernum,
3836       amount         => $amount,
3837       authorization  => $auth,
3838       description    => $options{'description'},
3839     );
3840
3841     foreach my $field (qw( authorization_source_code returned_ACI
3842                            transaction_identifier validation_code           
3843                            transaction_sequence_num local_transaction_date    
3844                            local_transaction_time AVS_result_code          )) {
3845       $capture{$field} = $transaction->$field() if $transaction->can($field);
3846     }
3847
3848     $capture->content( %capture );
3849
3850     $capture->submit();
3851
3852     unless ( $capture->is_success ) {
3853       my $e = "Authorization successful but capture failed, custnum #".
3854               $self->custnum. ': '.  $capture->result_code.
3855               ": ". $capture->error_message;
3856       warn $e;
3857       return $e;
3858     }
3859
3860   }
3861
3862   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3863   my $cpp_captured_err = $cust_pay_pending->replace;
3864   return $cpp_captured_err if $cpp_captured_err;
3865
3866   ###
3867   # remove paycvv after initial transaction
3868   ###
3869
3870   #false laziness w/misc/process/payment.cgi - check both to make sure working
3871   # correctly
3872   if ( defined $self->dbdef_table->column('paycvv')
3873        && length($self->paycvv)
3874        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3875   ) {
3876     my $error = $self->remove_cvv;
3877     if ( $error ) {
3878       warn "WARNING: error removing cvv: $error\n";
3879     }
3880   }
3881
3882   ###
3883   # result handling
3884   ###
3885
3886   if ( $transaction->is_success() ) {
3887
3888     my $paybatch = '';
3889     if ( $payment_gateway ) { # agent override
3890       $paybatch = $payment_gateway->gatewaynum. '-';
3891     }
3892
3893     $paybatch .= "$processor:". $transaction->authorization;
3894
3895     $paybatch .= ':'. $transaction->order_number
3896       if $transaction->can('order_number')
3897       && length($transaction->order_number);
3898
3899     my $cust_pay = new FS::cust_pay ( {
3900        'custnum'  => $self->custnum,
3901        'invnum'   => $options{'invnum'},
3902        'paid'     => $amount,
3903        '_date'    => '',
3904        'payby'    => $method2payby{$method},
3905        'payinfo'  => $payinfo,
3906        'paybatch' => $paybatch,
3907        'paydate'  => $paydate,
3908     } );
3909     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3910     $cust_pay->payunique( $options{payunique} )
3911       if defined($options{payunique}) && length($options{payunique});
3912
3913     my $oldAutoCommit = $FS::UID::AutoCommit;
3914     local $FS::UID::AutoCommit = 0;
3915     my $dbh = dbh;
3916
3917     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3918
3919     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3920
3921     if ( $error ) {
3922       $cust_pay->invnum(''); #try again with no specific invnum
3923       my $error2 = $cust_pay->insert( $options{'manual'} ?
3924                                       ( 'manual' => 1 ) : ()
3925                                     );
3926       if ( $error2 ) {
3927         # gah.  but at least we have a record of the state we had to abort in
3928         # from cust_pay_pending now.
3929         my $e = "WARNING: $method captured but payment not recorded - ".
3930                 "error inserting payment ($processor): $error2".
3931                 " (previously tried insert with invnum #$options{'invnum'}" .
3932                 ": $error ) - pending payment saved as paypendingnum ".
3933                 $cust_pay_pending->paypendingnum. "\n";
3934         warn $e;
3935         return $e;
3936       }
3937     }
3938
3939     if ( $options{'paynum_ref'} ) {
3940       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3941     }
3942
3943     $cust_pay_pending->status('done');
3944     $cust_pay_pending->statustext('captured');
3945     $cust_pay_pending->paynum($cust_pay->paynum);
3946     my $cpp_done_err = $cust_pay_pending->replace;
3947
3948     if ( $cpp_done_err ) {
3949
3950       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3951       my $e = "WARNING: $method captured but payment not recorded - ".
3952               "error updating status for paypendingnum ".
3953               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3954       warn $e;
3955       return $e;
3956
3957     } else {
3958
3959       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3960       return ''; #no error
3961
3962     }
3963
3964   } else {
3965
3966     my $perror = "$processor error: ". $transaction->error_message;
3967
3968     unless ( $transaction->error_message ) {
3969
3970       my $t_response;
3971       if ( $transaction->can('response_page') ) {
3972         $t_response = {
3973                         'page'    => ( $transaction->can('response_page')
3974                                          ? $transaction->response_page
3975                                          : ''
3976                                      ),
3977                         'code'    => ( $transaction->can('response_code')
3978                                          ? $transaction->response_code
3979                                          : ''
3980                                      ),
3981                         'headers' => ( $transaction->can('response_headers')
3982                                          ? $transaction->response_headers
3983                                          : ''
3984                                      ),
3985                       };
3986       } else {
3987         $t_response .=
3988           "No additional debugging information available for $processor";
3989       }
3990
3991       $perror .= "No error_message returned from $processor -- ".
3992                  ( ref($t_response) ? Dumper($t_response) : $t_response );
3993
3994     }
3995
3996     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3997          && $conf->exists('emaildecline')
3998          && grep { $_ ne 'POST' } $self->invoicing_list
3999          && ! grep { $transaction->error_message =~ /$_/ }
4000                    $conf->config('emaildecline-exclude')
4001     ) {
4002       my @templ = $conf->config('declinetemplate');
4003       my $template = new Text::Template (
4004         TYPE   => 'ARRAY',
4005         SOURCE => [ map "$_\n", @templ ],
4006       ) or return "($perror) can't create template: $Text::Template::ERROR";
4007       $template->compile()
4008         or return "($perror) can't compile template: $Text::Template::ERROR";
4009
4010       my $templ_hash = { error => $transaction->error_message };
4011
4012       my $error = send_email(
4013         'from'    => $conf->config('invoice_from', $self->agentnum ),
4014         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4015         'subject' => 'Your payment could not be processed',
4016         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
4017       );
4018
4019       $perror .= " (also received error sending decline notification: $error)"
4020         if $error;
4021
4022     }
4023
4024     $cust_pay_pending->status('done');
4025     $cust_pay_pending->statustext("declined: $perror");
4026     my $cpp_done_err = $cust_pay_pending->replace;
4027     if ( $cpp_done_err ) {
4028       my $e = "WARNING: $method declined but pending payment not resolved - ".
4029               "error updating status for paypendingnum ".
4030               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4031       warn $e;
4032       $perror = "$e ($perror)";
4033     }
4034
4035     return $perror;
4036   }
4037
4038 }
4039
4040 sub _bop_recurring_billing {
4041   my( $self, %opt ) = @_;
4042
4043   my $method = $conf->config('credit_card-recurring_billing_flag');
4044
4045   if ( $method eq 'transaction_is_recur' ) {
4046
4047     return 1 if $opt{'trans_is_recur'};
4048
4049   } else {
4050
4051     my %hash = ( 'custnum' => $self->custnum,
4052                  'payby'   => 'CARD',
4053                );
4054
4055     return 1 
4056       if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4057       || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4058                                                                $opt{'payinfo'} )
4059                              } );
4060
4061   }
4062
4063   return 0;
4064
4065 }
4066
4067
4068 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4069
4070 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4071 via a Business::OnlinePayment realtime gateway.  See
4072 L<http://420.am/business-onlinepayment> for supported gateways.
4073
4074 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4075
4076 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4077
4078 Most gateways require a reference to an original payment transaction to refund,
4079 so you probably need to specify a I<paynum>.
4080
4081 I<amount> defaults to the original amount of the payment if not specified.
4082
4083 I<reason> specifies a reason for the refund.
4084
4085 I<paydate> specifies the expiration date for a credit card overriding the
4086 value from the customer record or the payment record. Specified as yyyy-mm-dd
4087
4088 Implementation note: If I<amount> is unspecified or equal to the amount of the
4089 orignal payment, first an attempt is made to "void" the transaction via
4090 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4091 the normal attempt is made to "refund" ("credit") the transaction via the
4092 gateway is attempted.
4093
4094 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4095 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4096 #if set, will override the value from the customer record.
4097
4098 #If an I<invnum> is specified, this payment (if successful) is applied to the
4099 #specified invoice.  If you don't specify an I<invnum> you might want to
4100 #call the B<apply_payments> method.
4101
4102 =cut
4103
4104 #some false laziness w/realtime_bop, not enough to make it worth merging
4105 #but some useful small subs should be pulled out
4106 sub realtime_refund_bop {
4107   my $self = shift;
4108
4109   return $self->_new_realtime_refund_bop(@_)
4110     if $self->_new_bop_required();
4111
4112   my( $method, %options ) = @_;
4113   if ( $DEBUG ) {
4114     warn "$me realtime_refund_bop: $method refund\n";
4115     warn "  $_ => $options{$_}\n" foreach keys %options;
4116   }
4117
4118   eval "use Business::OnlinePayment";  
4119   die $@ if $@;
4120
4121   ###
4122   # look up the original payment and optionally a gateway for that payment
4123   ###
4124
4125   my $cust_pay = '';
4126   my $amount = $options{'amount'};
4127
4128   my( $processor, $login, $password, @bop_options ) ;
4129   my( $auth, $order_number ) = ( '', '', '' );
4130
4131   if ( $options{'paynum'} ) {
4132
4133     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
4134     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4135       or return "Unknown paynum $options{'paynum'}";
4136     $amount ||= $cust_pay->paid;
4137
4138     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4139       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4140                 $cust_pay->paybatch;
4141     my $gatewaynum = '';
4142     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4143
4144     if ( $gatewaynum ) { #gateway for the payment to be refunded
4145
4146       my $payment_gateway =
4147         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4148       die "payment gateway $gatewaynum not found"
4149         unless $payment_gateway;
4150
4151       $processor   = $payment_gateway->gateway_module;
4152       $login       = $payment_gateway->gateway_username;
4153       $password    = $payment_gateway->gateway_password;
4154       @bop_options = $payment_gateway->options;
4155
4156     } else { #try the default gateway
4157
4158       my( $conf_processor, $unused_action );
4159       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4160         $self->default_payment_gateway($method);
4161
4162       return "processor of payment $options{'paynum'} $processor does not".
4163              " match default processor $conf_processor"
4164         unless $processor eq $conf_processor;
4165
4166     }
4167
4168
4169   } else { # didn't specify a paynum, so look for agent gateway overrides
4170            # like a normal transaction 
4171
4172     my $cardtype;
4173     if ( $method eq 'CC' ) {
4174       $cardtype = cardtype($self->payinfo);
4175     } elsif ( $method eq 'ECHECK' ) {
4176       $cardtype = 'ACH';
4177     } else {
4178       $cardtype = $method;
4179     }
4180     my $override =
4181            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4182                                                cardtype => $cardtype,
4183                                                taxclass => '',              } )
4184         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4185                                                cardtype => '',
4186                                                taxclass => '',              } );
4187
4188     if ( $override ) { #use a payment gateway override
4189  
4190       my $payment_gateway = $override->payment_gateway;
4191
4192       $processor   = $payment_gateway->gateway_module;
4193       $login       = $payment_gateway->gateway_username;
4194       $password    = $payment_gateway->gateway_password;
4195       #$action      = $payment_gateway->gateway_action;
4196       @bop_options = $payment_gateway->options;
4197
4198     } else { #use the standard settings from the config
4199
4200       my $unused_action;
4201       ( $processor, $login, $password, $unused_action, @bop_options ) =
4202         $self->default_payment_gateway($method);
4203
4204     }
4205
4206   }
4207   return "neither amount nor paynum specified" unless $amount;
4208
4209   my %content = (
4210     'type'           => $method,
4211     'login'          => $login,
4212     'password'       => $password,
4213     'order_number'   => $order_number,
4214     'amount'         => $amount,
4215     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4216   );
4217   $content{authorization} = $auth
4218     if length($auth); #echeck/ACH transactions have an order # but no auth
4219                       #(at least with authorize.net)
4220
4221   my $disable_void_after;
4222   if ($conf->exists('disable_void_after')
4223       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4224     $disable_void_after = $1;
4225   }
4226
4227   #first try void if applicable
4228   if ( $cust_pay && $cust_pay->paid == $amount
4229     && (
4230       ( not defined($disable_void_after) )
4231       || ( time < ($cust_pay->_date + $disable_void_after ) )
4232     )
4233   ) {
4234     warn "  attempting void\n" if $DEBUG > 1;
4235     my $void = new Business::OnlinePayment( $processor, @bop_options );
4236     $void->content( 'action' => 'void', %content );
4237     $void->submit();
4238     if ( $void->is_success ) {
4239       my $error = $cust_pay->void($options{'reason'});
4240       if ( $error ) {
4241         # gah, even with transactions.
4242         my $e = 'WARNING: Card/ACH voided but database not updated - '.
4243                 "error voiding payment: $error";
4244         warn $e;
4245         return $e;
4246       }
4247       warn "  void successful\n" if $DEBUG > 1;
4248       return '';
4249     }
4250   }
4251
4252   warn "  void unsuccessful, trying refund\n"
4253     if $DEBUG > 1;
4254
4255   #massage data
4256   my $address = $self->address1;
4257   $address .= ", ". $self->address2 if $self->address2;
4258
4259   my($payname, $payfirst, $paylast);
4260   if ( $self->payname && $method ne 'ECHECK' ) {
4261     $payname = $self->payname;
4262     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4263       or return "Illegal payname $payname";
4264     ($payfirst, $paylast) = ($1, $2);
4265   } else {
4266     $payfirst = $self->getfield('first');
4267     $paylast = $self->getfield('last');
4268     $payname =  "$payfirst $paylast";
4269   }
4270
4271   my @invoicing_list = $self->invoicing_list_emailonly;
4272   if ( $conf->exists('emailinvoiceautoalways')
4273        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4274        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4275     push @invoicing_list, $self->all_emails;
4276   }
4277
4278   my $email = ($conf->exists('business-onlinepayment-email-override'))
4279               ? $conf->config('business-onlinepayment-email-override')
4280               : $invoicing_list[0];
4281
4282   my $payip = exists($options{'payip'})
4283                 ? $options{'payip'}
4284                 : $self->payip;
4285   $content{customer_ip} = $payip
4286     if length($payip);
4287
4288   my $payinfo = '';
4289   if ( $method eq 'CC' ) {
4290
4291     if ( $cust_pay ) {
4292       $content{card_number} = $payinfo = $cust_pay->payinfo;
4293       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4294         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4295         ($content{expiration} = "$2/$1");  # where available
4296     } else {
4297       $content{card_number} = $payinfo = $self->payinfo;
4298       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4299         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4300       $content{expiration} = "$2/$1";
4301     }
4302
4303   } elsif ( $method eq 'ECHECK' ) {
4304
4305     if ( $cust_pay ) {
4306       $payinfo = $cust_pay->payinfo;
4307     } else {
4308       $payinfo = $self->payinfo;
4309     } 
4310     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4311     $content{bank_name} = $self->payname;
4312     $content{account_type} = 'CHECKING';
4313     $content{account_name} = $payname;
4314     $content{customer_org} = $self->company ? 'B' : 'I';
4315     $content{customer_ssn} = $self->ss;
4316   } elsif ( $method eq 'LEC' ) {
4317     $content{phone} = $payinfo = $self->payinfo;
4318   }
4319
4320   #then try refund
4321   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4322   my %sub_content = $refund->content(
4323     'action'         => 'credit',
4324     'customer_id'    => $self->custnum,
4325     'last_name'      => $paylast,
4326     'first_name'     => $payfirst,
4327     'name'           => $payname,
4328     'address'        => $address,
4329     'city'           => $self->city,
4330     'state'          => $self->state,
4331     'zip'            => $self->zip,
4332     'country'        => $self->country,
4333     'email'          => $email,
4334     'phone'          => $self->daytime || $self->night,
4335     %content, #after
4336   );
4337   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4338     if $DEBUG > 1;
4339   $refund->submit();
4340
4341   return "$processor error: ". $refund->error_message
4342     unless $refund->is_success();
4343
4344   my %method2payby = (
4345     'CC'     => 'CARD',
4346     'ECHECK' => 'CHEK',
4347     'LEC'    => 'LECB',
4348   );
4349
4350   my $paybatch = "$processor:". $refund->authorization;
4351   $paybatch .= ':'. $refund->order_number
4352     if $refund->can('order_number') && $refund->order_number;
4353
4354   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4355     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4356     last unless @cust_bill_pay;
4357     my $cust_bill_pay = pop @cust_bill_pay;
4358     my $error = $cust_bill_pay->delete;
4359     last if $error;
4360   }
4361
4362   my $cust_refund = new FS::cust_refund ( {
4363     'custnum'  => $self->custnum,
4364     'paynum'   => $options{'paynum'},
4365     'refund'   => $amount,
4366     '_date'    => '',
4367     'payby'    => $method2payby{$method},
4368     'payinfo'  => $payinfo,
4369     'paybatch' => $paybatch,
4370     'reason'   => $options{'reason'} || 'card or ACH refund',
4371   } );
4372   my $error = $cust_refund->insert;
4373   if ( $error ) {
4374     $cust_refund->paynum(''); #try again with no specific paynum
4375     my $error2 = $cust_refund->insert;
4376     if ( $error2 ) {
4377       # gah, even with transactions.
4378       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4379               "error inserting refund ($processor): $error2".
4380               " (previously tried insert with paynum #$options{'paynum'}" .
4381               ": $error )";
4382       warn $e;
4383       return $e;
4384     }
4385   }
4386
4387   ''; #no error
4388
4389 }
4390
4391 # does the configuration indicate the new bop routines are required?
4392
4393 sub _new_bop_required {
4394   my $self = shift;
4395
4396   my $botpp = 'Business::OnlineThirdPartyPayment';
4397
4398   return 1
4399     if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4400          scalar( grep { $_->gateway_namespace eq $botpp } 
4401                  qsearch( 'payment_gateway', { 'disabled' => '' } )
4402                )
4403        )
4404   ;
4405
4406   '';
4407 }
4408   
4409
4410 =item realtime_collect [ OPTION => VALUE ... ]
4411
4412 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4413 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4414 gateway.  See L<http://420.am/business-onlinepayment> and 
4415 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4416
4417 On failure returns an error message.
4418
4419 Returns false or a hashref upon success.  The hashref contains keys popup_url reference, and collectitems.  The first is a URL to which a browser should be redirected for completion of collection.  The second is a reference id for the transaction suitable for the end user.  The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
4420
4421 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4422
4423 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4424 then it is deduced from the customer record.
4425
4426 If no I<amount> is specified, then the customer balance is used.