Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / FS / FS / cust_main.pm
1 package FS::cust_main;
2
3 require 5.006;
4 use strict;
5 use base qw( FS::cust_main::Packages FS::cust_main::Status
6              FS::cust_main::NationalID
7              FS::cust_main::Billing FS::cust_main::Billing_Realtime
8              FS::cust_main::Billing_Discount
9              FS::cust_main::Billing_ThirdParty
10              FS::cust_main::Location
11              FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
12              FS::geocode_Mixin FS::Quotable_Mixin
13              FS::o2m_Common
14              FS::Record
15            );
16 use vars qw( $DEBUG $me $conf
17              @encrypted_fields
18              $import
19              $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
20              $skip_fuzzyfiles
21              @paytypes
22            );
23 use Carp;
24 use Scalar::Util qw( blessed );
25 use Time::Local qw(timelocal);
26 use Storable qw(thaw);
27 use MIME::Base64;
28 use Data::Dumper;
29 use Tie::IxHash;
30 use Digest::MD5 qw(md5_base64);
31 use Date::Format;
32 #use Date::Manip;
33 use File::Temp; #qw( tempfile );
34 use Business::CreditCard 0.28;
35 use Locale::Country;
36 use FS::UID qw( dbh driver_name );
37 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
38 use FS::Misc qw( generate_email send_email generate_ps do_print );
39 use FS::Msgcat qw(gettext);
40 use FS::CurrentUser;
41 use FS::TicketSystem;
42 use FS::payby;
43 use FS::cust_pkg;
44 use FS::cust_svc;
45 use FS::cust_bill;
46 use FS::cust_bill_void;
47 use FS::legacy_cust_bill;
48 use FS::cust_pay;
49 use FS::cust_pay_pending;
50 use FS::cust_pay_void;
51 use FS::cust_pay_batch;
52 use FS::cust_credit;
53 use FS::cust_refund;
54 use FS::part_referral;
55 use FS::cust_main_county;
56 use FS::cust_location;
57 use FS::cust_class;
58 use FS::cust_main_exemption;
59 use FS::cust_tax_adjustment;
60 use FS::cust_tax_location;
61 use FS::agent;
62 use FS::agent_currency;
63 use FS::cust_main_invoice;
64 use FS::cust_tag;
65 use FS::prepay_credit;
66 use FS::queue;
67 use FS::part_pkg;
68 use FS::part_export;
69 #use FS::cust_event;
70 use FS::type_pkgs;
71 use FS::payment_gateway;
72 use FS::agent_payment_gateway;
73 use FS::banned_pay;
74 use FS::cust_main_note;
75 use FS::cust_attachment;
76 use FS::contact;
77 use FS::Locales;
78 use FS::upgrade_journal;
79
80 # 1 is mostly method/subroutine entry and options
81 # 2 traces progress of some operations
82 # 3 is even more information including possibly sensitive data
83 $DEBUG = 0;
84 $me = '[FS::cust_main]';
85
86 $import = 0;
87 $ignore_expired_card = 0;
88 $ignore_banned_card = 0;
89
90 $skip_fuzzyfiles = 0;
91
92 @encrypted_fields = ('payinfo', 'paycvv');
93 sub nohistory_fields { ('payinfo', 'paycvv'); }
94
95 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
96
97 #ask FS::UID to run this stuff for us later
98 #$FS::UID::callback{'FS::cust_main'} = sub { 
99 install_callback FS::UID sub { 
100   $conf = new FS::Conf;
101   #yes, need it for stuff below (prolly should be cached)
102 };
103
104 sub _cache {
105   my $self = shift;
106   my ( $hashref, $cache ) = @_;
107   if ( exists $hashref->{'pkgnum'} ) {
108     #@{ $self->{'_pkgnum'} } = ();
109     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
110     $self->{'_pkgnum'} = $subcache;
111     #push @{ $self->{'_pkgnum'} },
112     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
113   }
114 }
115
116 =head1 NAME
117
118 FS::cust_main - Object methods for cust_main records
119
120 =head1 SYNOPSIS
121
122   use FS::cust_main;
123
124   $record = new FS::cust_main \%hash;
125   $record = new FS::cust_main { 'column' => 'value' };
126
127   $error = $record->insert;
128
129   $error = $new_record->replace($old_record);
130
131   $error = $record->delete;
132
133   $error = $record->check;
134
135   @cust_pkg = $record->all_pkgs;
136
137   @cust_pkg = $record->ncancelled_pkgs;
138
139   @cust_pkg = $record->suspended_pkgs;
140
141   $error = $record->bill;
142   $error = $record->bill %options;
143   $error = $record->bill 'time' => $time;
144
145   $error = $record->collect;
146   $error = $record->collect %options;
147   $error = $record->collect 'invoice_time'   => $time,
148                           ;
149
150 =head1 DESCRIPTION
151
152 An FS::cust_main object represents a customer.  FS::cust_main inherits from 
153 FS::Record.  The following fields are currently supported:
154
155 =over 4
156
157 =item custnum
158
159 Primary key (assigned automatically for new customers)
160
161 =item agentnum
162
163 Agent (see L<FS::agent>)
164
165 =item refnum
166
167 Advertising source (see L<FS::part_referral>)
168
169 =item first
170
171 First name
172
173 =item last
174
175 Last name
176
177 =item ss
178
179 Cocial security number (optional)
180
181 =item company
182
183 (optional)
184
185 =item daytime
186
187 phone (optional)
188
189 =item night
190
191 phone (optional)
192
193 =item fax
194
195 phone (optional)
196
197 =item mobile
198
199 phone (optional)
200
201 =item payby
202
203 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
204
205 =item payinfo
206
207 Payment Information (See L<FS::payinfo_Mixin> for data format)
208
209 =item paymask
210
211 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
212
213 =item paycvv
214
215 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
216
217 =item paydate
218
219 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
220
221 =item paystart_month
222
223 Start date month (maestro/solo cards only)
224
225 =item paystart_year
226
227 Start date year (maestro/solo cards only)
228
229 =item payissue
230
231 Issue number (maestro/solo cards only)
232
233 =item payname
234
235 Name on card or billing name
236
237 =item payip
238
239 IP address from which payment information was received
240
241 =item tax
242
243 Tax exempt, empty or `Y'
244
245 =item usernum
246
247 Order taker (see L<FS::access_user>)
248
249 =item comments
250
251 Comments (optional)
252
253 =item referral_custnum
254
255 Referring customer number
256
257 =item spool_cdr
258
259 Enable individual CDR spooling, empty or `Y'
260
261 =item dundate
262
263 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
264
265 =item squelch_cdr
266
267 Discourage individual CDR printing, empty or `Y'
268
269 =item edit_subject
270
271 Allow self-service editing of ticket subjects, empty or 'Y'
272
273 =item calling_list_exempt
274
275 Do not call, empty or 'Y'
276
277 =back
278
279 =head1 METHODS
280
281 =over 4
282
283 =item new HASHREF
284
285 Creates a new customer.  To add the customer to the database, see L<"insert">.
286
287 Note that this stores the hash reference, not a distinct copy of the hash it
288 points to.  You can ask the object for a copy with the I<hash> method.
289
290 =cut
291
292 sub table { 'cust_main'; }
293
294 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
295
296 Adds this customer to the database.  If there is an error, returns the error,
297 otherwise returns false.
298
299 Usually the customer's location will not yet exist in the database, and
300 the C<bill_location> and C<ship_location> pseudo-fields must be set to 
301 uninserted L<FS::cust_location> objects.  These will be inserted and linked
302 (in both directions) to the new customer record.  If they're references 
303 to the same object, they will become the same location.
304
305 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
306 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
307 are inserted atomicly, or the transaction is rolled back.  Passing an empty
308 hash reference is equivalent to not supplying this parameter.  There should be
309 a better explanation of this, but until then, here's an example:
310
311   use Tie::RefHash;
312   tie %hash, 'Tie::RefHash'; #this part is important
313   %hash = (
314     $cust_pkg => [ $svc_acct ],
315     ...
316   );
317   $cust_main->insert( \%hash );
318
319 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
320 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
321 expected and rollback the entire transaction; it is not necessary to call 
322 check_invoicing_list first.  The invoicing_list is set after the records in the
323 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
324 invoicing_list destination to the newly-created svc_acct.  Here's an example:
325
326   $cust_main->insert( {}, [ $email, 'POST' ] );
327
328 Currently available options are: I<depend_jobnum>, I<noexport>,
329 I<tax_exemption> and I<prospectnum>.
330
331 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
332 on the supplied jobnum (they will not run until the specific job completes).
333 This can be used to defer provisioning until some action completes (such
334 as running the customer's credit card successfully).
335
336 The I<noexport> option is deprecated.  If I<noexport> is set true, no
337 provisioning jobs (exports) are scheduled.  (You can schedule them later with
338 the B<reexport> method.)
339
340 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
341 of tax names and exemption numbers.  FS::cust_main_exemption records will be
342 created and inserted.
343
344 If I<prospectnum> is set, moves contacts and locations from that prospect.
345
346 =cut
347
348 sub insert {
349   my $self = shift;
350   my $cust_pkgs = @_ ? shift : {};
351   my $invoicing_list = @_ ? shift : '';
352   my %options = @_;
353   warn "$me insert called with options ".
354        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
355     if $DEBUG;
356
357   local $SIG{HUP} = 'IGNORE';
358   local $SIG{INT} = 'IGNORE';
359   local $SIG{QUIT} = 'IGNORE';
360   local $SIG{TERM} = 'IGNORE';
361   local $SIG{TSTP} = 'IGNORE';
362   local $SIG{PIPE} = 'IGNORE';
363
364   my $oldAutoCommit = $FS::UID::AutoCommit;
365   local $FS::UID::AutoCommit = 0;
366   my $dbh = dbh;
367
368   my $prepay_identifier = '';
369   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
370   my $payby = '';
371   if ( $self->payby eq 'PREPAY' ) {
372
373     $self->payby('BILL');
374     $prepay_identifier = $self->payinfo;
375     $self->payinfo('');
376
377     warn "  looking up prepaid card $prepay_identifier\n"
378       if $DEBUG > 1;
379
380     my $error = $self->get_prepay( $prepay_identifier,
381                                    'amount_ref'     => \$amount,
382                                    'seconds_ref'    => \$seconds,
383                                    'upbytes_ref'    => \$upbytes,
384                                    'downbytes_ref'  => \$downbytes,
385                                    'totalbytes_ref' => \$totalbytes,
386                                  );
387     if ( $error ) {
388       $dbh->rollback if $oldAutoCommit;
389       #return "error applying prepaid card (transaction rolled back): $error";
390       return $error;
391     }
392
393     $payby = 'PREP' if $amount;
394
395   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|PPAL)$/ ) {
396
397     $payby = $1;
398     $self->payby('BILL');
399     $amount = $self->paid;
400
401   }
402
403   # insert locations
404   foreach my $l (qw(bill_location ship_location)) {
405     my $loc = delete $self->hashref->{$l};
406     # XXX if we're moving a prospect's locations, do that here
407     if ( !$loc ) {
408       return "$l not set";
409     }
410     
411     if ( !$loc->locationnum ) {
412       # warn the location that we're going to insert it with no custnum
413       $loc->set(custnum_pending => 1);
414       warn "  inserting $l\n"
415         if $DEBUG > 1;
416       my $error = $loc->insert;
417       if ( $error ) {
418         $dbh->rollback if $oldAutoCommit;
419         my $label = $l eq 'ship_location' ? 'service' : 'billing';
420         return "$error (in $label location)";
421       }
422     }
423     elsif ( ($loc->custnum || 0) > 0 or $loc->prospectnum ) {
424       # then it somehow belongs to another customer--shouldn't happen
425       $dbh->rollback if $oldAutoCommit;
426       return "$l belongs to customer ".$loc->custnum;
427     }
428     # else it already belongs to this customer 
429     # (happens when ship_location is identical to bill_location)
430
431     $self->set($l.'num', $loc->locationnum);
432
433     if ( $self->get($l.'num') eq '' ) {
434       $dbh->rollback if $oldAutoCommit;
435       return "$l not set";
436     }
437   }
438
439   warn "  inserting $self\n"
440     if $DEBUG > 1;
441
442   $self->signupdate(time) unless $self->signupdate;
443
444   $self->auto_agent_custid()
445     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
446
447   my $error = $self->SUPER::insert;
448   if ( $error ) {
449     $dbh->rollback if $oldAutoCommit;
450     #return "inserting cust_main record (transaction rolled back): $error";
451     return $error;
452   }
453
454   # now set cust_location.custnum
455   foreach my $l (qw(bill_location ship_location)) {
456     warn "  setting $l.custnum\n"
457       if $DEBUG > 1;
458     my $loc = $self->$l;
459     unless ( $loc->custnum ) {
460       $loc->set(custnum => $self->custnum);
461       $error ||= $loc->replace;
462     }
463
464     if ( $error ) {
465       $dbh->rollback if $oldAutoCommit;
466       return "error setting $l custnum: $error";
467     }
468   }
469
470   warn "  setting invoicing list\n"
471     if $DEBUG > 1;
472
473   if ( $invoicing_list ) {
474     $error = $self->check_invoicing_list( $invoicing_list );
475     if ( $error ) {
476       $dbh->rollback if $oldAutoCommit;
477       #return "checking invoicing_list (transaction rolled back): $error";
478       return $error;
479     }
480     $self->invoicing_list( $invoicing_list );
481   }
482
483   warn "  setting customer tags\n"
484     if $DEBUG > 1;
485
486   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
487     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
488                                       'custnum' => $self->custnum };
489     my $error = $cust_tag->insert;
490     if ( $error ) {
491       $dbh->rollback if $oldAutoCommit;
492       return $error;
493     }
494   }
495
496   my $prospectnum = delete $options{'prospectnum'};
497   if ( $prospectnum ) {
498
499     warn "  moving contacts and locations from prospect $prospectnum\n"
500       if $DEBUG > 1;
501
502     my $prospect_main =
503       qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
504     unless ( $prospect_main ) {
505       $dbh->rollback if $oldAutoCommit;
506       return "Unknown prospectnum $prospectnum";
507     }
508     $prospect_main->custnum($self->custnum);
509     $prospect_main->disabled('Y');
510     my $error = $prospect_main->replace;
511     if ( $error ) {
512       $dbh->rollback if $oldAutoCommit;
513       return $error;
514     }
515
516     my @contact = $prospect_main->contact;
517     my @cust_location = $prospect_main->cust_location;
518     my @qual = $prospect_main->qual;
519
520     foreach my $r ( @contact, @cust_location, @qual ) {
521       $r->prospectnum('');
522       $r->custnum($self->custnum);
523       my $error = $r->replace;
524       if ( $error ) {
525         $dbh->rollback if $oldAutoCommit;
526         return $error;
527       }
528     }
529
530   }
531
532   warn "  setting cust_main_exemption\n"
533     if $DEBUG > 1;
534
535   my $tax_exemption = delete $options{'tax_exemption'};
536   if ( $tax_exemption ) {
537
538     $tax_exemption = { map { $_ => '' } @$tax_exemption }
539       if ref($tax_exemption) eq 'ARRAY';
540
541     foreach my $taxname ( keys %$tax_exemption ) {
542       my $cust_main_exemption = new FS::cust_main_exemption {
543         'custnum'       => $self->custnum,
544         'taxname'       => $taxname,
545         'exempt_number' => $tax_exemption->{$taxname},
546       };
547       my $error = $cust_main_exemption->insert;
548       if ( $error ) {
549         $dbh->rollback if $oldAutoCommit;
550         return "inserting cust_main_exemption (transaction rolled back): $error";
551       }
552     }
553   }
554
555   warn "  ordering packages\n"
556     if $DEBUG > 1;
557
558   $error = $self->order_pkgs( $cust_pkgs,
559                               %options,
560                               'seconds_ref'    => \$seconds,
561                               'upbytes_ref'    => \$upbytes,
562                               'downbytes_ref'  => \$downbytes,
563                               'totalbytes_ref' => \$totalbytes,
564                             );
565   if ( $error ) {
566     $dbh->rollback if $oldAutoCommit;
567     return $error;
568   }
569
570   if ( $seconds ) {
571     $dbh->rollback if $oldAutoCommit;
572     return "No svc_acct record to apply pre-paid time";
573   }
574   if ( $upbytes || $downbytes || $totalbytes ) {
575     $dbh->rollback if $oldAutoCommit;
576     return "No svc_acct record to apply pre-paid data";
577   }
578
579   if ( $amount ) {
580     warn "  inserting initial $payby payment of $amount\n"
581       if $DEBUG > 1;
582     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
583     if ( $error ) {
584       $dbh->rollback if $oldAutoCommit;
585       return "inserting payment (transaction rolled back): $error";
586     }
587   }
588
589   unless ( $import || $skip_fuzzyfiles ) {
590     warn "  queueing fuzzyfiles update\n"
591       if $DEBUG > 1;
592     $error = $self->queue_fuzzyfiles_update;
593     if ( $error ) {
594       $dbh->rollback if $oldAutoCommit;
595       return "updating fuzzy search cache: $error";
596     }
597   }
598
599   # FS::geocode_Mixin::after_insert or something?
600   if ( $conf->config('tax_district_method') and !$import ) {
601     # if anything non-empty, try to look it up
602     my $queue = new FS::queue {
603       'job'     => 'FS::geocode_Mixin::process_district_update',
604       'custnum' => $self->custnum,
605     };
606     my $error = $queue->insert( ref($self), $self->custnum );
607     if ( $error ) {
608       $dbh->rollback if $oldAutoCommit;
609       return "queueing tax district update: $error";
610     }
611   }
612
613   # cust_main exports!
614   warn "  exporting\n" if $DEBUG > 1;
615
616   my $export_args = $options{'export_args'} || [];
617
618   my @part_export =
619     map qsearch( 'part_export', {exportnum=>$_} ),
620       $conf->config('cust_main-exports'); #, $agentnum
621
622   foreach my $part_export ( @part_export ) {
623     my $error = $part_export->export_insert($self, @$export_args);
624     if ( $error ) {
625       $dbh->rollback if $oldAutoCommit;
626       return "exporting to ". $part_export->exporttype.
627              " (transaction rolled back): $error";
628     }
629   }
630
631   #foreach my $depend_jobnum ( @$depend_jobnums ) {
632   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
633   #      if $DEBUG;
634   #    foreach my $jobnum ( @jobnums ) {
635   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
636   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
637   #        if $DEBUG;
638   #      my $error = $queue->depend_insert($depend_jobnum);
639   #      if ( $error ) {
640   #        $dbh->rollback if $oldAutoCommit;
641   #        return "error queuing job dependancy: $error";
642   #      }
643   #    }
644   #  }
645   #
646   #}
647   #
648   #if ( exists $options{'jobnums'} ) {
649   #  push @{ $options{'jobnums'} }, @jobnums;
650   #}
651
652   warn "  insert complete; committing transaction\n"
653     if $DEBUG > 1;
654
655   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
656   '';
657
658 }
659
660 use File::CounterFile;
661 sub auto_agent_custid {
662   my $self = shift;
663
664   my $format = $conf->config('cust_main-auto_agent_custid');
665   my $agent_custid;
666   if ( $format eq '1YMMXXXXXXXX' ) {
667
668     my $counter = new File::CounterFile 'cust_main.agent_custid';
669     $counter->lock;
670
671     my $ym = 100000000000 + time2str('%y%m00000000', time);
672     if ( $ym > $counter->value ) {
673       $counter->{'value'} = $agent_custid = $ym;
674       $counter->{'updated'} = 1;
675     } else {
676       $agent_custid = $counter->inc;
677     }
678
679     $counter->unlock;
680
681   } else {
682     die "Unknown cust_main-auto_agent_custid format: $format";
683   }
684
685   $self->agent_custid($agent_custid);
686
687 }
688
689 =item PACKAGE METHODS
690
691 Documentation on customer package methods has been moved to
692 L<FS::cust_main::Packages>.
693
694 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
695
696 Recharges this (existing) customer with the specified prepaid card (see
697 L<FS::prepay_credit>), specified either by I<identifier> or as an
698 FS::prepay_credit object.  If there is an error, returns the error, otherwise
699 returns false.
700
701 Optionally, five scalar references can be passed as well.  They will have their
702 values filled in with the amount, number of seconds, and number of upload,
703 download, and total bytes applied by this prepaid card.
704
705 =cut
706
707 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
708 #the only place that uses these args
709 sub recharge_prepay { 
710   my( $self, $prepay_credit, $amountref, $secondsref, 
711       $upbytesref, $downbytesref, $totalbytesref ) = @_;
712
713   local $SIG{HUP} = 'IGNORE';
714   local $SIG{INT} = 'IGNORE';
715   local $SIG{QUIT} = 'IGNORE';
716   local $SIG{TERM} = 'IGNORE';
717   local $SIG{TSTP} = 'IGNORE';
718   local $SIG{PIPE} = 'IGNORE';
719
720   my $oldAutoCommit = $FS::UID::AutoCommit;
721   local $FS::UID::AutoCommit = 0;
722   my $dbh = dbh;
723
724   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
725
726   my $error = $self->get_prepay( $prepay_credit,
727                                  'amount_ref'     => \$amount,
728                                  'seconds_ref'    => \$seconds,
729                                  'upbytes_ref'    => \$upbytes,
730                                  'downbytes_ref'  => \$downbytes,
731                                  'totalbytes_ref' => \$totalbytes,
732                                )
733            || $self->increment_seconds($seconds)
734            || $self->increment_upbytes($upbytes)
735            || $self->increment_downbytes($downbytes)
736            || $self->increment_totalbytes($totalbytes)
737            || $self->insert_cust_pay_prepay( $amount,
738                                              ref($prepay_credit)
739                                                ? $prepay_credit->identifier
740                                                : $prepay_credit
741                                            );
742
743   if ( $error ) {
744     $dbh->rollback if $oldAutoCommit;
745     return $error;
746   }
747
748   if ( defined($amountref)  ) { $$amountref  = $amount;  }
749   if ( defined($secondsref) ) { $$secondsref = $seconds; }
750   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
751   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
752   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
753
754   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
755   '';
756
757 }
758
759 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
760
761 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
762 specified either by I<identifier> or as an FS::prepay_credit object.
763
764 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
765 incremented by the values of the prepaid card.
766
767 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
768 check or set this customer's I<agentnum>.
769
770 If there is an error, returns the error, otherwise returns false.
771
772 =cut
773
774
775 sub get_prepay {
776   my( $self, $prepay_credit, %opt ) = @_;
777
778   local $SIG{HUP} = 'IGNORE';
779   local $SIG{INT} = 'IGNORE';
780   local $SIG{QUIT} = 'IGNORE';
781   local $SIG{TERM} = 'IGNORE';
782   local $SIG{TSTP} = 'IGNORE';
783   local $SIG{PIPE} = 'IGNORE';
784
785   my $oldAutoCommit = $FS::UID::AutoCommit;
786   local $FS::UID::AutoCommit = 0;
787   my $dbh = dbh;
788
789   unless ( ref($prepay_credit) ) {
790
791     my $identifier = $prepay_credit;
792
793     $prepay_credit = qsearchs(
794       'prepay_credit',
795       { 'identifier' => $identifier },
796       '',
797       'FOR UPDATE'
798     );
799
800     unless ( $prepay_credit ) {
801       $dbh->rollback if $oldAutoCommit;
802       return "Invalid prepaid card: ". $identifier;
803     }
804
805   }
806
807   if ( $prepay_credit->agentnum ) {
808     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
809       $dbh->rollback if $oldAutoCommit;
810       return "prepaid card not valid for agent ". $self->agentnum;
811     }
812     $self->agentnum($prepay_credit->agentnum);
813   }
814
815   my $error = $prepay_credit->delete;
816   if ( $error ) {
817     $dbh->rollback if $oldAutoCommit;
818     return "removing prepay_credit (transaction rolled back): $error";
819   }
820
821   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
822     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
823
824   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
825   '';
826
827 }
828
829 =item increment_upbytes SECONDS
830
831 Updates this customer's single or primary account (see L<FS::svc_acct>) by
832 the specified number of upbytes.  If there is an error, returns the error,
833 otherwise returns false.
834
835 =cut
836
837 sub increment_upbytes {
838   _increment_column( shift, 'upbytes', @_);
839 }
840
841 =item increment_downbytes SECONDS
842
843 Updates this customer's single or primary account (see L<FS::svc_acct>) by
844 the specified number of downbytes.  If there is an error, returns the error,
845 otherwise returns false.
846
847 =cut
848
849 sub increment_downbytes {
850   _increment_column( shift, 'downbytes', @_);
851 }
852
853 =item increment_totalbytes SECONDS
854
855 Updates this customer's single or primary account (see L<FS::svc_acct>) by
856 the specified number of totalbytes.  If there is an error, returns the error,
857 otherwise returns false.
858
859 =cut
860
861 sub increment_totalbytes {
862   _increment_column( shift, 'totalbytes', @_);
863 }
864
865 =item increment_seconds SECONDS
866
867 Updates this customer's single or primary account (see L<FS::svc_acct>) by
868 the specified number of seconds.  If there is an error, returns the error,
869 otherwise returns false.
870
871 =cut
872
873 sub increment_seconds {
874   _increment_column( shift, 'seconds', @_);
875 }
876
877 =item _increment_column AMOUNT
878
879 Updates this customer's single or primary account (see L<FS::svc_acct>) by
880 the specified number of seconds or bytes.  If there is an error, returns
881 the error, otherwise returns false.
882
883 =cut
884
885 sub _increment_column {
886   my( $self, $column, $amount ) = @_;
887   warn "$me increment_column called: $column, $amount\n"
888     if $DEBUG;
889
890   return '' unless $amount;
891
892   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
893                       $self->ncancelled_pkgs;
894
895   if ( ! @cust_pkg ) {
896     return 'No packages with primary or single services found'.
897            ' to apply pre-paid time';
898   } elsif ( scalar(@cust_pkg) > 1 ) {
899     #maybe have a way to specify the package/account?
900     return 'Multiple packages found to apply pre-paid time';
901   }
902
903   my $cust_pkg = $cust_pkg[0];
904   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
905     if $DEBUG > 1;
906
907   my @cust_svc =
908     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
909
910   if ( ! @cust_svc ) {
911     return 'No account found to apply pre-paid time';
912   } elsif ( scalar(@cust_svc) > 1 ) {
913     return 'Multiple accounts found to apply pre-paid time';
914   }
915   
916   my $svc_acct = $cust_svc[0]->svc_x;
917   warn "  found service svcnum ". $svc_acct->pkgnum.
918        ' ('. $svc_acct->email. ")\n"
919     if $DEBUG > 1;
920
921   $column = "increment_$column";
922   $svc_acct->$column($amount);
923
924 }
925
926 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
927
928 Inserts a prepayment in the specified amount for this customer.  An optional
929 second argument can specify the prepayment identifier for tracking purposes.
930 If there is an error, returns the error, otherwise returns false.
931
932 =cut
933
934 sub insert_cust_pay_prepay {
935   shift->insert_cust_pay('PREP', @_);
936 }
937
938 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
939
940 Inserts a cash payment in the specified amount for this customer.  An optional
941 second argument can specify the payment identifier for tracking purposes.
942 If there is an error, returns the error, otherwise returns false.
943
944 =cut
945
946 sub insert_cust_pay_cash {
947   shift->insert_cust_pay('CASH', @_);
948 }
949
950 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
951
952 Inserts a Western Union payment in the specified amount for this customer.  An
953 optional second argument can specify the prepayment identifier for tracking
954 purposes.  If there is an error, returns the error, otherwise returns false.
955
956 =cut
957
958 sub insert_cust_pay_west {
959   shift->insert_cust_pay('WEST', @_);
960 }
961
962 sub insert_cust_pay {
963   my( $self, $payby, $amount ) = splice(@_, 0, 3);
964   my $payinfo = scalar(@_) ? shift : '';
965
966   my $cust_pay = new FS::cust_pay {
967     'custnum' => $self->custnum,
968     'paid'    => sprintf('%.2f', $amount),
969     #'_date'   => #date the prepaid card was purchased???
970     'payby'   => $payby,
971     'payinfo' => $payinfo,
972   };
973   $cust_pay->insert;
974
975 }
976
977 =item delete [ OPTION => VALUE ... ]
978
979 This deletes the customer.  If there is an error, returns the error, otherwise
980 returns false.
981
982 This will completely remove all traces of the customer record.  This is not
983 what you want when a customer cancels service; for that, cancel all of the
984 customer's packages (see L</cancel>).
985
986 If the customer has any uncancelled packages, you need to pass a new (valid)
987 customer number for those packages to be transferred to, as the "new_customer"
988 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
989 what you want when a customer cancels service and that you really should be
990 looking at L<FS::cust_pkg/cancel>?  
991
992 You can't delete a customer with invoices (see L<FS::cust_bill>),
993 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
994 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
995 set the "delete_financials" option to a true value.
996
997 =cut
998
999 sub delete {
1000   my( $self, %opt ) = @_;
1001
1002   local $SIG{HUP} = 'IGNORE';
1003   local $SIG{INT} = 'IGNORE';
1004   local $SIG{QUIT} = 'IGNORE';
1005   local $SIG{TERM} = 'IGNORE';
1006   local $SIG{TSTP} = 'IGNORE';
1007   local $SIG{PIPE} = 'IGNORE';
1008
1009   my $oldAutoCommit = $FS::UID::AutoCommit;
1010   local $FS::UID::AutoCommit = 0;
1011   my $dbh = dbh;
1012
1013   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1014      $dbh->rollback if $oldAutoCommit;
1015      return "Can't delete a master agent customer";
1016   }
1017
1018   #use FS::access_user
1019   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1020      $dbh->rollback if $oldAutoCommit;
1021      return "Can't delete a master employee customer";
1022   }
1023
1024   tie my %financial_tables, 'Tie::IxHash',
1025     'cust_bill'      => 'invoices',
1026     'cust_statement' => 'statements',
1027     'cust_credit'    => 'credits',
1028     'cust_pay'       => 'payments',
1029     'cust_refund'    => 'refunds',
1030   ;
1031    
1032   foreach my $table ( keys %financial_tables ) {
1033
1034     my @records = $self->$table();
1035
1036     if ( @records && ! $opt{'delete_financials'} ) {
1037       $dbh->rollback if $oldAutoCommit;
1038       return "Can't delete a customer with ". $financial_tables{$table};
1039     }
1040
1041     foreach my $record ( @records ) {
1042       my $error = $record->delete;
1043       if ( $error ) {
1044         $dbh->rollback if $oldAutoCommit;
1045         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1046       }
1047     }
1048
1049   }
1050
1051   my @cust_pkg = $self->ncancelled_pkgs;
1052   if ( @cust_pkg ) {
1053     my $new_custnum = $opt{'new_custnum'};
1054     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1055       $dbh->rollback if $oldAutoCommit;
1056       return "Invalid new customer number: $new_custnum";
1057     }
1058     foreach my $cust_pkg ( @cust_pkg ) {
1059       my %hash = $cust_pkg->hash;
1060       $hash{'custnum'} = $new_custnum;
1061       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1062       my $error = $new_cust_pkg->replace($cust_pkg,
1063                                          options => { $cust_pkg->options },
1064                                         );
1065       if ( $error ) {
1066         $dbh->rollback if $oldAutoCommit;
1067         return $error;
1068       }
1069     }
1070   }
1071   my @cancelled_cust_pkg = $self->all_pkgs;
1072   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1073     my $error = $cust_pkg->delete;
1074     if ( $error ) {
1075       $dbh->rollback if $oldAutoCommit;
1076       return $error;
1077     }
1078   }
1079
1080   #cust_tax_adjustment in financials?
1081   #cust_pay_pending?  ouch
1082   #cust_recon?
1083   foreach my $table (qw(
1084     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1085     cust_location cust_main_note cust_tax_adjustment
1086     cust_pay_void cust_pay_batch queue cust_tax_exempt
1087   )) {
1088     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1089       my $error = $record->delete;
1090       if ( $error ) {
1091         $dbh->rollback if $oldAutoCommit;
1092         return $error;
1093       }
1094     }
1095   }
1096
1097   my $sth = $dbh->prepare(
1098     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1099   ) or do {
1100     my $errstr = $dbh->errstr;
1101     $dbh->rollback if $oldAutoCommit;
1102     return $errstr;
1103   };
1104   $sth->execute($self->custnum) or do {
1105     my $errstr = $sth->errstr;
1106     $dbh->rollback if $oldAutoCommit;
1107     return $errstr;
1108   };
1109
1110   #tickets
1111
1112   my $ticket_dbh = '';
1113   if ($conf->config('ticket_system') eq 'RT_Internal') {
1114     $ticket_dbh = $dbh;
1115   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1116     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1117     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1118       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1119   }
1120
1121   if ( $ticket_dbh ) {
1122
1123     my $ticket_sth = $ticket_dbh->prepare(
1124       'DELETE FROM Links WHERE Target = ?'
1125     ) or do {
1126       my $errstr = $ticket_dbh->errstr;
1127       $dbh->rollback if $oldAutoCommit;
1128       return $errstr;
1129     };
1130     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1131       or do {
1132         my $errstr = $ticket_sth->errstr;
1133         $dbh->rollback if $oldAutoCommit;
1134         return $errstr;
1135       };
1136
1137     #check and see if the customer is the only link on the ticket, and
1138     #if so, set the ticket to deleted status in RT?
1139     #maybe someday, for now this will at least fix tickets not displaying
1140
1141   }
1142
1143   #delete the customer record
1144
1145   my $error = $self->SUPER::delete;
1146   if ( $error ) {
1147     $dbh->rollback if $oldAutoCommit;
1148     return $error;
1149   }
1150
1151   # cust_main exports!
1152
1153   #my $export_args = $options{'export_args'} || [];
1154
1155   my @part_export =
1156     map qsearch( 'part_export', {exportnum=>$_} ),
1157       $conf->config('cust_main-exports'); #, $agentnum
1158
1159   foreach my $part_export ( @part_export ) {
1160     my $error = $part_export->export_delete( $self ); #, @$export_args);
1161     if ( $error ) {
1162       $dbh->rollback if $oldAutoCommit;
1163       return "exporting to ". $part_export->exporttype.
1164              " (transaction rolled back): $error";
1165     }
1166   }
1167
1168   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1169   '';
1170
1171 }
1172
1173 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1174
1175 This merges this customer into the provided new custnum, and then deletes the
1176 customer.  If there is an error, returns the error, otherwise returns false.
1177
1178 The source customer's name, company name, phone numbers, agent,
1179 referring customer, customer class, advertising source, order taker, and
1180 billing information (except balance) are discarded.
1181
1182 All packages are moved to the target customer.  Packages with package locations
1183 are preserved.  Packages without package locations are moved to a new package
1184 location with the source customer's service/shipping address.
1185
1186 All invoices, statements, payments, credits and refunds are moved to the target
1187 customer.  The source customer's balance is added to the target customer.
1188
1189 All notes, attachments, tickets and customer tags are moved to the target
1190 customer.
1191
1192 Change history is not currently moved.
1193
1194 =cut
1195
1196 sub merge {
1197   my( $self, $new_custnum, %opt ) = @_;
1198
1199   return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1200
1201   my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1202     or return "Invalid new customer number: $new_custnum";
1203
1204   return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1205     if $self->agentnum != $new_cust_main->agentnum 
1206     && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1207
1208   local $SIG{HUP} = 'IGNORE';
1209   local $SIG{INT} = 'IGNORE';
1210   local $SIG{QUIT} = 'IGNORE';
1211   local $SIG{TERM} = 'IGNORE';
1212   local $SIG{TSTP} = 'IGNORE';
1213   local $SIG{PIPE} = 'IGNORE';
1214
1215   my $oldAutoCommit = $FS::UID::AutoCommit;
1216   local $FS::UID::AutoCommit = 0;
1217   my $dbh = dbh;
1218
1219   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1220      $dbh->rollback if $oldAutoCommit;
1221      return "Can't merge a master agent customer";
1222   }
1223
1224   #use FS::access_user
1225   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1226      $dbh->rollback if $oldAutoCommit;
1227      return "Can't merge a master employee customer";
1228   }
1229
1230   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1231                                      'status'  => { op=>'!=', value=>'done' },
1232                                    }
1233               )
1234   ) {
1235      $dbh->rollback if $oldAutoCommit;
1236      return "Can't merge a customer with pending payments";
1237   }
1238
1239   tie my %financial_tables, 'Tie::IxHash',
1240     'cust_bill'      => 'invoices',
1241     'cust_bill_void' => 'voided invoices',
1242     'cust_statement' => 'statements',
1243     'cust_credit'    => 'credits',
1244     'cust_pay'       => 'payments',
1245     'cust_pay_void'  => 'voided payments',
1246     'cust_refund'    => 'refunds',
1247   ;
1248    
1249   foreach my $table ( keys %financial_tables ) {
1250
1251     my @records = $self->$table();
1252
1253     foreach my $record ( @records ) {
1254       $record->custnum($new_custnum);
1255       my $error = $record->replace;
1256       if ( $error ) {
1257         $dbh->rollback if $oldAutoCommit;
1258         return "Error merging ". $financial_tables{$table}. ": $error\n";
1259       }
1260     }
1261
1262   }
1263
1264   my $name = $self->ship_name; #?
1265
1266   my $locationnum = '';
1267   foreach my $cust_pkg ( $self->all_pkgs ) {
1268     $cust_pkg->custnum($new_custnum);
1269
1270     unless ( $cust_pkg->locationnum ) {
1271       unless ( $locationnum ) {
1272         my $cust_location = new FS::cust_location {
1273           $self->location_hash,
1274           'custnum' => $new_custnum,
1275         };
1276         my $error = $cust_location->insert;
1277         if ( $error ) {
1278           $dbh->rollback if $oldAutoCommit;
1279           return $error;
1280         }
1281         $locationnum = $cust_location->locationnum;
1282       }
1283       $cust_pkg->locationnum($locationnum);
1284     }
1285
1286     my $error = $cust_pkg->replace;
1287     if ( $error ) {
1288       $dbh->rollback if $oldAutoCommit;
1289       return $error;
1290     }
1291
1292     # add customer (ship) name to svc_phone.phone_name if blank
1293     my @cust_svc = $cust_pkg->cust_svc;
1294     foreach my $cust_svc (@cust_svc) {
1295       my($label, $value, $svcdb) = $cust_svc->label;
1296       next unless $svcdb eq 'svc_phone';
1297       my $svc_phone = $cust_svc->svc_x;
1298       next if $svc_phone->phone_name;
1299       $svc_phone->phone_name($name);
1300       my $error = $svc_phone->replace;
1301       if ( $error ) {
1302         $dbh->rollback if $oldAutoCommit;
1303         return $error;
1304       }
1305     }
1306
1307   }
1308
1309   #not considered:
1310   # cust_tax_exempt (texas tax exemptions)
1311   # cust_recon (some sort of not-well understood thing for OnPac)
1312
1313   #these are moved over
1314   foreach my $table (qw(
1315     cust_tag cust_location contact cust_attachment cust_main_note
1316     cust_tax_adjustment cust_pay_batch queue
1317   )) {
1318     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1319       $record->custnum($new_custnum);
1320       my $error = $record->replace;
1321       if ( $error ) {
1322         $dbh->rollback if $oldAutoCommit;
1323         return $error;
1324       }
1325     }
1326   }
1327
1328   #these aren't preserved
1329   foreach my $table (qw(
1330     cust_main_exemption cust_main_invoice
1331   )) {
1332     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1333       my $error = $record->delete;
1334       if ( $error ) {
1335         $dbh->rollback if $oldAutoCommit;
1336         return $error;
1337       }
1338     }
1339   }
1340
1341
1342   my $sth = $dbh->prepare(
1343     'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1344   ) or do {
1345     my $errstr = $dbh->errstr;
1346     $dbh->rollback if $oldAutoCommit;
1347     return $errstr;
1348   };
1349   $sth->execute($new_custnum, $self->custnum) or do {
1350     my $errstr = $sth->errstr;
1351     $dbh->rollback if $oldAutoCommit;
1352     return $errstr;
1353   };
1354
1355   #tickets
1356
1357   my $ticket_dbh = '';
1358   if ($conf->config('ticket_system') eq 'RT_Internal') {
1359     $ticket_dbh = $dbh;
1360   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1361     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1362     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1363       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1364   }
1365
1366   if ( $ticket_dbh ) {
1367
1368     my $ticket_sth = $ticket_dbh->prepare(
1369       'UPDATE Links SET Target = ? WHERE Target = ?'
1370     ) or do {
1371       my $errstr = $ticket_dbh->errstr;
1372       $dbh->rollback if $oldAutoCommit;
1373       return $errstr;
1374     };
1375     $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1376                          'freeside://freeside/cust_main/'.$self->custnum)
1377       or do {
1378         my $errstr = $ticket_sth->errstr;
1379         $dbh->rollback if $oldAutoCommit;
1380         return $errstr;
1381       };
1382
1383   }
1384
1385   #delete the customer record
1386
1387   my $error = $self->delete;
1388   if ( $error ) {
1389     $dbh->rollback if $oldAutoCommit;
1390     return $error;
1391   }
1392
1393   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1394   '';
1395
1396 }
1397
1398 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1399
1400 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1401 returns the error, otherwise returns false.
1402
1403 To change the customer's address, set the pseudo-fields C<bill_location> and
1404 C<ship_location>.  The address will still only change if at least one of the
1405 address fields differs from the existing values.
1406
1407 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1408 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1409 expected and rollback the entire transaction; it is not necessary to call 
1410 check_invoicing_list first.  Here's an example:
1411
1412   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1413
1414 Currently available options are: I<tax_exemption>.
1415
1416 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1417 of tax names and exemption numbers.  FS::cust_main_exemption records will be
1418 deleted and inserted as appropriate.
1419
1420 =cut
1421
1422 sub replace {
1423   my $self = shift;
1424
1425   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1426               ? shift
1427               : $self->replace_old;
1428
1429   my @param = @_;
1430
1431   warn "$me replace called\n"
1432     if $DEBUG;
1433
1434   my $curuser = $FS::CurrentUser::CurrentUser;
1435   if (    $self->payby eq 'COMP'
1436        && $self->payby ne $old->payby
1437        && ! $curuser->access_right('Complimentary customer')
1438      )
1439   {
1440     return "You are not permitted to create complimentary accounts.";
1441   }
1442
1443   local($ignore_expired_card) = 1
1444     if $old->payby  =~ /^(CARD|DCRD)$/
1445     && $self->payby =~ /^(CARD|DCRD)$/
1446     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1447
1448   local($ignore_banned_card) = 1
1449     if (    $old->payby  =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1450          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1451     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1452
1453   return "Invoicing locale is required"
1454     if $old->locale
1455     && ! $self->locale
1456     && $conf->exists('cust_main-require_locale');
1457
1458   local $SIG{HUP} = 'IGNORE';
1459   local $SIG{INT} = 'IGNORE';
1460   local $SIG{QUIT} = 'IGNORE';
1461   local $SIG{TERM} = 'IGNORE';
1462   local $SIG{TSTP} = 'IGNORE';
1463   local $SIG{PIPE} = 'IGNORE';
1464
1465   my $oldAutoCommit = $FS::UID::AutoCommit;
1466   local $FS::UID::AutoCommit = 0;
1467   my $dbh = dbh;
1468
1469   for my $l (qw(bill_location ship_location)) {
1470     my $old_loc = $old->$l;
1471     my $new_loc = $self->$l;
1472
1473     # find the existing location if there is one
1474     $new_loc->set('custnum' => $self->custnum);
1475     my $error = $new_loc->find_or_insert;
1476     if ( $error ) {
1477       $dbh->rollback if $oldAutoCommit;
1478       return $error;
1479     }
1480     $self->set($l.'num', $new_loc->locationnum);
1481   } #for $l
1482
1483   # replace the customer record
1484   my $error = $self->SUPER::replace($old);
1485
1486   if ( $error ) {
1487     $dbh->rollback if $oldAutoCommit;
1488     return $error;
1489   }
1490
1491   # now move packages to the new service location
1492   $self->set('ship_location', ''); #flush cache
1493   if ( $old->ship_locationnum and # should only be null during upgrade...
1494        $old->ship_locationnum != $self->ship_locationnum ) {
1495     $error = $old->ship_location->move_to($self->ship_location);
1496     if ( $error ) {
1497       $dbh->rollback if $oldAutoCommit;
1498       return $error;
1499     }
1500   }
1501   # don't move packages based on the billing location, but 
1502   # disable it if it's no longer in use
1503   if ( $old->bill_locationnum and
1504        $old->bill_locationnum != $self->bill_locationnum ) {
1505     $error = $old->bill_location->disable_if_unused;
1506     if ( $error ) {
1507       $dbh->rollback if $oldAutoCommit;
1508       return $error;
1509     }
1510   }
1511
1512   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1513     my $invoicing_list = shift @param;
1514     $error = $self->check_invoicing_list( $invoicing_list );
1515     if ( $error ) {
1516       $dbh->rollback if $oldAutoCommit;
1517       return $error;
1518     }
1519     $self->invoicing_list( $invoicing_list );
1520   }
1521
1522   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1523
1524     #this could be more efficient than deleting and re-inserting, if it matters
1525     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1526       my $error = $cust_tag->delete;
1527       if ( $error ) {
1528         $dbh->rollback if $oldAutoCommit;
1529         return $error;
1530       }
1531     }
1532     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1533       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1534                                         'custnum' => $self->custnum };
1535       my $error = $cust_tag->insert;
1536       if ( $error ) {
1537         $dbh->rollback if $oldAutoCommit;
1538         return $error;
1539       }
1540     }
1541
1542   }
1543
1544   my %options = @param;
1545
1546   my $tax_exemption = delete $options{'tax_exemption'};
1547   if ( $tax_exemption ) {
1548
1549     $tax_exemption = { map { $_ => '' } @$tax_exemption }
1550       if ref($tax_exemption) eq 'ARRAY';
1551
1552     my %cust_main_exemption =
1553       map { $_->taxname => $_ }
1554           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1555
1556     foreach my $taxname ( keys %$tax_exemption ) {
1557
1558       if ( $cust_main_exemption{$taxname} && 
1559            $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1560          )
1561       {
1562         delete $cust_main_exemption{$taxname};
1563         next;
1564       }
1565
1566       my $cust_main_exemption = new FS::cust_main_exemption {
1567         'custnum'       => $self->custnum,
1568         'taxname'       => $taxname,
1569         'exempt_number' => $tax_exemption->{$taxname},
1570       };
1571       my $error = $cust_main_exemption->insert;
1572       if ( $error ) {
1573         $dbh->rollback if $oldAutoCommit;
1574         return "inserting cust_main_exemption (transaction rolled back): $error";
1575       }
1576     }
1577
1578     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1579       my $error = $cust_main_exemption->delete;
1580       if ( $error ) {
1581         $dbh->rollback if $oldAutoCommit;
1582         return "deleting cust_main_exemption (transaction rolled back): $error";
1583       }
1584     }
1585
1586   }
1587
1588   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1589        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1590               && $self->get('payinfo') !~ /^99\d{14}$/ 
1591             )
1592             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1593           )
1594      )
1595   {
1596
1597     # card/check/lec info has changed, want to retry realtime_ invoice events
1598     my $error = $self->retry_realtime;
1599     if ( $error ) {
1600       $dbh->rollback if $oldAutoCommit;
1601       return $error;
1602     }
1603   }
1604
1605   unless ( $import || $skip_fuzzyfiles ) {
1606     $error = $self->queue_fuzzyfiles_update;
1607     if ( $error ) {
1608       $dbh->rollback if $oldAutoCommit;
1609       return "updating fuzzy search cache: $error";
1610     }
1611   }
1612
1613   # tax district update in cust_location
1614
1615   # cust_main exports!
1616
1617   my $export_args = $options{'export_args'} || [];
1618
1619   my @part_export =
1620     map qsearch( 'part_export', {exportnum=>$_} ),
1621       $conf->config('cust_main-exports'); #, $agentnum
1622
1623   foreach my $part_export ( @part_export ) {
1624     my $error = $part_export->export_replace( $self, $old, @$export_args);
1625     if ( $error ) {
1626       $dbh->rollback if $oldAutoCommit;
1627       return "exporting to ". $part_export->exporttype.
1628              " (transaction rolled back): $error";
1629     }
1630   }
1631
1632   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1633   '';
1634
1635 }
1636
1637 =item queue_fuzzyfiles_update
1638
1639 Used by insert & replace to update the fuzzy search cache
1640
1641 =cut
1642
1643 use FS::cust_main::Search;
1644 sub queue_fuzzyfiles_update {
1645   my $self = shift;
1646
1647   local $SIG{HUP} = 'IGNORE';
1648   local $SIG{INT} = 'IGNORE';
1649   local $SIG{QUIT} = 'IGNORE';
1650   local $SIG{TERM} = 'IGNORE';
1651   local $SIG{TSTP} = 'IGNORE';
1652   local $SIG{PIPE} = 'IGNORE';
1653
1654   my $oldAutoCommit = $FS::UID::AutoCommit;
1655   local $FS::UID::AutoCommit = 0;
1656   my $dbh = dbh;
1657
1658   my @locations = $self->bill_location;
1659   push @locations, $self->ship_location if $self->has_ship_address;
1660   foreach my $location (@locations) {
1661     my $queue = new FS::queue { 
1662       'job' => 'FS::cust_main::Search::append_fuzzyfiles'
1663     };
1664     my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields;
1665     my $error = $queue->insert( @args );
1666     if ( $error ) {
1667       $dbh->rollback if $oldAutoCommit;
1668       return "queueing job (transaction rolled back): $error";
1669     }
1670   }
1671
1672   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1673   '';
1674
1675 }
1676
1677 =item check
1678
1679 Checks all fields to make sure this is a valid customer record.  If there is
1680 an error, returns the error, otherwise returns false.  Called by the insert
1681 and replace methods.
1682
1683 =cut
1684
1685 sub check {
1686   my $self = shift;
1687
1688   warn "$me check BEFORE: \n". $self->_dump
1689     if $DEBUG > 2;
1690
1691   my $error =
1692     $self->ut_numbern('custnum')
1693     || $self->ut_number('agentnum')
1694     || $self->ut_textn('agent_custid')
1695     || $self->ut_number('refnum')
1696     || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1697     || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1698     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1699     || $self->ut_textn('custbatch')
1700     || $self->ut_name('last')
1701     || $self->ut_name('first')
1702     || $self->ut_snumbern('signupdate')
1703     || $self->ut_snumbern('birthdate')
1704     || $self->ut_snumbern('spouse_birthdate')
1705     || $self->ut_snumbern('anniversary_date')
1706     || $self->ut_textn('company')
1707     || $self->ut_anything('comments')
1708     || $self->ut_numbern('referral_custnum')
1709     || $self->ut_textn('stateid')
1710     || $self->ut_textn('stateid_state')
1711     || $self->ut_textn('invoice_terms')
1712     || $self->ut_floatn('cdr_termination_percentage')
1713     || $self->ut_floatn('credit_limit')
1714     || $self->ut_numbern('billday')
1715     || $self->ut_numbern('prorate_day')
1716     || $self->ut_flag('edit_subject')
1717     || $self->ut_flag('calling_list_exempt')
1718     || $self->ut_flag('invoice_noemail')
1719     || $self->ut_flag('message_noemail')
1720     || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1721     || $self->ut_currencyn('currency')
1722   ;
1723
1724   my $company = $self->company;
1725   $company =~ s/^\s+//; 
1726   $company =~ s/\s+$//; 
1727   $company =~ s/\s+/ /g;
1728   $self->company($company);
1729
1730   #barf.  need message catalogs.  i18n.  etc.
1731   $error .= "Please select an advertising source."
1732     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1733   return $error if $error;
1734
1735   my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1736     or return "Unknown agent";
1737
1738   if ( $self->currency ) {
1739     my $agent_currency = qsearchs( 'agent_currency', {
1740       'agentnum' => $agent->agentnum,
1741       'currency' => $self->currency,
1742     })
1743       or return "Agent ". $agent->agent.
1744                 " not permitted to offer ".  $self->currency. " invoicing";
1745   }
1746
1747   return "Unknown refnum"
1748     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1749
1750   return "Unknown referring custnum: ". $self->referral_custnum
1751     unless ! $self->referral_custnum 
1752            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1753
1754   if ( $self->ss eq '' ) {
1755     $self->ss('');
1756   } else {
1757     my $ss = $self->ss;
1758     $ss =~ s/\D//g;
1759     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1760       or return "Illegal social security number: ". $self->ss;
1761     $self->ss("$1-$2-$3");
1762   }
1763
1764   # cust_main_county verification now handled by cust_location check
1765
1766   $error =
1767        $self->ut_phonen('daytime', $self->country)
1768     || $self->ut_phonen('night',   $self->country)
1769     || $self->ut_phonen('fax',     $self->country)
1770     || $self->ut_phonen('mobile',  $self->country)
1771   ;
1772   return $error if $error;
1773
1774   if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1775        && ! $import
1776        && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1777      ) {
1778
1779     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1780                           ? 'Day Phone'
1781                           : FS::Msgcat::_gettext('daytime');
1782     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1783                         ? 'Night Phone'
1784                         : FS::Msgcat::_gettext('night');
1785
1786     my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1787                         ? 'Mobile Phone'
1788                         : FS::Msgcat::_gettext('mobile');
1789
1790     return "$daytime_label, $night_label or $mobile_label is required"
1791   
1792   }
1793
1794   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1795   #  or return "Illegal payby: ". $self->payby;
1796   #$self->payby($1);
1797   FS::payby->can_payby($self->table, $self->payby)
1798     or return "Illegal payby: ". $self->payby;
1799
1800   $error =    $self->ut_numbern('paystart_month')
1801            || $self->ut_numbern('paystart_year')
1802            || $self->ut_numbern('payissue')
1803            || $self->ut_textn('paytype')
1804   ;
1805   return $error if $error;
1806
1807   if ( $self->payip eq '' ) {
1808     $self->payip('');
1809   } else {
1810     $error = $self->ut_ip('payip');
1811     return $error if $error;
1812   }
1813
1814   # If it is encrypted and the private key is not availaible then we can't
1815   # check the credit card.
1816   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1817
1818   # Need some kind of global flag to accept invalid cards, for testing
1819   # on scrubbed data.
1820   if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1821
1822     my $payinfo = $self->payinfo;
1823     $payinfo =~ s/\D//g;
1824     $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1825       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1826     $payinfo = $1;
1827     $self->payinfo($payinfo);
1828     validate($payinfo)
1829       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1830
1831     return gettext('unknown_card_type')
1832       if $self->payinfo !~ /^99\d{14}$/ #token
1833       && cardtype($self->payinfo) eq "Unknown";
1834
1835     unless ( $ignore_banned_card ) {
1836       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1837       if ( $ban ) {
1838         if ( $ban->bantype eq 'warn' ) {
1839           #or others depending on value of $ban->reason ?
1840           return '_duplicate_card'.
1841                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1842                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
1843                  ' (ban# '. $ban->bannum. ')'
1844             unless $self->override_ban_warn;
1845         } else {
1846           return 'Banned credit card: banned on '.
1847                  time2str('%a %h %o at %r', $ban->_date).
1848                  ' by '. $ban->otaker.
1849                  ' (ban# '. $ban->bannum. ')';
1850         }
1851       }
1852     }
1853
1854     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1855       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1856         $self->paycvv =~ /^(\d{4})$/
1857           or return "CVV2 (CID) for American Express cards is four digits.";
1858         $self->paycvv($1);
1859       } else {
1860         $self->paycvv =~ /^(\d{3})$/
1861           or return "CVV2 (CVC2/CID) is three digits.";
1862         $self->paycvv($1);
1863       }
1864     } else {
1865       $self->paycvv('');
1866     }
1867
1868     my $cardtype = cardtype($payinfo);
1869     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1870
1871       return "Start date or issue number is required for $cardtype cards"
1872         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1873
1874       return "Start month must be between 1 and 12"
1875         if $self->paystart_month
1876            and $self->paystart_month < 1 || $self->paystart_month > 12;
1877
1878       return "Start year must be 1990 or later"
1879         if $self->paystart_year
1880            and $self->paystart_year < 1990;
1881
1882       return "Issue number must be beween 1 and 99"
1883         if $self->payissue
1884           and $self->payissue < 1 || $self->payissue > 99;
1885
1886     } else {
1887       $self->paystart_month('');
1888       $self->paystart_year('');
1889       $self->payissue('');
1890     }
1891
1892   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1893
1894     my $payinfo = $self->payinfo;
1895     $payinfo =~ s/[^\d\@\.]//g;
1896     if ( $conf->config('echeck-country') eq 'CA' ) {
1897       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1898         or return 'invalid echeck account@branch.bank';
1899       $payinfo = "$1\@$2.$3";
1900     } elsif ( $conf->config('echeck-country') eq 'US' ) {
1901       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1902       $payinfo = "$1\@$2";
1903     } else {
1904       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1905       $payinfo = "$1\@$2";
1906     }
1907     $self->payinfo($payinfo);
1908     $self->paycvv('');
1909
1910     unless ( $ignore_banned_card ) {
1911       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1912       if ( $ban ) {
1913         if ( $ban->bantype eq 'warn' ) {
1914           #or others depending on value of $ban->reason ?
1915           return '_duplicate_ach' unless $self->override_ban_warn;
1916         } else {
1917           return 'Banned ACH account: banned on '.
1918                  time2str('%a %h %o at %r', $ban->_date).
1919                  ' by '. $ban->otaker.
1920                  ' (ban# '. $ban->bannum. ')';
1921         }
1922       }
1923     }
1924
1925   } elsif ( $self->payby eq 'LECB' ) {
1926
1927     my $payinfo = $self->payinfo;
1928     $payinfo =~ s/\D//g;
1929     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1930     $payinfo = $1;
1931     $self->payinfo($payinfo);
1932     $self->paycvv('');
1933
1934   } elsif ( $self->payby eq 'BILL' ) {
1935
1936     $error = $self->ut_textn('payinfo');
1937     return "Illegal P.O. number: ". $self->payinfo if $error;
1938     $self->paycvv('');
1939
1940   } elsif ( $self->payby eq 'COMP' ) {
1941
1942     my $curuser = $FS::CurrentUser::CurrentUser;
1943     if (    ! $self->custnum
1944          && ! $curuser->access_right('Complimentary customer')
1945        )
1946     {
1947       return "You are not permitted to create complimentary accounts."
1948     }
1949
1950     $error = $self->ut_textn('payinfo');
1951     return "Illegal comp account issuer: ". $self->payinfo if $error;
1952     $self->paycvv('');
1953
1954   } elsif ( $self->payby eq 'PREPAY' ) {
1955
1956     my $payinfo = $self->payinfo;
1957     $payinfo =~ s/\W//g; #anything else would just confuse things
1958     $self->payinfo($payinfo);
1959     $error = $self->ut_alpha('payinfo');
1960     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1961     return "Unknown prepayment identifier"
1962       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1963     $self->paycvv('');
1964
1965   }
1966
1967   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1968     return "Expiration date required"
1969       # shouldn't payinfo_check do this?
1970       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1971     $self->paydate('');
1972   } else {
1973     my( $m, $y );
1974     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1975       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1976     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1977       ( $m, $y ) = ( $2, "19$1" );
1978     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1979       ( $m, $y ) = ( $3, "20$2" );
1980     } else {
1981       return "Illegal expiration date: ". $self->paydate;
1982     }
1983     $m = sprintf('%02d',$m);
1984     $self->paydate("$y-$m-01");
1985     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1986     return gettext('expired_card')
1987       if !$import
1988       && !$ignore_expired_card 
1989       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1990   }
1991
1992   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1993        ( ! $conf->exists('require_cardname')
1994          || $self->payby !~ /^(CARD|DCRD)$/  ) 
1995   ) {
1996     $self->payname( $self->first. " ". $self->getfield('last') );
1997   } else {
1998     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1999       or return gettext('illegal_name'). " payname: ". $self->payname;
2000     $self->payname($1);
2001   }
2002
2003   return "Please select an invoicing locale"
2004     if ! $self->locale
2005     && ! $self->custnum
2006     && $conf->exists('cust_main-require_locale');
2007
2008   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2009     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2010     $self->$flag($1);
2011   }
2012
2013   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2014
2015   warn "$me check AFTER: \n". $self->_dump
2016     if $DEBUG > 2;
2017
2018   $self->SUPER::check;
2019 }
2020
2021 =item addr_fields 
2022
2023 Returns a list of fields which have ship_ duplicates.
2024
2025 =cut
2026
2027 sub addr_fields {
2028   qw( last first company
2029       address1 address2 city county state zip country
2030       latitude longitude
2031       daytime night fax mobile
2032     );
2033 }
2034
2035 =item has_ship_address
2036
2037 Returns true if this customer record has a separate shipping address.
2038
2039 =cut
2040
2041 sub has_ship_address {
2042   my $self = shift;
2043   $self->bill_locationnum != $self->ship_locationnum;
2044 }
2045
2046 =item location_hash
2047
2048 Returns a list of key/value pairs, with the following keys: address1, 
2049 adddress2, city, county, state, zip, country, district, and geocode.  The 
2050 shipping address is used if present.
2051
2052 =cut
2053
2054 sub location_hash {
2055   my $self = shift;
2056   $self->ship_location->location_hash;
2057 }
2058
2059 =item cust_location
2060
2061 Returns all locations (see L<FS::cust_location>) for this customer.
2062
2063 =cut
2064
2065 sub cust_location {
2066   my $self = shift;
2067   qsearch('cust_location', { 'custnum' => $self->custnum,
2068                              'prospectnum' => '' } );
2069 }
2070
2071 =item cust_contact
2072
2073 Returns all contacts (see L<FS::contact>) for this customer.
2074
2075 =cut
2076
2077 #already used :/ sub contact {
2078 sub cust_contact {
2079   my $self = shift;
2080   qsearch('contact', { 'custnum' => $self->custnum } );
2081 }
2082
2083 =item unsuspend
2084
2085 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2086 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2087 on success or a list of errors.
2088
2089 =cut
2090
2091 sub unsuspend {
2092   my $self = shift;
2093   grep { $_->unsuspend } $self->suspended_pkgs;
2094 }
2095
2096 =item suspend
2097
2098 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2099
2100 Returns a list: an empty list on success or a list of errors.
2101
2102 =cut
2103
2104 sub suspend {
2105   my $self = shift;
2106   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2107 }
2108
2109 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2110
2111 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2112 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2113 of a list of pkgparts; the hashref has the following keys:
2114
2115 =over 4
2116
2117 =item pkgparts - listref of pkgparts
2118
2119 =item (other options are passed to the suspend method)
2120
2121 =back
2122
2123
2124 Returns a list: an empty list on success or a list of errors.
2125
2126 =cut
2127
2128 sub suspend_if_pkgpart {
2129   my $self = shift;
2130   my (@pkgparts, %opt);
2131   if (ref($_[0]) eq 'HASH'){
2132     @pkgparts = @{$_[0]{pkgparts}};
2133     %opt      = %{$_[0]};
2134   }else{
2135     @pkgparts = @_;
2136   }
2137   grep { $_->suspend(%opt) }
2138     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2139       $self->unsuspended_pkgs;
2140 }
2141
2142 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2143
2144 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2145 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2146 instead of a list of pkgparts; the hashref has the following keys:
2147
2148 =over 4
2149
2150 =item pkgparts - listref of pkgparts
2151
2152 =item (other options are passed to the suspend method)
2153
2154 =back
2155
2156 Returns a list: an empty list on success or a list of errors.
2157
2158 =cut
2159
2160 sub suspend_unless_pkgpart {
2161   my $self = shift;
2162   my (@pkgparts, %opt);
2163   if (ref($_[0]) eq 'HASH'){
2164     @pkgparts = @{$_[0]{pkgparts}};
2165     %opt      = %{$_[0]};
2166   }else{
2167     @pkgparts = @_;
2168   }
2169   grep { $_->suspend(%opt) }
2170     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2171       $self->unsuspended_pkgs;
2172 }
2173
2174 =item cancel [ OPTION => VALUE ... ]
2175
2176 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2177
2178 Available options are:
2179
2180 =over 4
2181
2182 =item quiet - can be set true to supress email cancellation notices.
2183
2184 =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.
2185
2186 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2187
2188 =item nobill - can be set true to skip billing if it might otherwise be done.
2189
2190 =back
2191
2192 Always returns a list: an empty list on success or a list of errors.
2193
2194 =cut
2195
2196 # nb that dates are not specified as valid options to this method
2197
2198 sub cancel {
2199   my( $self, %opt ) = @_;
2200
2201   warn "$me cancel called on customer ". $self->custnum. " with options ".
2202        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2203     if $DEBUG;
2204
2205   return ( 'access denied' )
2206     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2207
2208   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2209
2210     #should try decryption (we might have the private key)
2211     # and if not maybe queue a job for the server that does?
2212     return ( "Can't (yet) ban encrypted credit cards" )
2213       if $self->is_encrypted($self->payinfo);
2214
2215     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2216     my $error = $ban->insert;
2217     return ( $error ) if $error;
2218
2219   }
2220
2221   my @pkgs = $self->ncancelled_pkgs;
2222
2223   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2224     $opt{nobill} = 1;
2225     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2226     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2227       if $error;
2228   }
2229
2230   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2231        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2232     if $DEBUG;
2233
2234   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2235 }
2236
2237 sub _banned_pay_hashref {
2238   my $self = shift;
2239
2240   my %payby2ban = (
2241     'CARD' => 'CARD',
2242     'DCRD' => 'CARD',
2243     'CHEK' => 'CHEK',
2244     'DCHK' => 'CHEK'
2245   );
2246
2247   {
2248     'payby'   => $payby2ban{$self->payby},
2249     'payinfo' => $self->payinfo,
2250     #don't ever *search* on reason! #'reason'  =>
2251   };
2252 }
2253
2254 sub _new_banned_pay_hashref {
2255   my $self = shift;
2256   my $hr = $self->_banned_pay_hashref;
2257   $hr->{payinfo} = md5_base64($hr->{payinfo});
2258   $hr;
2259 }
2260
2261 =item notes
2262
2263 Returns all notes (see L<FS::cust_main_note>) for this customer.
2264
2265 =cut
2266
2267 sub notes {
2268   my($self,$orderby_classnum) = (shift,shift);
2269   my $orderby = "_DATE DESC";
2270   $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2271   qsearch( 'cust_main_note',
2272            { 'custnum' => $self->custnum },
2273            '',
2274            "ORDER BY $orderby",
2275          );
2276 }
2277
2278 =item agent
2279
2280 Returns the agent (see L<FS::agent>) for this customer.
2281
2282 =cut
2283
2284 sub agent {
2285   my $self = shift;
2286   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2287 }
2288
2289 =item agent_name
2290
2291 Returns the agent name (see L<FS::agent>) for this customer.
2292
2293 =cut
2294
2295 sub agent_name {
2296   my $self = shift;
2297   $self->agent->agent;
2298 }
2299
2300 =item cust_tag
2301
2302 Returns any tags associated with this customer, as FS::cust_tag objects,
2303 or an empty list if there are no tags.
2304
2305 =cut
2306
2307 sub cust_tag {
2308   my $self = shift;
2309   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2310 }
2311
2312 =item part_tag
2313
2314 Returns any tags associated with this customer, as FS::part_tag objects,
2315 or an empty list if there are no tags.
2316
2317 =cut
2318
2319 sub part_tag {
2320   my $self = shift;
2321   map $_->part_tag, $self->cust_tag; 
2322 }
2323
2324
2325 =item cust_class
2326
2327 Returns the customer class, as an FS::cust_class object, or the empty string
2328 if there is no customer class.
2329
2330 =cut
2331
2332 sub cust_class {
2333   my $self = shift;
2334   if ( $self->classnum ) {
2335     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2336   } else {
2337     return '';
2338   } 
2339 }
2340
2341 =item categoryname 
2342
2343 Returns the customer category name, or the empty string if there is no customer
2344 category.
2345
2346 =cut
2347
2348 sub categoryname {
2349   my $self = shift;
2350   my $cust_class = $self->cust_class;
2351   $cust_class
2352     ? $cust_class->categoryname
2353     : '';
2354 }
2355
2356 =item classname 
2357
2358 Returns the customer class name, or the empty string if there is no customer
2359 class.
2360
2361 =cut
2362
2363 sub classname {
2364   my $self = shift;
2365   my $cust_class = $self->cust_class;
2366   $cust_class
2367     ? $cust_class->classname
2368     : '';
2369 }
2370
2371 =item BILLING METHODS
2372
2373 Documentation on billing methods has been moved to
2374 L<FS::cust_main::Billing>.
2375
2376 =item REALTIME BILLING METHODS
2377
2378 Documentation on realtime billing methods has been moved to
2379 L<FS::cust_main::Billing_Realtime>.
2380
2381 =item remove_cvv
2382
2383 Removes the I<paycvv> field from the database directly.
2384
2385 If there is an error, returns the error, otherwise returns false.
2386
2387 =cut
2388
2389 sub remove_cvv {
2390   my $self = shift;
2391   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2392     or return dbh->errstr;
2393   $sth->execute($self->custnum)
2394     or return $sth->errstr;
2395   $self->paycvv('');
2396   '';
2397 }
2398
2399 =item batch_card OPTION => VALUE...
2400
2401 Adds a payment for this invoice to the pending credit card batch (see
2402 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2403 runs the payment using a realtime gateway.
2404
2405 Options may include:
2406
2407 B<amount>: the amount to be paid; defaults to the customer's balance minus
2408 any payments in transit.
2409
2410 B<payby>: the payment method; defaults to cust_main.payby
2411
2412 B<realtime>: runs this as a realtime payment instead of adding it to a 
2413 batch.  Deprecated.
2414
2415 B<invnum>: sets cust_pay_batch.invnum.
2416
2417 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets 
2418 the billing address for the payment; defaults to the customer's billing
2419 location.
2420
2421 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2422 date, and name; defaults to those fields in cust_main.
2423
2424 =cut
2425
2426 sub batch_card {
2427   my ($self, %options) = @_;
2428
2429   my $amount;
2430   if (exists($options{amount})) {
2431     $amount = $options{amount};
2432   }else{
2433     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2434   }
2435   return '' unless $amount > 0;
2436   
2437   my $invnum = delete $options{invnum};
2438   my $payby = $options{payby} || $self->payby;  #still dubious
2439
2440   if ($options{'realtime'}) {
2441     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2442                                 $amount,
2443                                 %options,
2444                               );
2445   }
2446
2447   my $oldAutoCommit = $FS::UID::AutoCommit;
2448   local $FS::UID::AutoCommit = 0;
2449   my $dbh = dbh;
2450
2451   #this needs to handle mysql as well as Pg, like svc_acct.pm
2452   #(make it into a common function if folks need to do batching with mysql)
2453   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2454     or return "Cannot lock pay_batch: " . $dbh->errstr;
2455
2456   my %pay_batch = (
2457     'status' => 'O',
2458     'payby'  => FS::payby->payby2payment($payby),
2459   );
2460   $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2461
2462   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2463
2464   unless ( $pay_batch ) {
2465     $pay_batch = new FS::pay_batch \%pay_batch;
2466     my $error = $pay_batch->insert;
2467     if ( $error ) {
2468       $dbh->rollback if $oldAutoCommit;
2469       die "error creating new batch: $error\n";
2470     }
2471   }
2472
2473   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2474       'batchnum' => $pay_batch->batchnum,
2475       'custnum'  => $self->custnum,
2476   } );
2477
2478   foreach (qw( address1 address2 city state zip country latitude longitude
2479                payby payinfo paydate payname ))
2480   {
2481     $options{$_} = '' unless exists($options{$_});
2482   }
2483
2484   my $loc = $self->bill_location;
2485
2486   my $cust_pay_batch = new FS::cust_pay_batch ( {
2487     'batchnum' => $pay_batch->batchnum,
2488     'invnum'   => $invnum || 0,                    # is there a better value?
2489                                                    # this field should be
2490                                                    # removed...
2491                                                    # cust_bill_pay_batch now
2492     'custnum'  => $self->custnum,
2493     'last'     => $self->getfield('last'),
2494     'first'    => $self->getfield('first'),
2495     'address1' => $options{address1} || $loc->address1,
2496     'address2' => $options{address2} || $loc->address2,
2497     'city'     => $options{city}     || $loc->city,
2498     'state'    => $options{state}    || $loc->state,
2499     'zip'      => $options{zip}      || $loc->zip,
2500     'country'  => $options{country}  || $loc->country,
2501     'payby'    => $options{payby}    || $self->payby,
2502     'payinfo'  => $options{payinfo}  || $self->payinfo,
2503     'exp'      => $options{paydate}  || $self->paydate,
2504     'payname'  => $options{payname}  || $self->payname,
2505     'amount'   => $amount,                         # consolidating
2506   } );
2507   
2508   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2509     if $old_cust_pay_batch;
2510
2511   my $error;
2512   if ($old_cust_pay_batch) {
2513     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2514   } else {
2515     $error = $cust_pay_batch->insert;
2516   }
2517
2518   if ( $error ) {
2519     $dbh->rollback if $oldAutoCommit;
2520     die $error;
2521   }
2522
2523   my $unapplied =   $self->total_unapplied_credits
2524                   + $self->total_unapplied_payments
2525                   + $self->in_transit_payments;
2526   foreach my $cust_bill ($self->open_cust_bill) {
2527     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2528     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2529       'invnum' => $cust_bill->invnum,
2530       'paybatchnum' => $cust_pay_batch->paybatchnum,
2531       'amount' => $cust_bill->owed,
2532       '_date' => time,
2533     };
2534     if ($unapplied >= $cust_bill_pay_batch->amount){
2535       $unapplied -= $cust_bill_pay_batch->amount;
2536       next;
2537     }else{
2538       $cust_bill_pay_batch->amount(sprintf ( "%.2f", 
2539                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2540     }
2541     $error = $cust_bill_pay_batch->insert;
2542     if ( $error ) {
2543       $dbh->rollback if $oldAutoCommit;
2544       die $error;
2545     }
2546   }
2547
2548   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2549   '';
2550 }
2551
2552 =item total_owed
2553
2554 Returns the total owed for this customer on all invoices
2555 (see L<FS::cust_bill/owed>).
2556
2557 =cut
2558
2559 sub total_owed {
2560   my $self = shift;
2561   $self->total_owed_date(2145859200); #12/31/2037
2562 }
2563
2564 =item total_owed_date TIME
2565
2566 Returns the total owed for this customer on all invoices with date earlier than
2567 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2568 see L<Time::Local> and L<Date::Parse> for conversion functions.
2569
2570 =cut
2571
2572 sub total_owed_date {
2573   my $self = shift;
2574   my $time = shift;
2575
2576   my $custnum = $self->custnum;
2577
2578   my $owed_sql = FS::cust_bill->owed_sql;
2579
2580   my $sql = "
2581     SELECT SUM($owed_sql) FROM cust_bill
2582       WHERE custnum = $custnum
2583         AND _date <= $time
2584   ";
2585
2586   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2587
2588 }
2589
2590 =item total_owed_pkgnum PKGNUM
2591
2592 Returns the total owed on all invoices for this customer's specific package
2593 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2594
2595 =cut
2596
2597 sub total_owed_pkgnum {
2598   my( $self, $pkgnum ) = @_;
2599   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2600 }
2601
2602 =item total_owed_date_pkgnum TIME PKGNUM
2603
2604 Returns the total owed for this customer's specific package when using
2605 experimental package balances on all invoices with date earlier than
2606 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2607 see L<Time::Local> and L<Date::Parse> for conversion functions.
2608
2609 =cut
2610
2611 sub total_owed_date_pkgnum {
2612   my( $self, $time, $pkgnum ) = @_;
2613
2614   my $total_bill = 0;
2615   foreach my $cust_bill (
2616     grep { $_->_date <= $time }
2617       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2618   ) {
2619     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2620   }
2621   sprintf( "%.2f", $total_bill );
2622
2623 }
2624
2625 =item total_paid
2626
2627 Returns the total amount of all payments.
2628
2629 =cut
2630
2631 sub total_paid {
2632   my $self = shift;
2633   my $total = 0;
2634   $total += $_->paid foreach $self->cust_pay;
2635   sprintf( "%.2f", $total );
2636 }
2637
2638 =item total_unapplied_credits
2639
2640 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2641 customer.  See L<FS::cust_credit/credited>.
2642
2643 =item total_credited
2644
2645 Old name for total_unapplied_credits.  Don't use.
2646
2647 =cut
2648
2649 sub total_credited {
2650   #carp "total_credited deprecated, use total_unapplied_credits";
2651   shift->total_unapplied_credits(@_);
2652 }
2653
2654 sub total_unapplied_credits {
2655   my $self = shift;
2656
2657   my $custnum = $self->custnum;
2658
2659   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2660
2661   my $sql = "
2662     SELECT SUM($unapplied_sql) FROM cust_credit
2663       WHERE custnum = $custnum
2664   ";
2665
2666   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2667
2668 }
2669
2670 =item total_unapplied_credits_pkgnum PKGNUM
2671
2672 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2673 customer.  See L<FS::cust_credit/credited>.
2674
2675 =cut
2676
2677 sub total_unapplied_credits_pkgnum {
2678   my( $self, $pkgnum ) = @_;
2679   my $total_credit = 0;
2680   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2681   sprintf( "%.2f", $total_credit );
2682 }
2683
2684
2685 =item total_unapplied_payments
2686
2687 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2688 See L<FS::cust_pay/unapplied>.
2689
2690 =cut
2691
2692 sub total_unapplied_payments {
2693   my $self = shift;
2694
2695   my $custnum = $self->custnum;
2696
2697   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2698
2699   my $sql = "
2700     SELECT SUM($unapplied_sql) FROM cust_pay
2701       WHERE custnum = $custnum
2702   ";
2703
2704   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2705
2706 }
2707
2708 =item total_unapplied_payments_pkgnum PKGNUM
2709
2710 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2711 specific package when using experimental package balances.  See
2712 L<FS::cust_pay/unapplied>.
2713
2714 =cut
2715
2716 sub total_unapplied_payments_pkgnum {
2717   my( $self, $pkgnum ) = @_;
2718   my $total_unapplied = 0;
2719   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2720   sprintf( "%.2f", $total_unapplied );
2721 }
2722
2723
2724 =item total_unapplied_refunds
2725
2726 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2727 customer.  See L<FS::cust_refund/unapplied>.
2728
2729 =cut
2730
2731 sub total_unapplied_refunds {
2732   my $self = shift;
2733   my $custnum = $self->custnum;
2734
2735   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2736
2737   my $sql = "
2738     SELECT SUM($unapplied_sql) FROM cust_refund
2739       WHERE custnum = $custnum
2740   ";
2741
2742   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2743
2744 }
2745
2746 =item balance
2747
2748 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2749 total_unapplied_credits minus total_unapplied_payments).
2750
2751 =cut
2752
2753 sub balance {
2754   my $self = shift;
2755   $self->balance_date_range;
2756 }
2757
2758 =item balance_date TIME
2759
2760 Returns the balance for this customer, only considering invoices with date
2761 earlier than TIME (total_owed_date minus total_credited minus
2762 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2763 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2764 functions.
2765
2766 =cut
2767
2768 sub balance_date {
2769   my $self = shift;
2770   $self->balance_date_range(shift);
2771 }
2772
2773 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2774
2775 Returns the balance for this customer, optionally considering invoices with
2776 date earlier than START_TIME, and not later than END_TIME
2777 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2778
2779 Times are specified as SQL fragments or numeric
2780 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2781 L<Date::Parse> for conversion functions.  The empty string can be passed
2782 to disable that time constraint completely.
2783
2784 Available options are:
2785
2786 =over 4
2787
2788 =item unapplied_date
2789
2790 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
2791
2792 =back
2793
2794 =cut
2795
2796 sub balance_date_range {
2797   my $self = shift;
2798   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2799             ') FROM cust_main WHERE custnum='. $self->custnum;
2800   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2801 }
2802
2803 =item balance_pkgnum PKGNUM
2804
2805 Returns the balance for this customer's specific package when using
2806 experimental package balances (total_owed plus total_unrefunded, minus
2807 total_unapplied_credits minus total_unapplied_payments)
2808
2809 =cut
2810
2811 sub balance_pkgnum {
2812   my( $self, $pkgnum ) = @_;
2813
2814   sprintf( "%.2f",
2815       $self->total_owed_pkgnum($pkgnum)
2816 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2817 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2818     - $self->total_unapplied_credits_pkgnum($pkgnum)
2819     - $self->total_unapplied_payments_pkgnum($pkgnum)
2820   );
2821 }
2822
2823 =item in_transit_payments
2824
2825 Returns the total of requests for payments for this customer pending in 
2826 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2827
2828 =cut
2829
2830 sub in_transit_payments {
2831   my $self = shift;
2832   my $in_transit_payments = 0;
2833   foreach my $pay_batch ( qsearch('pay_batch', {
2834     'status' => 'I',
2835   } ) ) {
2836     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2837       'batchnum' => $pay_batch->batchnum,
2838       'custnum' => $self->custnum,
2839     } ) ) {
2840       $in_transit_payments += $cust_pay_batch->amount;
2841     }
2842   }
2843   sprintf( "%.2f", $in_transit_payments );
2844 }
2845
2846 =item payment_info
2847
2848 Returns a hash of useful information for making a payment.
2849
2850 =over 4
2851
2852 =item balance
2853
2854 Current balance.
2855
2856 =item payby
2857
2858 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2859 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2860 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2861
2862 =back
2863
2864 For credit card transactions:
2865
2866 =over 4
2867
2868 =item card_type 1
2869
2870 =item payname
2871
2872 Exact name on card
2873
2874 =back
2875
2876 For electronic check transactions:
2877
2878 =over 4
2879
2880 =item stateid_state
2881
2882 =back
2883
2884 =cut
2885
2886 sub payment_info {
2887   my $self = shift;
2888
2889   my %return = ();
2890
2891   $return{balance} = $self->balance;
2892
2893   $return{payname} = $self->payname
2894                      || ( $self->first. ' '. $self->get('last') );
2895
2896   $return{$_} = $self->bill_location->$_
2897     for qw(address1 address2 city state zip);
2898
2899   $return{payby} = $self->payby;
2900   $return{stateid_state} = $self->stateid_state;
2901
2902   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2903     $return{card_type} = cardtype($self->payinfo);
2904     $return{payinfo} = $self->paymask;
2905
2906     @return{'month', 'year'} = $self->paydate_monthyear;
2907
2908   }
2909
2910   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2911     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2912     $return{payinfo1} = $payinfo1;
2913     $return{payinfo2} = $payinfo2;
2914     $return{paytype}  = $self->paytype;
2915     $return{paystate} = $self->paystate;
2916
2917   }
2918
2919   #doubleclick protection
2920   my $_date = time;
2921   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2922
2923   %return;
2924
2925 }
2926
2927 =item paydate_monthyear
2928
2929 Returns a two-element list consisting of the month and year of this customer's
2930 paydate (credit card expiration date for CARD customers)
2931
2932 =cut
2933
2934 sub paydate_monthyear {
2935   my $self = shift;
2936   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2937     ( $2, $1 );
2938   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2939     ( $1, $3 );
2940   } else {
2941     ('', '');
2942   }
2943 }
2944
2945 =item paydate_epoch
2946
2947 Returns the exact time in seconds corresponding to the payment method 
2948 expiration date.  For CARD/DCRD customers this is the end of the month;
2949 for others (COMP is the only other payby that uses paydate) it's the start.
2950 Returns 0 if the paydate is empty or set to the far future.
2951
2952 =cut
2953
2954 sub paydate_epoch {
2955   my $self = shift;
2956   my ($month, $year) = $self->paydate_monthyear;
2957   return 0 if !$year or $year >= 2037;
2958   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2959     $month++;
2960     if ( $month == 13 ) {
2961       $month = 1;
2962       $year++;
2963     }
2964     return timelocal(0,0,0,1,$month-1,$year) - 1;
2965   }
2966   else {
2967     return timelocal(0,0,0,1,$month-1,$year);
2968   }
2969 }
2970
2971 =item paydate_epoch_sql
2972
2973 Class method.  Returns an SQL expression to obtain the payment expiration date
2974 as a number of seconds.
2975
2976 =cut
2977
2978 # Special expiration date behavior for non-CARD/DCRD customers has been 
2979 # carefully preserved.  Do we really use that?
2980 sub paydate_epoch_sql {
2981   my $class = shift;
2982   my $table = shift || 'cust_main';
2983   my ($case1, $case2);
2984   if ( driver_name eq 'Pg' ) {
2985     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2986     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2987   }
2988   elsif ( lc(driver_name) eq 'mysql' ) {
2989     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2990     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2991   }
2992   else { return '' }
2993   return "CASE WHEN $table.payby IN('CARD','DCRD') 
2994   THEN ($case1)
2995   ELSE ($case2)
2996   END"
2997 }
2998
2999 =item tax_exemption TAXNAME
3000
3001 =cut
3002
3003 sub tax_exemption {
3004   my( $self, $taxname ) = @_;
3005
3006   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3007                                      'taxname' => $taxname,
3008                                    },
3009           );
3010 }
3011
3012 =item cust_main_exemption
3013
3014 =cut
3015
3016 sub cust_main_exemption {
3017   my $self = shift;
3018   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3019 }
3020
3021 =item invoicing_list [ ARRAYREF ]
3022
3023 If an arguement is given, sets these email addresses as invoice recipients
3024 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3025 (except as warnings), so use check_invoicing_list first.
3026
3027 Returns a list of email addresses (with svcnum entries expanded).
3028
3029 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3030 check it without disturbing anything by passing nothing.
3031
3032 This interface may change in the future.
3033
3034 =cut
3035
3036 sub invoicing_list {
3037   my( $self, $arrayref ) = @_;
3038
3039   if ( $arrayref ) {
3040     my @cust_main_invoice;
3041     if ( $self->custnum ) {
3042       @cust_main_invoice = 
3043         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3044     } else {
3045       @cust_main_invoice = ();
3046     }
3047     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3048       #warn $cust_main_invoice->destnum;
3049       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3050         #warn $cust_main_invoice->destnum;
3051         my $error = $cust_main_invoice->delete;
3052         warn $error if $error;
3053       }
3054     }
3055     if ( $self->custnum ) {
3056       @cust_main_invoice = 
3057         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3058     } else {
3059       @cust_main_invoice = ();
3060     }
3061     my %seen = map { $_->address => 1 } @cust_main_invoice;
3062     foreach my $address ( @{$arrayref} ) {
3063       next if exists $seen{$address} && $seen{$address};
3064       $seen{$address} = 1;
3065       my $cust_main_invoice = new FS::cust_main_invoice ( {
3066         'custnum' => $self->custnum,
3067         'dest'    => $address,
3068       } );
3069       my $error = $cust_main_invoice->insert;
3070       warn $error if $error;
3071     }
3072   }
3073   
3074   if ( $self->custnum ) {
3075     map { $_->address }
3076       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3077   } else {
3078     ();
3079   }
3080
3081 }
3082
3083 =item check_invoicing_list ARRAYREF
3084
3085 Checks these arguements as valid input for the invoicing_list method.  If there
3086 is an error, returns the error, otherwise returns false.
3087
3088 =cut
3089
3090 sub check_invoicing_list {
3091   my( $self, $arrayref ) = @_;
3092
3093   foreach my $address ( @$arrayref ) {
3094
3095     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3096       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3097     }
3098
3099     my $cust_main_invoice = new FS::cust_main_invoice ( {
3100       'custnum' => $self->custnum,
3101       'dest'    => $address,
3102     } );
3103     my $error = $self->custnum
3104                 ? $cust_main_invoice->check
3105                 : $cust_main_invoice->checkdest
3106     ;
3107     return $error if $error;
3108
3109   }
3110
3111   return "Email address required"
3112     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3113     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3114
3115   '';
3116 }
3117
3118 =item set_default_invoicing_list
3119
3120 Sets the invoicing list to all accounts associated with this customer,
3121 overwriting any previous invoicing list.
3122
3123 =cut
3124
3125 sub set_default_invoicing_list {
3126   my $self = shift;
3127   $self->invoicing_list($self->all_emails);
3128 }
3129
3130 =item all_emails
3131
3132 Returns the email addresses of all accounts provisioned for this customer.
3133
3134 =cut
3135
3136 sub all_emails {
3137   my $self = shift;
3138   my %list;
3139   foreach my $cust_pkg ( $self->all_pkgs ) {
3140     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3141     my @svc_acct =
3142       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3143         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3144           @cust_svc;
3145     $list{$_}=1 foreach map { $_->email } @svc_acct;
3146   }
3147   keys %list;
3148 }
3149
3150 =item invoicing_list_addpost
3151
3152 Adds postal invoicing to this customer.  If this customer is already configured
3153 to receive postal invoices, does nothing.
3154
3155 =cut
3156
3157 sub invoicing_list_addpost {
3158   my $self = shift;
3159   return if grep { $_ eq 'POST' } $self->invoicing_list;
3160   my @invoicing_list = $self->invoicing_list;
3161   push @invoicing_list, 'POST';
3162   $self->invoicing_list(\@invoicing_list);
3163 }
3164
3165 =item invoicing_list_emailonly
3166
3167 Returns the list of email invoice recipients (invoicing_list without non-email
3168 destinations such as POST and FAX).
3169
3170 =cut
3171
3172 sub invoicing_list_emailonly {
3173   my $self = shift;
3174   warn "$me invoicing_list_emailonly called"
3175     if $DEBUG;
3176   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3177 }
3178
3179 =item invoicing_list_emailonly_scalar
3180
3181 Returns the list of email invoice recipients (invoicing_list without non-email
3182 destinations such as POST and FAX) as a comma-separated scalar.
3183
3184 =cut
3185
3186 sub invoicing_list_emailonly_scalar {
3187   my $self = shift;
3188   warn "$me invoicing_list_emailonly_scalar called"
3189     if $DEBUG;
3190   join(', ', $self->invoicing_list_emailonly);
3191 }
3192
3193 =item referral_custnum_cust_main
3194
3195 Returns the customer who referred this customer (or the empty string, if
3196 this customer was not referred).
3197
3198 Note the difference with referral_cust_main method: This method,
3199 referral_custnum_cust_main returns the single customer (if any) who referred
3200 this customer, while referral_cust_main returns an array of customers referred
3201 BY this customer.
3202
3203 =cut
3204
3205 sub referral_custnum_cust_main {
3206   my $self = shift;
3207   return '' unless $self->referral_custnum;
3208   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3209 }
3210
3211 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3212
3213 Returns an array of customers referred by this customer (referral_custnum set
3214 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3215 customers referred by customers referred by this customer and so on, inclusive.
3216 The default behavior is DEPTH 1 (no recursion).
3217
3218 Note the difference with referral_custnum_cust_main method: This method,
3219 referral_cust_main, returns an array of customers referred BY this customer,
3220 while referral_custnum_cust_main returns the single customer (if any) who
3221 referred this customer.
3222
3223 =cut
3224
3225 sub referral_cust_main {
3226   my $self = shift;
3227   my $depth = @_ ? shift : 1;
3228   my $exclude = @_ ? shift : {};
3229
3230   my @cust_main =
3231     map { $exclude->{$_->custnum}++; $_; }
3232       grep { ! $exclude->{ $_->custnum } }
3233         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3234
3235   if ( $depth > 1 ) {
3236     push @cust_main,
3237       map { $_->referral_cust_main($depth-1, $exclude) }
3238         @cust_main;
3239   }
3240
3241   @cust_main;
3242 }
3243
3244 =item referral_cust_main_ncancelled
3245
3246 Same as referral_cust_main, except only returns customers with uncancelled
3247 packages.
3248
3249 =cut
3250
3251 sub referral_cust_main_ncancelled {
3252   my $self = shift;
3253   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3254 }
3255
3256 =item referral_cust_pkg [ DEPTH ]
3257
3258 Like referral_cust_main, except returns a flat list of all unsuspended (and
3259 uncancelled) packages for each customer.  The number of items in this list may
3260 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3261
3262 =cut
3263
3264 sub referral_cust_pkg {
3265   my $self = shift;
3266   my $depth = @_ ? shift : 1;
3267
3268   map { $_->unsuspended_pkgs }
3269     grep { $_->unsuspended_pkgs }
3270       $self->referral_cust_main($depth);
3271 }
3272
3273 =item referring_cust_main
3274
3275 Returns the single cust_main record for the customer who referred this customer
3276 (referral_custnum), or false.
3277
3278 =cut
3279
3280 sub referring_cust_main {
3281   my $self = shift;
3282   return '' unless $self->referral_custnum;
3283   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3284 }
3285
3286 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3287
3288 Applies a credit to this customer.  If there is an error, returns the error,
3289 otherwise returns false.
3290
3291 REASON can be a text string, an FS::reason object, or a scalar reference to
3292 a reasonnum.  If a text string, it will be automatically inserted as a new
3293 reason, and a 'reason_type' option must be passed to indicate the
3294 FS::reason_type for the new reason.
3295
3296 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3297
3298 Any other options are passed to FS::cust_credit::insert.
3299
3300 =cut
3301
3302 sub credit {
3303   my( $self, $amount, $reason, %options ) = @_;
3304
3305   my $cust_credit = new FS::cust_credit {
3306     'custnum' => $self->custnum,
3307     'amount'  => $amount,
3308   };
3309
3310   if ( ref($reason) ) {
3311
3312     if ( ref($reason) eq 'SCALAR' ) {
3313       $cust_credit->reasonnum( $$reason );
3314     } else {
3315       $cust_credit->reasonnum( $reason->reasonnum );
3316     }
3317
3318   } else {
3319     $cust_credit->set('reason', $reason)
3320   }
3321
3322   for (qw( addlinfo eventnum )) {
3323     $cust_credit->$_( delete $options{$_} )
3324       if exists($options{$_});
3325   }
3326
3327   $cust_credit->insert(%options);
3328
3329 }
3330
3331 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3332
3333 Creates a one-time charge for this customer.  If there is an error, returns
3334 the error, otherwise returns false.
3335
3336 New-style, with a hashref of options:
3337
3338   my $error = $cust_main->charge(
3339                                   {
3340                                     'amount'     => 54.32,
3341                                     'quantity'   => 1,
3342                                     'start_date' => str2time('7/4/2009'),
3343                                     'pkg'        => 'Description',
3344                                     'comment'    => 'Comment',
3345                                     'additional' => [], #extra invoice detail
3346                                     'classnum'   => 1,  #pkg_class
3347
3348                                     'setuptax'   => '', # or 'Y' for tax exempt
3349
3350                                     'locationnum'=> 1234, # optional
3351
3352                                     #internal taxation
3353                                     'taxclass'   => 'Tax class',
3354
3355                                     #vendor taxation
3356                                     'taxproduct' => 2,  #part_pkg_taxproduct
3357                                     'override'   => {}, #XXX describe
3358
3359                                     #will be filled in with the new object
3360                                     'cust_pkg_ref' => \$cust_pkg,
3361
3362                                     #generate an invoice immediately
3363                                     'bill_now' => 0,
3364                                     'invoice_terms' => '', #with these terms
3365                                   }
3366                                 );
3367
3368 Old-style:
3369
3370   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3371
3372 =cut
3373
3374 sub charge {
3375   my $self = shift;
3376   my ( $amount, $quantity, $start_date, $classnum );
3377   my ( $pkg, $comment, $additional );
3378   my ( $setuptax, $taxclass );   #internal taxes
3379   my ( $taxproduct, $override ); #vendor (CCH) taxes
3380   my $no_auto = '';
3381   my $cust_pkg_ref = '';
3382   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3383   my $locationnum;
3384   if ( ref( $_[0] ) ) {
3385     $amount     = $_[0]->{amount};
3386     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3387     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3388     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3389     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3390     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3391                                            : '$'. sprintf("%.2f",$amount);
3392     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3393     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3394     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3395     $additional = $_[0]->{additional} || [];
3396     $taxproduct = $_[0]->{taxproductnum};
3397     $override   = { '' => $_[0]->{tax_override} };
3398     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3399     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3400     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3401     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3402   } else {
3403     $amount     = shift;
3404     $quantity   = 1;
3405     $start_date = '';
3406     $pkg        = @_ ? shift : 'One-time charge';
3407     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3408     $setuptax   = '';
3409     $taxclass   = @_ ? shift : '';
3410     $additional = [];
3411   }
3412
3413   local $SIG{HUP} = 'IGNORE';
3414   local $SIG{INT} = 'IGNORE';
3415   local $SIG{QUIT} = 'IGNORE';
3416   local $SIG{TERM} = 'IGNORE';
3417   local $SIG{TSTP} = 'IGNORE';
3418   local $SIG{PIPE} = 'IGNORE';
3419
3420   my $oldAutoCommit = $FS::UID::AutoCommit;
3421   local $FS::UID::AutoCommit = 0;
3422   my $dbh = dbh;
3423
3424   my $part_pkg = new FS::part_pkg ( {
3425     'pkg'           => $pkg,
3426     'comment'       => $comment,
3427     'plan'          => 'flat',
3428     'freq'          => 0,
3429     'disabled'      => 'Y',
3430     'classnum'      => ( $classnum ? $classnum : '' ),
3431     'setuptax'      => $setuptax,
3432     'taxclass'      => $taxclass,
3433     'taxproductnum' => $taxproduct,
3434   } );
3435
3436   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3437                         ( 0 .. @$additional - 1 )
3438                   ),
3439                   'additional_count' => scalar(@$additional),
3440                   'setup_fee' => $amount,
3441                 );
3442
3443   my $error = $part_pkg->insert( options       => \%options,
3444                                  tax_overrides => $override,
3445                                );
3446   if ( $error ) {
3447     $dbh->rollback if $oldAutoCommit;
3448     return $error;
3449   }
3450
3451   my $pkgpart = $part_pkg->pkgpart;
3452   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3453   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3454     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3455     $error = $type_pkgs->insert;
3456     if ( $error ) {
3457       $dbh->rollback if $oldAutoCommit;
3458       return $error;
3459     }
3460   }
3461
3462   my $cust_pkg = new FS::cust_pkg ( {
3463     'custnum'    => $self->custnum,
3464     'pkgpart'    => $pkgpart,
3465     'quantity'   => $quantity,
3466     'start_date' => $start_date,
3467     'no_auto'    => $no_auto,
3468     'locationnum'=> $locationnum,
3469   } );
3470
3471   $error = $cust_pkg->insert;
3472   if ( $error ) {
3473     $dbh->rollback if $oldAutoCommit;
3474     return $error;
3475   } elsif ( $cust_pkg_ref ) {
3476     ${$cust_pkg_ref} = $cust_pkg;
3477   }
3478
3479   if ( $bill_now ) {
3480     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3481                              'pkg_list'      => [ $cust_pkg ],
3482                            );
3483     if ( $error ) {
3484       $dbh->rollback if $oldAutoCommit;
3485       return $error;
3486     }   
3487   }
3488
3489   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3490   return '';
3491
3492 }
3493
3494 #=item charge_postal_fee
3495 #
3496 #Applies a one time charge this customer.  If there is an error,
3497 #returns the error, returns the cust_pkg charge object or false
3498 #if there was no charge.
3499 #
3500 #=cut
3501 #
3502 # This should be a customer event.  For that to work requires that bill
3503 # also be a customer event.
3504
3505 sub charge_postal_fee {
3506   my $self = shift;
3507
3508   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3509   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3510
3511   my $cust_pkg = new FS::cust_pkg ( {
3512     'custnum'  => $self->custnum,
3513     'pkgpart'  => $pkgpart,
3514     'quantity' => 1,
3515   } );
3516
3517   my $error = $cust_pkg->insert;
3518   $error ? $error : $cust_pkg;
3519 }
3520
3521 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3522
3523 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3524
3525 Optionally, a list or hashref of additional arguments to the qsearch call can
3526 be passed.
3527
3528 =cut
3529
3530 sub cust_bill {
3531   my $self = shift;
3532   my $opt = ref($_[0]) ? shift : { @_ };
3533
3534   #return $self->num_cust_bill unless wantarray || keys %$opt;
3535
3536   $opt->{'table'} = 'cust_bill';
3537   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3538   $opt->{'hashref'}{'custnum'} = $self->custnum;
3539   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3540
3541   map { $_ } #behavior of sort undefined in scalar context
3542     sort { $a->_date <=> $b->_date }
3543       qsearch($opt);
3544 }
3545
3546 =item open_cust_bill
3547
3548 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3549 customer.
3550
3551 =cut
3552
3553 sub open_cust_bill {
3554   my $self = shift;
3555
3556   $self->cust_bill(
3557     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3558     #@_
3559   );
3560
3561 }
3562
3563 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3564
3565 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3566
3567 =cut
3568
3569 sub legacy_cust_bill {
3570   my $self = shift;
3571
3572   #return $self->num_legacy_cust_bill unless wantarray;
3573
3574   map { $_ } #behavior of sort undefined in scalar context
3575     sort { $a->_date <=> $b->_date }
3576       qsearch({ 'table'    => 'legacy_cust_bill',
3577                 'hashref'  => { 'custnum' => $self->custnum, },
3578                 'order_by' => 'ORDER BY _date ASC',
3579              });
3580 }
3581
3582 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3583
3584 Returns all the statements (see L<FS::cust_statement>) for this customer.
3585
3586 Optionally, a list or hashref of additional arguments to the qsearch call can
3587 be passed.
3588
3589 =cut
3590
3591 =item cust_bill_void
3592
3593 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3594
3595 =cut
3596
3597 sub cust_bill_void {
3598   my $self = shift;
3599
3600   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3601   sort { $a->_date <=> $b->_date }
3602     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3603 }
3604
3605 sub cust_statement {
3606   my $self = shift;
3607   my $opt = ref($_[0]) ? shift : { @_ };
3608
3609   #return $self->num_cust_statement unless wantarray || keys %$opt;
3610
3611   $opt->{'table'} = 'cust_statement';
3612   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3613   $opt->{'hashref'}{'custnum'} = $self->custnum;
3614   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3615
3616   map { $_ } #behavior of sort undefined in scalar context
3617     sort { $a->_date <=> $b->_date }
3618       qsearch($opt);
3619 }
3620
3621 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3622
3623 Returns all services of type SVCDB (such as 'svc_acct') for this customer.  
3624
3625 Optionally, a list or hashref of additional arguments to the qsearch call can 
3626 be passed following the SVCDB.
3627
3628 =cut
3629
3630 sub svc_x {
3631   my $self = shift;
3632   my $svcdb = shift;
3633   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3634     warn "$me svc_x requires a svcdb";
3635     return;
3636   }
3637   my $opt = ref($_[0]) ? shift : { @_ };
3638
3639   $opt->{'table'} = $svcdb;
3640   $opt->{'addl_from'} = 
3641     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3642     ($opt->{'addl_from'} || '');
3643
3644   my $custnum = $self->custnum;
3645   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3646   my $where = "cust_pkg.custnum = $custnum";
3647
3648   my $extra_sql = $opt->{'extra_sql'} || '';
3649   if ( keys %{ $opt->{'hashref'} } ) {
3650     $extra_sql = " AND $where $extra_sql";
3651   }
3652   else {
3653     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3654       $extra_sql = "WHERE $where AND $1";
3655     }
3656     else {
3657       $extra_sql = "WHERE $where $extra_sql";
3658     }
3659   }
3660   $opt->{'extra_sql'} = $extra_sql;
3661
3662   qsearch($opt);
3663 }
3664
3665 # required for use as an eventtable; 
3666 sub svc_acct {
3667   my $self = shift;
3668   $self->svc_x('svc_acct', @_);
3669 }
3670
3671 =item cust_credit
3672
3673 Returns all the credits (see L<FS::cust_credit>) for this customer.
3674
3675 =cut
3676
3677 sub cust_credit {
3678   my $self = shift;
3679   map { $_ } #return $self->num_cust_credit unless wantarray;
3680   sort { $a->_date <=> $b->_date }
3681     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3682 }
3683
3684 =item cust_credit_pkgnum
3685
3686 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3687 package when using experimental package balances.
3688
3689 =cut
3690
3691 sub cust_credit_pkgnum {
3692   my( $self, $pkgnum ) = @_;
3693   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3694   sort { $a->_date <=> $b->_date }
3695     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3696                               'pkgnum'  => $pkgnum,
3697                             }
3698     );
3699 }
3700
3701 =item cust_pay
3702
3703 Returns all the payments (see L<FS::cust_pay>) for this customer.
3704
3705 =cut
3706
3707 sub cust_pay {
3708   my $self = shift;
3709   return $self->num_cust_pay unless wantarray;
3710   sort { $a->_date <=> $b->_date }
3711     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3712 }
3713
3714 =item num_cust_pay
3715
3716 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3717 called automatically when the cust_pay method is used in a scalar context.
3718
3719 =cut
3720
3721 sub num_cust_pay {
3722   my $self = shift;
3723   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3724   my $sth = dbh->prepare($sql) or die dbh->errstr;
3725   $sth->execute($self->custnum) or die $sth->errstr;
3726   $sth->fetchrow_arrayref->[0];
3727 }
3728
3729 =item cust_pay_pkgnum
3730
3731 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3732 package when using experimental package balances.
3733
3734 =cut
3735
3736 sub cust_pay_pkgnum {
3737   my( $self, $pkgnum ) = @_;
3738   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3739   sort { $a->_date <=> $b->_date }
3740     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3741                            'pkgnum'  => $pkgnum,
3742                          }
3743     );
3744 }
3745
3746 =item cust_pay_void
3747
3748 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3749
3750 =cut
3751
3752 sub cust_pay_void {
3753   my $self = shift;
3754   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3755   sort { $a->_date <=> $b->_date }
3756     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3757 }
3758
3759 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3760
3761 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3762
3763 Optionally, a list or hashref of additional arguments to the qsearch call can
3764 be passed.
3765
3766 =cut
3767
3768 sub cust_pay_batch {
3769   my $self = shift;
3770   my $opt = ref($_[0]) ? shift : { @_ };
3771
3772   #return $self->num_cust_statement unless wantarray || keys %$opt;
3773
3774   $opt->{'table'} = 'cust_pay_batch';
3775   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3776   $opt->{'hashref'}{'custnum'} = $self->custnum;
3777   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3778
3779   map { $_ } #behavior of sort undefined in scalar context
3780     sort { $a->paybatchnum <=> $b->paybatchnum }
3781       qsearch($opt);
3782 }
3783
3784 =item cust_pay_pending
3785
3786 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3787 (without status "done").
3788
3789 =cut
3790
3791 sub cust_pay_pending {
3792   my $self = shift;
3793   return $self->num_cust_pay_pending unless wantarray;
3794   sort { $a->_date <=> $b->_date }
3795     qsearch( 'cust_pay_pending', {
3796                                    'custnum' => $self->custnum,
3797                                    'status'  => { op=>'!=', value=>'done' },
3798                                  },
3799            );
3800 }
3801
3802 =item cust_pay_pending_attempt
3803
3804 Returns all payment attempts / declined payments for this customer, as pending
3805 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3806 a corresponding payment (see L<FS::cust_pay>).
3807
3808 =cut
3809
3810 sub cust_pay_pending_attempt {
3811   my $self = shift;
3812   return $self->num_cust_pay_pending_attempt unless wantarray;
3813   sort { $a->_date <=> $b->_date }
3814     qsearch( 'cust_pay_pending', {
3815                                    'custnum' => $self->custnum,
3816                                    'status'  => 'done',
3817                                    'paynum'  => '',
3818                                  },
3819            );
3820 }
3821
3822 =item num_cust_pay_pending
3823
3824 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3825 customer (without status "done").  Also called automatically when the
3826 cust_pay_pending method is used in a scalar context.
3827
3828 =cut
3829
3830 sub num_cust_pay_pending {
3831   my $self = shift;
3832   $self->scalar_sql(
3833     " SELECT COUNT(*) FROM cust_pay_pending ".
3834       " WHERE custnum = ? AND status != 'done' ",
3835     $self->custnum
3836   );
3837 }
3838
3839 =item num_cust_pay_pending_attempt
3840
3841 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3842 customer, with status "done" but without a corresp.  Also called automatically when the
3843 cust_pay_pending method is used in a scalar context.
3844
3845 =cut
3846
3847 sub num_cust_pay_pending_attempt {
3848   my $self = shift;