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