2e8fe8159516f2cd8264c0d514ab4339c7068959
[freeside.git] / FS / FS / cust_main.pm
1 package FS::cust_main;
2 use base qw( FS::cust_main::Packages
3              FS::cust_main::Status
4              FS::cust_main::NationalID
5              FS::cust_main::Billing
6              FS::cust_main::Billing_Realtime
7              FS::cust_main::Billing_Batch
8              FS::cust_main::Billing_Discount
9              FS::cust_main::Billing_ThirdParty
10              FS::cust_main::Location
11              FS::cust_main::Credit_Limit
12              FS::cust_main::Merge
13              FS::cust_main::API
14              FS::otaker_Mixin FS::cust_main_Mixin
15              FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
16              FS::o2m_Common
17              FS::Record
18            );
19
20 require 5.006;
21 use strict;
22 use Carp;
23 use Try::Tiny;
24 use Scalar::Util qw( blessed );
25 use List::Util qw(min);
26 use Tie::IxHash;
27 use File::Temp; #qw( tempfile );
28 use Data::Dumper;
29 use Time::Local qw(timelocal);
30 use Date::Format;
31 #use Date::Manip;
32 use Email::Address;
33 use Business::CreditCard 0.28;
34 use FS::UID qw( dbh driver_name );
35 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
36 use FS::Cursor;
37 use FS::Misc qw( generate_ps do_print money_pretty card_types );
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::tax_status;
58 use FS::cust_main_exemption;
59 use FS::cust_tax_adjustment;
60 use FS::cust_tax_location;
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::cust_contact;
76 use FS::Locales;
77 use FS::upgrade_journal;
78 use FS::sales;
79 use FS::cust_payby;
80 use FS::contact;
81 use FS::reason;
82 use FS::Misc::Savepoint;
83
84 # 1 is mostly method/subroutine entry and options
85 # 2 traces progress of some operations
86 # 3 is even more information including possibly sensitive data
87 our $DEBUG = 0;
88 our $me = '[FS::cust_main]';
89
90 our $import = 0;
91 our $ignore_expired_card = 0;
92 our $ignore_banned_card = 0;
93 our $ignore_invalid_card = 0;
94
95 our $skip_fuzzyfiles = 0;
96
97 our $ucfirst_nowarn = 0;
98
99 #this info is in cust_payby as of 4.x
100 #this and the fields themselves can be removed in 5.x
101 our @encrypted_fields = ('payinfo', 'paycvv');
102 sub nohistory_fields { ('payinfo', 'paycvv'); }
103
104 our $conf;
105 our $default_agent_custid;
106 our $custnum_display_length;
107 #ask FS::UID to run this stuff for us later
108 #$FS::UID::callback{'FS::cust_main'} = sub { 
109 install_callback FS::UID sub { 
110   $conf = new FS::Conf;
111   $ignore_invalid_card    = $conf->exists('allow_invalid_cards');
112   $default_agent_custid   = $conf->exists('cust_main-default_agent_custid');
113   $custnum_display_length = $conf->config('cust_main-custnum-display_length');
114 };
115
116 sub _cache {
117   my $self = shift;
118   my ( $hashref, $cache ) = @_;
119   if ( exists $hashref->{'pkgnum'} ) {
120     #@{ $self->{'_pkgnum'} } = ();
121     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
122     $self->{'_pkgnum'} = $subcache;
123     #push @{ $self->{'_pkgnum'} },
124     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
125   }
126 }
127
128 =head1 NAME
129
130 FS::cust_main - Object methods for cust_main records
131
132 =head1 SYNOPSIS
133
134   use FS::cust_main;
135
136   $record = new FS::cust_main \%hash;
137   $record = new FS::cust_main { 'column' => 'value' };
138
139   $error = $record->insert;
140
141   $error = $new_record->replace($old_record);
142
143   $error = $record->delete;
144
145   $error = $record->check;
146
147   @cust_pkg = $record->all_pkgs;
148
149   @cust_pkg = $record->ncancelled_pkgs;
150
151   @cust_pkg = $record->suspended_pkgs;
152
153   $error = $record->bill;
154   $error = $record->bill %options;
155   $error = $record->bill 'time' => $time;
156
157   $error = $record->collect;
158   $error = $record->collect %options;
159   $error = $record->collect 'invoice_time'   => $time,
160                           ;
161
162 =head1 DESCRIPTION
163
164 An FS::cust_main object represents a customer.  FS::cust_main inherits from 
165 FS::Record.  The following fields are currently supported:
166
167 =over 4
168
169 =item custnum
170
171 Primary key (assigned automatically for new customers)
172
173 =item agentnum
174
175 Agent (see L<FS::agent>)
176
177 =item refnum
178
179 Advertising source (see L<FS::part_referral>)
180
181 =item first
182
183 First name
184
185 =item last
186
187 Last name
188
189 =item ss
190
191 Cocial security number (optional)
192
193 =item company
194
195 (optional)
196
197 =item daytime
198
199 phone (optional)
200
201 =item night
202
203 phone (optional)
204
205 =item fax
206
207 phone (optional)
208
209 =item mobile
210
211 phone (optional)
212
213 =item payby
214
215 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
216
217 =item payinfo
218
219 Payment Information (See L<FS::payinfo_Mixin> for data format)
220
221 =item paymask
222
223 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
224
225 =item paycvv
226
227 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
228
229 =item paydate
230
231 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
232
233 =item paystart_month
234
235 Start date month (maestro/solo cards only)
236
237 =item paystart_year
238
239 Start date year (maestro/solo cards only)
240
241 =item payissue
242
243 Issue number (maestro/solo cards only)
244
245 =item payname
246
247 Name on card or billing name
248
249 =item payip
250
251 IP address from which payment information was received
252
253 =item tax
254
255 Tax exempt, empty or `Y'
256
257 =item usernum
258
259 Order taker (see L<FS::access_user>)
260
261 =item comments
262
263 Comments (optional)
264
265 =item referral_custnum
266
267 Referring customer number
268
269 =item spool_cdr
270
271 Enable individual CDR spooling, empty or `Y'
272
273 =item dundate
274
275 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
276
277 =item squelch_cdr
278
279 Discourage individual CDR printing, empty or `Y'
280
281 =item edit_subject
282
283 Allow self-service editing of ticket subjects, empty or 'Y'
284
285 =item calling_list_exempt
286
287 Do not call, empty or 'Y'
288
289 =item invoice_ship_address
290
291 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
292
293 =back
294
295 =head1 METHODS
296
297 =over 4
298
299 =item new HASHREF
300
301 Creates a new customer.  To add the customer to the database, see L<"insert">.
302
303 Note that this stores the hash reference, not a distinct copy of the hash it
304 points to.  You can ask the object for a copy with the I<hash> method.
305
306 =cut
307
308 sub table { 'cust_main'; }
309
310 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
311
312 Adds this customer to the database.  If there is an error, returns the error,
313 otherwise returns false.
314
315 Usually the customer's location will not yet exist in the database, and
316 the C<bill_location> and C<ship_location> pseudo-fields must be set to 
317 uninserted L<FS::cust_location> objects.  These will be inserted and linked
318 (in both directions) to the new customer record.  If they're references 
319 to the same object, they will become the same location.
320
321 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
322 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
323 are inserted atomicly, or the transaction is rolled back.  Passing an empty
324 hash reference is equivalent to not supplying this parameter.  There should be
325 a better explanation of this, but until then, here's an example:
326
327   use Tie::RefHash;
328   tie %hash, 'Tie::RefHash'; #this part is important
329   %hash = (
330     $cust_pkg => [ $svc_acct ],
331     ...
332   );
333   $cust_main->insert( \%hash );
334
335 INVOICING_LIST_ARYREF: No longer supported.
336
337 Currently available options are: I<depend_jobnum>, I<noexport>,
338 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
339
340 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
341 on the supplied jobnum (they will not run until the specific job completes).
342 This can be used to defer provisioning until some action completes (such
343 as running the customer's credit card successfully).
344
345 The I<noexport> option is deprecated.  If I<noexport> is set true, no
346 provisioning jobs (exports) are scheduled.  (You can schedule them later with
347 the B<reexport> method.)
348
349 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
350 of tax names and exemption numbers.  FS::cust_main_exemption records will be
351 created and inserted.
352
353 If I<prospectnum> is set, moves contacts and locations from that prospect.
354
355 If I<contact> is set to an arrayref of FS::contact objects, those will be
356 inserted.
357
358 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
359 unset), inserts those new contacts with this new customer.  Handles CGI
360 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
361
362 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
363 new stored payment records with this new customer.  Handles CGI parameters
364 for an "m2" multiple entry field as passed by edit/cust_main.cgi
365
366 =cut
367
368 sub insert {
369   my $self = shift;
370   my $cust_pkgs = @_ ? shift : {};
371   my $invoicing_list;
372   if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
373     warn "cust_main::insert using deprecated invoicing list argument";
374     $invoicing_list = shift;
375   }
376   my %options = @_;
377   warn "$me insert called with options ".
378        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
379     if $DEBUG;
380
381   return "You are not permitted to change customer invoicing terms."
382     if $self->invoice_terms #i.e. not the default
383     && ! $FS::CurrentUser::CurrentUser->access_right('Edit customer invoice terms');
384
385   local $SIG{HUP} = 'IGNORE';
386   local $SIG{INT} = 'IGNORE';
387   local $SIG{QUIT} = 'IGNORE';
388   local $SIG{TERM} = 'IGNORE';
389   local $SIG{TSTP} = 'IGNORE';
390   local $SIG{PIPE} = 'IGNORE';
391
392   my $oldAutoCommit = $FS::UID::AutoCommit;
393   local $FS::UID::AutoCommit = 0;
394   my $dbh = dbh;
395
396   my $prepay_identifier = '';
397   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
398   my $payby = '';
399   if ( $self->payby eq 'PREPAY' ) {
400
401     $self->payby(''); #'BILL');
402     $prepay_identifier = $self->payinfo;
403     $self->payinfo('');
404
405     warn "  looking up prepaid card $prepay_identifier\n"
406       if $DEBUG > 1;
407
408     my $error = $self->get_prepay( $prepay_identifier,
409                                    'amount_ref'     => \$amount,
410                                    'seconds_ref'    => \$seconds,
411                                    'upbytes_ref'    => \$upbytes,
412                                    'downbytes_ref'  => \$downbytes,
413                                    'totalbytes_ref' => \$totalbytes,
414                                  );
415     if ( $error ) {
416       $dbh->rollback if $oldAutoCommit;
417       #return "error applying prepaid card (transaction rolled back): $error";
418       return $error;
419     }
420
421     $payby = 'PREP' if $amount;
422
423   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
424
425     $payby = $1;
426     $self->payby(''); #'BILL');
427     $amount = $self->paid;
428
429   }
430
431   # insert locations
432   foreach my $l (qw(bill_location ship_location)) {
433
434     my $loc = delete $self->hashref->{$l} or next;
435
436     if ( !$loc->locationnum ) {
437       # warn the location that we're going to insert it with no custnum
438       $loc->set(custnum_pending => 1);
439       warn "  inserting $l\n"
440         if $DEBUG > 1;
441       my $error = $loc->insert;
442       if ( $error ) {
443         $dbh->rollback if $oldAutoCommit;
444         my $label = $l eq 'ship_location' ? 'service' : 'billing';
445         return "$error (in $label location)";
446       }
447
448     } elsif ( $loc->prospectnum ) {
449
450       $loc->prospectnum('');
451       $loc->set(custnum_pending => 1);
452       my $error = $loc->replace;
453       if ( $error ) {
454         $dbh->rollback if $oldAutoCommit;
455         my $label = $l eq 'ship_location' ? 'service' : 'billing';
456         return "$error (moving $label location)";
457       }
458
459     } elsif ( ($loc->custnum || 0) > 0 ) {
460       # then it somehow belongs to another customer--shouldn't happen
461       $dbh->rollback if $oldAutoCommit;
462       return "$l belongs to customer ".$loc->custnum;
463     }
464     # else it already belongs to this customer 
465     # (happens when ship_location is identical to bill_location)
466
467     $self->set($l.'num', $loc->locationnum);
468
469     if ( $self->get($l.'num') eq '' ) {
470       $dbh->rollback if $oldAutoCommit;
471       return "$l not set";
472     }
473   }
474
475   warn "  inserting $self\n"
476     if $DEBUG > 1;
477
478   $self->signupdate(time) unless $self->signupdate;
479
480   $self->auto_agent_custid()
481     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
482
483   my $error =  $self->check_payinfo_cardtype
484             || $self->SUPER::insert;
485   if ( $error ) {
486     $dbh->rollback if $oldAutoCommit;
487     #return "inserting cust_main record (transaction rolled back): $error";
488     return $error;
489   }
490
491   # now set cust_location.custnum
492   foreach my $l (qw(bill_location ship_location)) {
493     warn "  setting $l.custnum\n"
494       if $DEBUG > 1;
495     my $loc = $self->$l or next;
496     unless ( $loc->custnum ) {
497       $loc->set(custnum => $self->custnum);
498       $error ||= $loc->replace;
499     }
500
501     if ( $error ) {
502       $dbh->rollback if $oldAutoCommit;
503       return "error setting $l custnum: $error";
504     }
505   }
506
507   warn "  setting customer tags\n"
508     if $DEBUG > 1;
509
510   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
511     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
512                                       'custnum' => $self->custnum };
513     my $error = $cust_tag->insert;
514     if ( $error ) {
515       $dbh->rollback if $oldAutoCommit;
516       return $error;
517     }
518   }
519
520   my $prospectnum = delete $options{'prospectnum'};
521   if ( $prospectnum ) {
522
523     warn "  moving contacts and locations from prospect $prospectnum\n"
524       if $DEBUG > 1;
525
526     my $prospect_main =
527       qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
528     unless ( $prospect_main ) {
529       $dbh->rollback if $oldAutoCommit;
530       return "Unknown prospectnum $prospectnum";
531     }
532     $prospect_main->custnum($self->custnum);
533     $prospect_main->disabled('Y');
534     my $error = $prospect_main->replace;
535     if ( $error ) {
536       $dbh->rollback if $oldAutoCommit;
537       return $error;
538     }
539
540     foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
541       my $cust_contact = new FS::cust_contact {
542         'custnum' => $self->custnum,
543         'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts
544         map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
545       };
546       my $error =  $cust_contact->insert
547                 || $prospect_contact->delete;
548       if ( $error ) {
549         $dbh->rollback if $oldAutoCommit;
550         return $error;
551       }
552     }
553
554     my @cust_location = $prospect_main->cust_location;
555     my @qual = $prospect_main->qual;
556
557     foreach my $r ( @cust_location, @qual ) {
558       $r->prospectnum('');
559       $r->custnum($self->custnum);
560       my $error = $r->replace;
561       if ( $error ) {
562         $dbh->rollback if $oldAutoCommit;
563         return $error;
564       }
565     }
566     # since we set invoice_dest on all migrated prospect contacts (for now),
567     # don't process invoicing_list.
568     delete $options{'invoicing_list'};
569     $invoicing_list = undef;
570   }
571
572   warn "  setting contacts\n"
573     if $DEBUG > 1;
574
575   $invoicing_list ||= $options{'invoicing_list'};
576   if ( $invoicing_list ) {
577
578     $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
579
580     my $email = '';
581     foreach my $dest (@$invoicing_list ) {
582       if ($dest eq 'POST') {
583         $self->set('postal_invoice', 'Y');
584       } else {
585
586         my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
587         if ( $contact_email ) {
588           my $cust_contact = FS::cust_contact->new({
589               contactnum    => $contact_email->contactnum,
590               custnum       => $self->custnum,
591           });
592           $cust_contact->set('invoice_dest', 'Y');
593           my $error = $cust_contact->insert;
594           if ( $error ) {
595             $dbh->rollback if $oldAutoCommit;
596             return "$error (linking to email address $dest)";
597           }
598
599         } else {
600           # this email address is not yet linked to any contact
601           $email .= ',' if length($email);
602           $email .= $dest;
603         }
604       }
605     }
606
607     if ( $email ) {
608
609       my $contact = FS::contact->new({
610         'custnum'       => $self->get('custnum'),
611         'last'          => $self->get('last'),
612         'first'         => $self->get('first'),
613         'emailaddress'  => $email,
614         'invoice_dest'  => 'Y', # yes, you can set this via the contact
615       });
616       my $error = $contact->insert;
617       if ( $error ) {
618         $dbh->rollback if $oldAutoCommit;
619         return $error;
620       }
621
622     }
623
624   }
625
626   if ( my $contact = delete $options{'contact'} ) {
627
628     foreach my $c ( @$contact ) {
629       $c->custnum($self->custnum);
630       my $error = $c->insert;
631       if ( $error ) {
632         $dbh->rollback if $oldAutoCommit;
633         return $error;
634       }
635
636     }
637
638   } elsif ( my $contact_params = delete $options{'contact_params'} ) {
639
640     my $error = $self->process_o2m( 'table'  => 'contact',
641                                     'fields' => FS::contact->cgi_contact_fields,
642                                     'params' => $contact_params,
643                                   );
644     if ( $error ) {
645       $dbh->rollback if $oldAutoCommit;
646       return $error;
647     }
648   }
649
650   warn "  setting cust_payby\n"
651     if $DEBUG > 1;
652
653   if ( $options{cust_payby} ) {
654
655     foreach my $cust_payby ( @{ $options{cust_payby} } ) {
656       $cust_payby->custnum($self->custnum);
657       my $error = $cust_payby->insert;
658       if ( $error ) {
659         $dbh->rollback if $oldAutoCommit;
660         return $error;
661       }
662     }
663
664   } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
665
666     my $error = $self->process_o2m(
667       'table'         => 'cust_payby',
668       'fields'        => FS::cust_payby->cgi_cust_payby_fields,
669       'params'        => $cust_payby_params,
670       'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
671     );
672     if ( $error ) {
673       $dbh->rollback if $oldAutoCommit;
674       return $error;
675     }
676
677   }
678
679   warn "  setting cust_main_exemption\n"
680     if $DEBUG > 1;
681
682   my $tax_exemption = delete $options{'tax_exemption'};
683   if ( $tax_exemption ) {
684
685     $tax_exemption = { map { $_ => '' } @$tax_exemption }
686       if ref($tax_exemption) eq 'ARRAY';
687
688     foreach my $taxname ( keys %$tax_exemption ) {
689       my $cust_main_exemption = new FS::cust_main_exemption {
690         'custnum'       => $self->custnum,
691         'taxname'       => $taxname,
692         'exempt_number' => $tax_exemption->{$taxname},
693       };
694       my $error = $cust_main_exemption->insert;
695       if ( $error ) {
696         $dbh->rollback if $oldAutoCommit;
697         return "inserting cust_main_exemption (transaction rolled back): $error";
698       }
699     }
700   }
701
702   warn "  ordering packages\n"
703     if $DEBUG > 1;
704
705   $error = $self->order_pkgs( $cust_pkgs,
706                               %options,
707                               'seconds_ref'    => \$seconds,
708                               'upbytes_ref'    => \$upbytes,
709                               'downbytes_ref'  => \$downbytes,
710                               'totalbytes_ref' => \$totalbytes,
711                             );
712   if ( $error ) {
713     $dbh->rollback if $oldAutoCommit;
714     return $error;
715   }
716
717   if ( $seconds ) {
718     $dbh->rollback if $oldAutoCommit;
719     return "No svc_acct record to apply pre-paid time";
720   }
721   if ( $upbytes || $downbytes || $totalbytes ) {
722     $dbh->rollback if $oldAutoCommit;
723     return "No svc_acct record to apply pre-paid data";
724   }
725
726   if ( $amount ) {
727     warn "  inserting initial $payby payment of $amount\n"
728       if $DEBUG > 1;
729     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
730     if ( $error ) {
731       $dbh->rollback if $oldAutoCommit;
732       return "inserting payment (transaction rolled back): $error";
733     }
734   }
735
736   unless ( $import || $skip_fuzzyfiles ) {
737     warn "  queueing fuzzyfiles update\n"
738       if $DEBUG > 1;
739     $error = $self->queue_fuzzyfiles_update;
740     if ( $error ) {
741       $dbh->rollback if $oldAutoCommit;
742       return "updating fuzzy search cache: $error";
743     }
744   }
745
746   # FS::geocode_Mixin::after_insert or something?
747   if ( $conf->config('tax_district_method') and !$import ) {
748     # if anything non-empty, try to look it up
749     my $queue = new FS::queue {
750       'job'     => 'FS::geocode_Mixin::process_district_update',
751       'custnum' => $self->custnum,
752     };
753     my $error = $queue->insert( ref($self), $self->custnum );
754     if ( $error ) {
755       $dbh->rollback if $oldAutoCommit;
756       return "queueing tax district update: $error";
757     }
758   }
759
760   # cust_main exports!
761   warn "  exporting\n" if $DEBUG > 1;
762
763   my $export_args = $options{'export_args'} || [];
764
765   my @part_export =
766     map qsearch( 'part_export', {exportnum=>$_} ),
767       $conf->config('cust_main-exports'); #, $agentnum
768
769   foreach my $part_export ( @part_export ) {
770     my $error = $part_export->export_insert($self, @$export_args);
771     if ( $error ) {
772       $dbh->rollback if $oldAutoCommit;
773       return "exporting to ". $part_export->exporttype.
774              " (transaction rolled back): $error";
775     }
776   }
777
778   #foreach my $depend_jobnum ( @$depend_jobnums ) {
779   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
780   #      if $DEBUG;
781   #    foreach my $jobnum ( @jobnums ) {
782   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
783   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
784   #        if $DEBUG;
785   #      my $error = $queue->depend_insert($depend_jobnum);
786   #      if ( $error ) {
787   #        $dbh->rollback if $oldAutoCommit;
788   #        return "error queuing job dependancy: $error";
789   #      }
790   #    }
791   #  }
792   #
793   #}
794   #
795   #if ( exists $options{'jobnums'} ) {
796   #  push @{ $options{'jobnums'} }, @jobnums;
797   #}
798
799   warn "  insert complete; committing transaction\n"
800     if $DEBUG > 1;
801
802   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
803   '';
804
805 }
806
807 use File::CounterFile;
808 sub auto_agent_custid {
809   my $self = shift;
810
811   my $format = $conf->config('cust_main-auto_agent_custid');
812   my $agent_custid;
813   if ( $format eq '1YMMXXXXXXXX' ) {
814
815     my $counter = new File::CounterFile 'cust_main.agent_custid';
816     $counter->lock;
817
818     my $ym = 100000000000 + time2str('%y%m00000000', time);
819     if ( $ym > $counter->value ) {
820       $counter->{'value'} = $agent_custid = $ym;
821       $counter->{'updated'} = 1;
822     } else {
823       $agent_custid = $counter->inc;
824     }
825
826     $counter->unlock;
827
828   } else {
829     die "Unknown cust_main-auto_agent_custid format: $format";
830   }
831
832   $self->agent_custid($agent_custid);
833
834 }
835
836 =item PACKAGE METHODS
837
838 Documentation on customer package methods has been moved to
839 L<FS::cust_main::Packages>.
840
841 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
842
843 Recharges this (existing) customer with the specified prepaid card (see
844 L<FS::prepay_credit>), specified either by I<identifier> or as an
845 FS::prepay_credit object.  If there is an error, returns the error, otherwise
846 returns false.
847
848 Optionally, five scalar references can be passed as well.  They will have their
849 values filled in with the amount, number of seconds, and number of upload,
850 download, and total bytes applied by this prepaid card.
851
852 =cut
853
854 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
855 #the only place that uses these args
856 sub recharge_prepay { 
857   my( $self, $prepay_credit, $amountref, $secondsref, 
858       $upbytesref, $downbytesref, $totalbytesref ) = @_;
859
860   local $SIG{HUP} = 'IGNORE';
861   local $SIG{INT} = 'IGNORE';
862   local $SIG{QUIT} = 'IGNORE';
863   local $SIG{TERM} = 'IGNORE';
864   local $SIG{TSTP} = 'IGNORE';
865   local $SIG{PIPE} = 'IGNORE';
866
867   my $oldAutoCommit = $FS::UID::AutoCommit;
868   local $FS::UID::AutoCommit = 0;
869   my $dbh = dbh;
870
871   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
872
873   my $error = $self->get_prepay( $prepay_credit,
874                                  'amount_ref'     => \$amount,
875                                  'seconds_ref'    => \$seconds,
876                                  'upbytes_ref'    => \$upbytes,
877                                  'downbytes_ref'  => \$downbytes,
878                                  'totalbytes_ref' => \$totalbytes,
879                                )
880            || $self->increment_seconds($seconds)
881            || $self->increment_upbytes($upbytes)
882            || $self->increment_downbytes($downbytes)
883            || $self->increment_totalbytes($totalbytes)
884            || $self->insert_cust_pay_prepay( $amount,
885                                              ref($prepay_credit)
886                                                ? $prepay_credit->identifier
887                                                : $prepay_credit
888                                            );
889
890   if ( $error ) {
891     $dbh->rollback if $oldAutoCommit;
892     return $error;
893   }
894
895   if ( defined($amountref)  ) { $$amountref  = $amount;  }
896   if ( defined($secondsref) ) { $$secondsref = $seconds; }
897   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
898   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
899   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
900
901   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
902   '';
903
904 }
905
906 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
907
908 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
909 specified either by I<identifier> or as an FS::prepay_credit object.
910
911 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
912 incremented by the values of the prepaid card.
913
914 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
915 check or set this customer's I<agentnum>.
916
917 If there is an error, returns the error, otherwise returns false.
918
919 =cut
920
921
922 sub get_prepay {
923   my( $self, $prepay_credit, %opt ) = @_;
924
925   local $SIG{HUP} = 'IGNORE';
926   local $SIG{INT} = 'IGNORE';
927   local $SIG{QUIT} = 'IGNORE';
928   local $SIG{TERM} = 'IGNORE';
929   local $SIG{TSTP} = 'IGNORE';
930   local $SIG{PIPE} = 'IGNORE';
931
932   my $oldAutoCommit = $FS::UID::AutoCommit;
933   local $FS::UID::AutoCommit = 0;
934   my $dbh = dbh;
935
936   unless ( ref($prepay_credit) ) {
937
938     my $identifier = $prepay_credit;
939
940     $prepay_credit = qsearchs(
941       'prepay_credit',
942       { 'identifier' => $identifier },
943       '',
944       'FOR UPDATE'
945     );
946
947     unless ( $prepay_credit ) {
948       $dbh->rollback if $oldAutoCommit;
949       return "Invalid prepaid card: ". $identifier;
950     }
951
952   }
953
954   if ( $prepay_credit->agentnum ) {
955     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
956       $dbh->rollback if $oldAutoCommit;
957       return "prepaid card not valid for agent ". $self->agentnum;
958     }
959     $self->agentnum($prepay_credit->agentnum);
960   }
961
962   my $error = $prepay_credit->delete;
963   if ( $error ) {
964     $dbh->rollback if $oldAutoCommit;
965     return "removing prepay_credit (transaction rolled back): $error";
966   }
967
968   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
969     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
970
971   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
972   '';
973
974 }
975
976 =item increment_upbytes SECONDS
977
978 Updates this customer's single or primary account (see L<FS::svc_acct>) by
979 the specified number of upbytes.  If there is an error, returns the error,
980 otherwise returns false.
981
982 =cut
983
984 sub increment_upbytes {
985   _increment_column( shift, 'upbytes', @_);
986 }
987
988 =item increment_downbytes SECONDS
989
990 Updates this customer's single or primary account (see L<FS::svc_acct>) by
991 the specified number of downbytes.  If there is an error, returns the error,
992 otherwise returns false.
993
994 =cut
995
996 sub increment_downbytes {
997   _increment_column( shift, 'downbytes', @_);
998 }
999
1000 =item increment_totalbytes SECONDS
1001
1002 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1003 the specified number of totalbytes.  If there is an error, returns the error,
1004 otherwise returns false.
1005
1006 =cut
1007
1008 sub increment_totalbytes {
1009   _increment_column( shift, 'totalbytes', @_);
1010 }
1011
1012 =item increment_seconds SECONDS
1013
1014 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1015 the specified number of seconds.  If there is an error, returns the error,
1016 otherwise returns false.
1017
1018 =cut
1019
1020 sub increment_seconds {
1021   _increment_column( shift, 'seconds', @_);
1022 }
1023
1024 =item _increment_column AMOUNT
1025
1026 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1027 the specified number of seconds or bytes.  If there is an error, returns
1028 the error, otherwise returns false.
1029
1030 =cut
1031
1032 sub _increment_column {
1033   my( $self, $column, $amount ) = @_;
1034   warn "$me increment_column called: $column, $amount\n"
1035     if $DEBUG;
1036
1037   return '' unless $amount;
1038
1039   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1040                       $self->ncancelled_pkgs;
1041
1042   if ( ! @cust_pkg ) {
1043     return 'No packages with primary or single services found'.
1044            ' to apply pre-paid time';
1045   } elsif ( scalar(@cust_pkg) > 1 ) {
1046     #maybe have a way to specify the package/account?
1047     return 'Multiple packages found to apply pre-paid time';
1048   }
1049
1050   my $cust_pkg = $cust_pkg[0];
1051   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1052     if $DEBUG > 1;
1053
1054   my @cust_svc =
1055     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1056
1057   if ( ! @cust_svc ) {
1058     return 'No account found to apply pre-paid time';
1059   } elsif ( scalar(@cust_svc) > 1 ) {
1060     return 'Multiple accounts found to apply pre-paid time';
1061   }
1062   
1063   my $svc_acct = $cust_svc[0]->svc_x;
1064   warn "  found service svcnum ". $svc_acct->pkgnum.
1065        ' ('. $svc_acct->email. ")\n"
1066     if $DEBUG > 1;
1067
1068   $column = "increment_$column";
1069   $svc_acct->$column($amount);
1070
1071 }
1072
1073 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1074
1075 Inserts a prepayment in the specified amount for this customer.  An optional
1076 second argument can specify the prepayment identifier for tracking purposes.
1077 If there is an error, returns the error, otherwise returns false.
1078
1079 =cut
1080
1081 sub insert_cust_pay_prepay {
1082   shift->insert_cust_pay('PREP', @_);
1083 }
1084
1085 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1086
1087 Inserts a cash payment in the specified amount for this customer.  An optional
1088 second argument can specify the payment identifier for tracking purposes.
1089 If there is an error, returns the error, otherwise returns false.
1090
1091 =cut
1092
1093 sub insert_cust_pay_cash {
1094   shift->insert_cust_pay('CASH', @_);
1095 }
1096
1097 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1098
1099 Inserts a Western Union payment in the specified amount for this customer.  An
1100 optional second argument can specify the prepayment identifier for tracking
1101 purposes.  If there is an error, returns the error, otherwise returns false.
1102
1103 =cut
1104
1105 sub insert_cust_pay_west {
1106   shift->insert_cust_pay('WEST', @_);
1107 }
1108
1109 sub insert_cust_pay {
1110   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1111   my $payinfo = scalar(@_) ? shift : '';
1112
1113   my $cust_pay = new FS::cust_pay {
1114     'custnum' => $self->custnum,
1115     'paid'    => sprintf('%.2f', $amount),
1116     #'_date'   => #date the prepaid card was purchased???
1117     'payby'   => $payby,
1118     'payinfo' => $payinfo,
1119   };
1120   $cust_pay->insert;
1121
1122 }
1123
1124 =item delete [ OPTION => VALUE ... ]
1125
1126 This deletes the customer.  If there is an error, returns the error, otherwise
1127 returns false.
1128
1129 This will completely remove all traces of the customer record.  This is not
1130 what you want when a customer cancels service; for that, cancel all of the
1131 customer's packages (see L</cancel>).
1132
1133 If the customer has any uncancelled packages, you need to pass a new (valid)
1134 customer number for those packages to be transferred to, as the "new_customer"
1135 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1136 what you want when a customer cancels service and that you really should be
1137 looking at L<FS::cust_pkg/cancel>?  
1138
1139 You can't delete a customer with invoices (see L<FS::cust_bill>),
1140 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1141 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1142 set the "delete_financials" option to a true value.
1143
1144 =cut
1145
1146 sub delete {
1147   my( $self, %opt ) = @_;
1148
1149   local $SIG{HUP} = 'IGNORE';
1150   local $SIG{INT} = 'IGNORE';
1151   local $SIG{QUIT} = 'IGNORE';
1152   local $SIG{TERM} = 'IGNORE';
1153   local $SIG{TSTP} = 'IGNORE';
1154   local $SIG{PIPE} = 'IGNORE';
1155
1156   my $oldAutoCommit = $FS::UID::AutoCommit;
1157   local $FS::UID::AutoCommit = 0;
1158   my $dbh = dbh;
1159
1160   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1161      $dbh->rollback if $oldAutoCommit;
1162      return "Can't delete a master agent customer";
1163   }
1164
1165   #use FS::access_user
1166   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1167      $dbh->rollback if $oldAutoCommit;
1168      return "Can't delete a master employee customer";
1169   }
1170
1171   tie my %financial_tables, 'Tie::IxHash',
1172     'cust_bill'      => 'invoices',
1173     'cust_statement' => 'statements',
1174     'cust_credit'    => 'credits',
1175     'cust_pay'       => 'payments',
1176     'cust_refund'    => 'refunds',
1177   ;
1178    
1179   foreach my $table ( keys %financial_tables ) {
1180
1181     my @records = $self->$table();
1182
1183     if ( @records && ! $opt{'delete_financials'} ) {
1184       $dbh->rollback if $oldAutoCommit;
1185       return "Can't delete a customer with ". $financial_tables{$table};
1186     }
1187
1188     foreach my $record ( @records ) {
1189       my $error = $record->delete;
1190       if ( $error ) {
1191         $dbh->rollback if $oldAutoCommit;
1192         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1193       }
1194     }
1195
1196   }
1197
1198   my @cust_pkg = $self->ncancelled_pkgs;
1199   if ( @cust_pkg ) {
1200     my $new_custnum = $opt{'new_custnum'};
1201     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1202       $dbh->rollback if $oldAutoCommit;
1203       return "Invalid new customer number: $new_custnum";
1204     }
1205     foreach my $cust_pkg ( @cust_pkg ) {
1206       my %hash = $cust_pkg->hash;
1207       $hash{'custnum'} = $new_custnum;
1208       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1209       my $error = $new_cust_pkg->replace($cust_pkg,
1210                                          options => { $cust_pkg->options },
1211                                         );
1212       if ( $error ) {
1213         $dbh->rollback if $oldAutoCommit;
1214         return $error;
1215       }
1216     }
1217   }
1218   my @cancelled_cust_pkg = $self->all_pkgs;
1219   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1220     my $error = $cust_pkg->delete;
1221     if ( $error ) {
1222       $dbh->rollback if $oldAutoCommit;
1223       return $error;
1224     }
1225   }
1226
1227   #cust_tax_adjustment in financials?
1228   #cust_pay_pending?  ouch
1229   foreach my $table (qw(
1230     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1231     cust_payby cust_location cust_main_note cust_tax_adjustment
1232     cust_pay_void cust_pay_batch queue cust_tax_exempt
1233   )) {
1234     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1235       my $error = $record->delete;
1236       if ( $error ) {
1237         $dbh->rollback if $oldAutoCommit;
1238         return $error;
1239       }
1240     }
1241   }
1242
1243   my $sth = $dbh->prepare(
1244     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1245   ) or do {
1246     my $errstr = $dbh->errstr;
1247     $dbh->rollback if $oldAutoCommit;
1248     return $errstr;
1249   };
1250   $sth->execute($self->custnum) or do {
1251     my $errstr = $sth->errstr;
1252     $dbh->rollback if $oldAutoCommit;
1253     return $errstr;
1254   };
1255
1256   #tickets
1257
1258   my $ticket_dbh = '';
1259   if ($conf->config('ticket_system') eq 'RT_Internal') {
1260     $ticket_dbh = $dbh;
1261   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1262     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1263     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1264       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1265   }
1266
1267   if ( $ticket_dbh ) {
1268
1269     my $ticket_sth = $ticket_dbh->prepare(
1270       'DELETE FROM Links WHERE Target = ?'
1271     ) or do {
1272       my $errstr = $ticket_dbh->errstr;
1273       $dbh->rollback if $oldAutoCommit;
1274       return $errstr;
1275     };
1276     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1277       or do {
1278         my $errstr = $ticket_sth->errstr;
1279         $dbh->rollback if $oldAutoCommit;
1280         return $errstr;
1281       };
1282
1283     #check and see if the customer is the only link on the ticket, and
1284     #if so, set the ticket to deleted status in RT?
1285     #maybe someday, for now this will at least fix tickets not displaying
1286
1287   }
1288
1289   #delete the customer record
1290
1291   my $error = $self->SUPER::delete;
1292   if ( $error ) {
1293     $dbh->rollback if $oldAutoCommit;
1294     return $error;
1295   }
1296
1297   # cust_main exports!
1298
1299   #my $export_args = $options{'export_args'} || [];
1300
1301   my @part_export =
1302     map qsearch( 'part_export', {exportnum=>$_} ),
1303       $conf->config('cust_main-exports'); #, $agentnum
1304
1305   foreach my $part_export ( @part_export ) {
1306     my $error = $part_export->export_delete( $self ); #, @$export_args);
1307     if ( $error ) {
1308       $dbh->rollback if $oldAutoCommit;
1309       return "exporting to ". $part_export->exporttype.
1310              " (transaction rolled back): $error";
1311     }
1312   }
1313
1314   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1315   '';
1316
1317 }
1318
1319 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1320
1321 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1322 returns the error, otherwise returns false.
1323
1324 To change the customer's address, set the pseudo-fields C<bill_location> and
1325 C<ship_location>.  The address will still only change if at least one of the
1326 address fields differs from the existing values.
1327
1328 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1329 set as the contact email address for a default contact with the same name as
1330 the customer.
1331
1332 Currently available options are: I<tax_exemption>, I<cust_payby_params>, 
1333 I<contact_params>, I<invoicing_list>, and I<move_pkgs>.
1334
1335 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1336 of tax names and exemption numbers.  FS::cust_main_exemption records will be
1337 deleted and inserted as appropriate.
1338
1339 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1340 groups (describing the customer's payment methods and contacts, respectively)
1341 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1342 and L<FS::contact> for the fields these can contain.
1343
1344 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1345 should be used instead if possible.
1346
1347 If I<move_pkgs> is an arrayref, it will override the list of packages
1348 to be moved to the new address (see L<FS::cust_location/move_pkgs>.)
1349
1350 =cut
1351
1352 sub replace {
1353   my $self = shift;
1354
1355   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1356               ? shift
1357               : $self->replace_old;
1358
1359   my @param = @_;
1360
1361   warn "$me replace called\n"
1362     if $DEBUG;
1363
1364   my $curuser = $FS::CurrentUser::CurrentUser;
1365   return "You are not permitted to create complimentary accounts."
1366     if $self->complimentary eq 'Y'
1367     && $self->complimentary ne $old->complimentary
1368     && ! $curuser->access_right('Complimentary customer');
1369
1370   local($ignore_expired_card) = 1
1371     if $old->payby  =~ /^(CARD|DCRD)$/
1372     && $self->payby =~ /^(CARD|DCRD)$/
1373     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1374
1375   local($ignore_banned_card) = 1
1376     if (    $old->payby  =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1377          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1378     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1379
1380   if (    $self->payby =~ /^(CARD|DCRD)$/
1381        && $old->payinfo ne $self->payinfo
1382        && $old->paymask ne $self->paymask )
1383   {
1384     my $error = $self->check_payinfo_cardtype;
1385     return $error if $error;
1386   }
1387
1388   return "Invoicing locale is required"
1389     if $old->locale
1390     && ! $self->locale
1391     && $conf->exists('cust_main-require_locale');
1392
1393   return "You are not permitted to change customer invoicing terms."
1394     if $old->invoice_terms ne $self->invoice_terms
1395     && ! $curuser->access_right('Edit customer invoice terms');
1396
1397   local $SIG{HUP} = 'IGNORE';
1398   local $SIG{INT} = 'IGNORE';
1399   local $SIG{QUIT} = 'IGNORE';
1400   local $SIG{TERM} = 'IGNORE';
1401   local $SIG{TSTP} = 'IGNORE';
1402   local $SIG{PIPE} = 'IGNORE';
1403
1404   my $oldAutoCommit = $FS::UID::AutoCommit;
1405   local $FS::UID::AutoCommit = 0;
1406   my $dbh = dbh;
1407
1408   for my $l (qw(bill_location ship_location)) {
1409     #my $old_loc = $old->$l;
1410     my $new_loc = $self->$l or next;
1411
1412     # find the existing location if there is one
1413     $new_loc->set('custnum' => $self->custnum);
1414     my $error = $new_loc->find_or_insert;
1415     if ( $error ) {
1416       $dbh->rollback if $oldAutoCommit;
1417       return $error;
1418     }
1419     $self->set($l.'num', $new_loc->locationnum);
1420   } #for $l
1421
1422   my $invoicing_list;
1423   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1424     warn "cust_main::replace: using deprecated invoicing list argument";
1425     $invoicing_list = shift @param;
1426   }
1427
1428   my %options = @param;
1429
1430   $invoicing_list ||= $options{invoicing_list};
1431
1432   my @contacts = map { $_->contact } $self->cust_contact;
1433   # find a contact that matches the customer's name
1434   my ($implicit_contact) = grep { $_->first eq $old->get('first')
1435                               and $_->last  eq $old->get('last') }
1436                             @contacts;
1437   $implicit_contact ||= FS::contact->new({
1438       'custnum'       => $self->custnum,
1439       'locationnum'   => $self->get('bill_locationnum'),
1440   });
1441
1442   # for any of these that are already contact emails, link to the existing
1443   # contact
1444   if ( $invoicing_list ) {
1445     my $email = '';
1446
1447     # kind of like process_m2m on these, except:
1448     # - the other side is two tables in a join
1449     # - and we might have to create new contact_emails
1450     # - and possibly a new contact
1451     # 
1452     # Find existing invoice emails that aren't on the implicit contact.
1453     # Any of these that are not on the new invoicing list will be removed.
1454     my %old_email_cust_contact;
1455     foreach my $cust_contact ($self->cust_contact) {
1456       next if !$cust_contact->invoice_dest;
1457       next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
1458
1459       foreach my $contact_email ($cust_contact->contact->contact_email) {
1460         $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
1461       }
1462     }
1463
1464     foreach my $dest (@$invoicing_list) {
1465
1466       if ($dest eq 'POST') {
1467
1468         $self->set('postal_invoice', 'Y');
1469
1470       } elsif ( exists($old_email_cust_contact{$dest}) ) {
1471
1472         delete $old_email_cust_contact{$dest}; # don't need to remove it, then
1473
1474       } else {
1475
1476         # See if it belongs to some other contact; if so, link it.
1477         my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
1478         if ( $contact_email
1479              and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
1480           my $cust_contact = qsearchs('cust_contact', {
1481               contactnum  => $contact_email->contactnum,
1482               custnum     => $self->custnum,
1483           }) || FS::cust_contact->new({
1484               contactnum    => $contact_email->contactnum,
1485               custnum       => $self->custnum,
1486           });
1487           $cust_contact->set('invoice_dest', 'Y');
1488           my $error = $cust_contact->custcontactnum ?
1489                         $cust_contact->replace : $cust_contact->insert;
1490           if ( $error ) {
1491             $dbh->rollback if $oldAutoCommit;
1492             return "$error (linking to email address $dest)";
1493           }
1494
1495         } else {
1496           # This email address is not yet linked to any contact, so it will
1497           # be added to the implicit contact.
1498           $email .= ',' if length($email);
1499           $email .= $dest;
1500         }
1501       }
1502     }
1503
1504     foreach my $remove_dest (keys %old_email_cust_contact) {
1505       my $cust_contact = $old_email_cust_contact{$remove_dest};
1506       # These were not in the list of requested destinations, so take them off.
1507       $cust_contact->set('invoice_dest', '');
1508       my $error = $cust_contact->replace;
1509       if ( $error ) {
1510         $dbh->rollback if $oldAutoCommit;
1511         return "$error (unlinking email address $remove_dest)";
1512       }
1513     }
1514
1515     # make sure it keeps up with the changed customer name, if any
1516     $implicit_contact->set('last', $self->get('last'));
1517     $implicit_contact->set('first', $self->get('first'));
1518     $implicit_contact->set('emailaddress', $email);
1519     $implicit_contact->set('invoice_dest', 'Y');
1520     $implicit_contact->set('custnum', $self->custnum);
1521     my $i_cust_contact =
1522       qsearchs('cust_contact', {
1523                                  contactnum  => $implicit_contact->contactnum,
1524                                  custnum     => $self->custnum,
1525                                }
1526       );
1527     if ( $i_cust_contact ) {
1528       $implicit_contact->set($_, $i_cust_contact->$_)
1529         foreach qw( classnum selfservice_access comment );
1530     }
1531
1532     my $error;
1533     if ( $implicit_contact->contactnum ) {
1534       $error = $implicit_contact->replace;
1535     } elsif ( length($email) ) { # don't create a new contact if not needed
1536       $error = $implicit_contact->insert;
1537     }
1538
1539     if ( $error ) {
1540       $dbh->rollback if $oldAutoCommit;
1541       return "$error (adding email address $email)";
1542     }
1543
1544   }
1545
1546   # replace the customer record
1547   my $error = $self->SUPER::replace($old);
1548
1549   if ( $error ) {
1550     $dbh->rollback if $oldAutoCommit;
1551     return $error;
1552   }
1553
1554   # now move packages to the new service location
1555   $self->set('ship_location', ''); #flush cache
1556   if ( $old->ship_locationnum and # should only be null during upgrade...
1557        $old->ship_locationnum != $self->ship_locationnum ) {
1558     $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'});
1559     if ( $error ) {
1560       $dbh->rollback if $oldAutoCommit;
1561       return $error;
1562     }
1563   }
1564   # don't move packages based on the billing location, but 
1565   # disable it if it's no longer in use
1566   if ( $old->bill_locationnum and
1567        $old->bill_locationnum != $self->bill_locationnum ) {
1568     $error = $old->bill_location->disable_if_unused;
1569     if ( $error ) {
1570       $dbh->rollback if $oldAutoCommit;
1571       return $error;
1572     }
1573   }
1574
1575   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1576
1577     #this could be more efficient than deleting and re-inserting, if it matters
1578     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1579       my $error = $cust_tag->delete;
1580       if ( $error ) {
1581         $dbh->rollback if $oldAutoCommit;
1582         return $error;
1583       }
1584     }
1585     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1586       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1587                                         'custnum' => $self->custnum };
1588       my $error = $cust_tag->insert;
1589       if ( $error ) {
1590         $dbh->rollback if $oldAutoCommit;
1591         return $error;
1592       }
1593     }
1594
1595   }
1596
1597   my $tax_exemption = delete $options{'tax_exemption'};
1598   if ( $tax_exemption ) {
1599
1600     $tax_exemption = { map { $_ => '' } @$tax_exemption }
1601       if ref($tax_exemption) eq 'ARRAY';
1602
1603     my %cust_main_exemption =
1604       map { $_->taxname => $_ }
1605           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1606
1607     foreach my $taxname ( keys %$tax_exemption ) {
1608
1609       if ( $cust_main_exemption{$taxname} && 
1610            $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1611          )
1612       {
1613         delete $cust_main_exemption{$taxname};
1614         next;
1615       }
1616
1617       my $cust_main_exemption = new FS::cust_main_exemption {
1618         'custnum'       => $self->custnum,
1619         'taxname'       => $taxname,
1620         'exempt_number' => $tax_exemption->{$taxname},
1621       };
1622       my $error = $cust_main_exemption->insert;
1623       if ( $error ) {
1624         $dbh->rollback if $oldAutoCommit;
1625         return "inserting cust_main_exemption (transaction rolled back): $error";
1626       }
1627     }
1628
1629     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1630       my $error = $cust_main_exemption->delete;
1631       if ( $error ) {
1632         $dbh->rollback if $oldAutoCommit;
1633         return "deleting cust_main_exemption (transaction rolled back): $error";
1634       }
1635     }
1636
1637   }
1638
1639   if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1640
1641     my $error = $self->process_o2m(
1642       'table'         => 'cust_payby',
1643       'fields'        => FS::cust_payby->cgi_cust_payby_fields,
1644       'params'        => $cust_payby_params,
1645       'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1646     );
1647     if ( $error ) {
1648       $dbh->rollback if $oldAutoCommit;
1649       return $error;
1650     }
1651
1652   }
1653
1654   if ( my $contact_params = delete $options{'contact_params'} ) {
1655
1656     # this can potentially replace contacts that were created by the
1657     # invoicing list argument, but the UI shouldn't allow both of them
1658     # to be specified
1659
1660     my $error = $self->process_o2m(
1661       'table'         => 'contact',
1662       'fields'        => FS::contact->cgi_contact_fields,
1663       'params'        => $contact_params,
1664     );
1665     if ( $error ) {
1666       $dbh->rollback if $oldAutoCommit;
1667       return $error;
1668     }
1669
1670   }
1671
1672   unless ( $import || $skip_fuzzyfiles ) {
1673     $error = $self->queue_fuzzyfiles_update;
1674     if ( $error ) {
1675       $dbh->rollback if $oldAutoCommit;
1676       return "updating fuzzy search cache: $error";
1677     }
1678   }
1679
1680   # tax district update in cust_location
1681
1682   # cust_main exports!
1683
1684   my $export_args = $options{'export_args'} || [];
1685
1686   my @part_export =
1687     map qsearch( 'part_export', {exportnum=>$_} ),
1688       $conf->config('cust_main-exports'); #, $agentnum
1689
1690   foreach my $part_export ( @part_export ) {
1691     my $error = $part_export->export_replace( $self, $old, @$export_args);
1692     if ( $error ) {
1693       $dbh->rollback if $oldAutoCommit;
1694       return "exporting to ". $part_export->exporttype.
1695              " (transaction rolled back): $error";
1696     }
1697   }
1698
1699   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1700   '';
1701
1702 }
1703
1704 =item queue_fuzzyfiles_update
1705
1706 Used by insert & replace to update the fuzzy search cache
1707
1708 =cut
1709
1710 use FS::cust_main::Search;
1711 sub queue_fuzzyfiles_update {
1712   my $self = shift;
1713
1714   local $SIG{HUP} = 'IGNORE';
1715   local $SIG{INT} = 'IGNORE';
1716   local $SIG{QUIT} = 'IGNORE';
1717   local $SIG{TERM} = 'IGNORE';
1718   local $SIG{TSTP} = 'IGNORE';
1719   local $SIG{PIPE} = 'IGNORE';
1720
1721   my $oldAutoCommit = $FS::UID::AutoCommit;
1722   local $FS::UID::AutoCommit = 0;
1723   my $dbh = dbh;
1724
1725   foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1726     my $queue = new FS::queue { 
1727       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1728     };
1729     my @args = "cust_main.$field", $self->get($field);
1730     my $error = $queue->insert( @args );
1731     if ( $error ) {
1732       $dbh->rollback if $oldAutoCommit;
1733       return "queueing job (transaction rolled back): $error";
1734     }
1735   }
1736
1737   my @locations = ();
1738   push @locations, $self->bill_location if $self->bill_locationnum;
1739   push @locations, $self->ship_location if @locations && $self->has_ship_address;
1740   foreach my $location (@locations) {
1741     my $queue = new FS::queue { 
1742       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1743     };
1744     my @args = 'cust_location.address1', $location->address1;
1745     my $error = $queue->insert( @args );
1746     if ( $error ) {
1747       $dbh->rollback if $oldAutoCommit;
1748       return "queueing job (transaction rolled back): $error";
1749     }
1750   }
1751
1752   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1753   '';
1754
1755 }
1756
1757 =item check
1758
1759 Checks all fields to make sure this is a valid customer record.  If there is
1760 an error, returns the error, otherwise returns false.  Called by the insert
1761 and replace methods.
1762
1763 =cut
1764
1765 sub check {
1766   my $self = shift;
1767
1768   warn "$me check BEFORE: \n". $self->_dump
1769     if $DEBUG > 2;
1770
1771   my $error =
1772     $self->ut_numbern('custnum')
1773     || $self->ut_number('agentnum')
1774     || $self->ut_textn('agent_custid')
1775     || $self->ut_number('refnum')
1776     || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1777     || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1778     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1779     || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1780     || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1781     || $self->ut_textn('custbatch')
1782     || $self->ut_name('last')
1783     || $self->ut_name('first')
1784     || $self->ut_snumbern('signupdate')
1785     || $self->ut_snumbern('birthdate')
1786     || $self->ut_namen('spouse_last')
1787     || $self->ut_namen('spouse_first')
1788     || $self->ut_snumbern('spouse_birthdate')
1789     || $self->ut_snumbern('anniversary_date')
1790     || $self->ut_textn('company')
1791     || $self->ut_textn('ship_company')
1792     || $self->ut_anything('comments')
1793     || $self->ut_numbern('referral_custnum')
1794     || $self->ut_textn('stateid')
1795     || $self->ut_textn('stateid_state')
1796     || $self->ut_textn('invoice_terms')
1797     || $self->ut_floatn('cdr_termination_percentage')
1798     || $self->ut_floatn('credit_limit')
1799     || $self->ut_numbern('billday')
1800     || $self->ut_numbern('prorate_day')
1801     || $self->ut_flag('force_prorate_day')
1802     || $self->ut_flag('edit_subject')
1803     || $self->ut_flag('calling_list_exempt')
1804     || $self->ut_flag('invoice_noemail')
1805     || $self->ut_flag('message_noemail')
1806     || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1807     || $self->ut_currencyn('currency')
1808     || $self->ut_textn('po_number')
1809     || $self->ut_enum('complimentary', [ '', 'Y' ])
1810     || $self->ut_flag('invoice_ship_address')
1811     || $self->ut_flag('invoice_dest')
1812   ;
1813
1814   foreach (qw(company ship_company)) {
1815     my $company = $self->get($_);
1816     $company =~ s/^\s+//; 
1817     $company =~ s/\s+$//; 
1818     $company =~ s/\s+/ /g;
1819     $self->set($_, $company);
1820   }
1821
1822   #barf.  need message catalogs.  i18n.  etc.
1823   $error .= "Please select an advertising source."
1824     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1825   return $error if $error;
1826
1827   my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1828     or return "Unknown agent";
1829
1830   if ( $self->currency ) {
1831     my $agent_currency = qsearchs( 'agent_currency', {
1832       'agentnum' => $agent->agentnum,
1833       'currency' => $self->currency,
1834     })
1835       or return "Agent ". $agent->agent.
1836                 " not permitted to offer ".  $self->currency. " invoicing";
1837   }
1838
1839   return "Unknown refnum"
1840     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1841
1842   return "Unknown referring custnum: ". $self->referral_custnum
1843     unless ! $self->referral_custnum 
1844            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1845
1846   if ( $self->ss eq '' ) {
1847     $self->ss('');
1848   } else {
1849     my $ss = $self->ss;
1850     $ss =~ s/\D//g;
1851     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1852       or return "Illegal social security number: ". $self->ss;
1853     $self->ss("$1-$2-$3");
1854   }
1855
1856   #turn off invoice_ship_address if ship & bill are the same
1857   if ($self->bill_locationnum eq $self->ship_locationnum) {
1858     $self->invoice_ship_address('');
1859   }
1860
1861   # cust_main_county verification now handled by cust_location check
1862
1863   $error =
1864        $self->ut_phonen('daytime', $self->country)
1865     || $self->ut_phonen('night',   $self->country)
1866     || $self->ut_phonen('fax',     $self->country)
1867     || $self->ut_phonen('mobile',  $self->country)
1868   ;
1869   return $error if $error;
1870
1871   if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1872        && ! $import
1873        && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1874      ) {
1875
1876     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1877                           ? 'Day Phone'
1878                           : FS::Msgcat::_gettext('daytime');
1879     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1880                         ? 'Night Phone'
1881                         : FS::Msgcat::_gettext('night');
1882
1883     my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1884                         ? 'Mobile Phone'
1885                         : FS::Msgcat::_gettext('mobile');
1886
1887     return "$daytime_label, $night_label or $mobile_label is required"
1888   
1889   }
1890
1891   return "Please select an invoicing locale"
1892     if ! $self->locale
1893     && ! $self->custnum
1894     && $conf->exists('cust_main-require_locale');
1895
1896   return "Please select a customer class"
1897     if ! $self->classnum
1898     && $conf->exists('cust_main-require_classnum');
1899
1900   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1901     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1902     $self->$flag($1);
1903   }
1904
1905   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1906
1907   warn "$me check AFTER: \n". $self->_dump
1908     if $DEBUG > 2;
1909
1910   $self->SUPER::check;
1911 }
1912
1913 sub check_payinfo_cardtype {
1914   my $self = shift;
1915
1916   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
1917
1918   my $payinfo = $self->payinfo;
1919   $payinfo =~ s/\D//g;
1920
1921   return '' if $self->tokenized($payinfo); #token
1922
1923   my %bop_card_types = map { $_=>1 } values %{ card_types() };
1924   my $cardtype = cardtype($payinfo);
1925
1926   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
1927
1928   '';
1929
1930 }
1931
1932 =item replace_check
1933
1934 Additional checks for replace only.
1935
1936 =cut
1937
1938 sub replace_check {
1939   my ($new,$old) = @_;
1940   #preserve old value if global config is set
1941   if ($old && $conf->exists('invoice-ship_address')) {
1942     $new->invoice_ship_address($old->invoice_ship_address);
1943   }
1944   return '';
1945 }
1946
1947 =item addr_fields 
1948
1949 Returns a list of fields which have ship_ duplicates.
1950
1951 =cut
1952
1953 sub addr_fields {
1954   qw( last first company
1955       locationname
1956       address1 address2 city county state zip country
1957       latitude longitude
1958       daytime night fax mobile
1959     );
1960 }
1961
1962 =item has_ship_address
1963
1964 Returns true if this customer record has a separate shipping address.
1965
1966 =cut
1967
1968 sub has_ship_address {
1969   my $self = shift;
1970   $self->bill_locationnum != $self->ship_locationnum;
1971 }
1972
1973 =item location_hash
1974
1975 Returns a list of key/value pairs, with the following keys: address1, 
1976 adddress2, city, county, state, zip, country, district, and geocode.  The 
1977 shipping address is used if present.
1978
1979 =cut
1980
1981 sub location_hash {
1982   my $self = shift;
1983   $self->ship_location->location_hash;
1984 }
1985
1986 =item cust_location
1987
1988 Returns all locations (see L<FS::cust_location>) for this customer.
1989
1990 =cut
1991
1992 sub cust_location {
1993   my $self = shift;
1994   qsearch({
1995     'table'   => 'cust_location',
1996     'hashref' => { 'custnum'     => $self->custnum,
1997                    'prospectnum' => '',
1998                  },
1999     'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
2000   });
2001 }
2002
2003 =item cust_contact
2004
2005 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2006
2007 =cut
2008
2009 sub cust_contact {
2010   my $self = shift;
2011   qsearch('cust_contact', { 'custnum' => $self->custnum } );
2012 }
2013
2014 =item cust_payby PAYBY
2015
2016 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2017
2018 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2019 Does not validate PAYBY.
2020
2021 =cut
2022
2023 sub cust_payby {
2024   my $self = shift;
2025   my @payby = @_;
2026   my $search = {
2027     'table'    => 'cust_payby',
2028     'hashref'  => { 'custnum' => $self->custnum },
2029     'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2030   };
2031   $search->{'extra_sql'} = ' AND payby IN ( '.
2032                                join(',', map dbh->quote($_), @payby).
2033                              ' ) '
2034     if @payby;
2035
2036   qsearch($search);
2037 }
2038
2039 =item has_cust_payby_auto
2040
2041 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2042
2043 =cut
2044
2045 sub has_cust_payby_auto {
2046   my $self = shift;
2047   scalar( qsearch({ 
2048     'table'     => 'cust_payby',
2049     'hashref'   => { 'custnum' => $self->custnum, },
2050     'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2051     'order_by'  => 'LIMIT 1',
2052   }) );
2053
2054 }
2055
2056 =item unsuspend
2057
2058 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2059 and L<FS::cust_pkg>) for this customer, except those on hold.
2060
2061 Returns a list: an empty list on success or a list of errors.
2062
2063 =cut
2064
2065 sub unsuspend {
2066   my $self = shift;
2067   grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2068 }
2069
2070 =item release_hold
2071
2072 Unsuspends all suspended packages in the on-hold state (those without setup 
2073 dates) for this customer. 
2074
2075 =cut
2076
2077 sub release_hold {
2078   my $self = shift;
2079   grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2080 }
2081
2082 =item suspend
2083
2084 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2085
2086 Returns a list: an empty list on success or a list of errors.
2087
2088 =cut
2089
2090 sub suspend {
2091   my $self = shift;
2092   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2093 }
2094
2095 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2096
2097 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2098 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2099 of a list of pkgparts; the hashref has the following keys:
2100
2101 =over 4
2102
2103 =item pkgparts - listref of pkgparts
2104
2105 =item (other options are passed to the suspend method)
2106
2107 =back
2108
2109
2110 Returns a list: an empty list on success or a list of errors.
2111
2112 =cut
2113
2114 sub suspend_if_pkgpart {
2115   my $self = shift;
2116   my (@pkgparts, %opt);
2117   if (ref($_[0]) eq 'HASH'){
2118     @pkgparts = @{$_[0]{pkgparts}};
2119     %opt      = %{$_[0]};
2120   }else{
2121     @pkgparts = @_;
2122   }
2123   grep { $_->suspend(%opt) }
2124     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2125       $self->unsuspended_pkgs;
2126 }
2127
2128 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2129
2130 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2131 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2132 instead of a list of pkgparts; the hashref has the following keys:
2133
2134 =over 4
2135
2136 =item pkgparts - listref of pkgparts
2137
2138 =item (other options are passed to the suspend method)
2139
2140 =back
2141
2142 Returns a list: an empty list on success or a list of errors.
2143
2144 =cut
2145
2146 sub suspend_unless_pkgpart {
2147   my $self = shift;
2148   my (@pkgparts, %opt);
2149   if (ref($_[0]) eq 'HASH'){
2150     @pkgparts = @{$_[0]{pkgparts}};
2151     %opt      = %{$_[0]};
2152   }else{
2153     @pkgparts = @_;
2154   }
2155   grep { $_->suspend(%opt) }
2156     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2157       $self->unsuspended_pkgs;
2158 }
2159
2160 =item cancel [ OPTION => VALUE ... ]
2161
2162 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2163 The cancellation time will be now.
2164
2165 =back
2166
2167 Always returns a list: an empty list on success or a list of errors.
2168
2169 =cut
2170
2171 sub cancel {
2172   my $self = shift;
2173   my %opt = @_;
2174   warn "$me cancel called on customer ". $self->custnum. " with options ".
2175        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2176     if $DEBUG;
2177   my @pkgs = $self->ncancelled_pkgs;
2178
2179   $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2180 }
2181
2182 =item cancel_pkgs OPTIONS
2183
2184 Cancels a specified list of packages. OPTIONS can include:
2185
2186 =over 4
2187
2188 =item cust_pkg - an arrayref of the packages. Required.
2189
2190 =item time - the cancellation time, used to calculate final bills and
2191 unused-time credits if any. Will be passed through to the bill() and
2192 FS::cust_pkg::cancel() methods.
2193
2194 =item quiet - can be set true to supress email cancellation notices.
2195
2196 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2197 reasonnum of an existing reason, or passing a hashref will create a new reason.
2198 The hashref should have the following keys:
2199 typenum - Reason type (see L<FS::reason_type>)
2200 reason - Text of the new reason.
2201
2202 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2203 for the individual packages, parallel to the C<cust_pkg> argument. The
2204 reason and reason_otaker arguments will be taken from those objects.
2205
2206 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2207
2208 =item nobill - can be set true to skip billing if it might otherwise be done.
2209
2210 =cut
2211
2212 sub cancel_pkgs {
2213   my( $self, %opt ) = @_;
2214
2215   # we're going to cancel services, which is not reversible
2216   #   unless exports are suppressed
2217   die "cancel_pkgs cannot be run inside a transaction"
2218     if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
2219
2220   my $oldAutoCommit = $FS::UID::AutoCommit;
2221   local $FS::UID::AutoCommit = 0;
2222
2223   savepoint_create('cancel_pkgs');
2224
2225   return ( 'access denied' )
2226     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2227
2228   if ( $opt{'ban'} ) {
2229
2230     foreach my $cust_payby ( $self->cust_payby ) {
2231
2232       #well, if they didn't get decrypted on search, then we don't have to 
2233       # try again... queue a job for the server that does have decryption
2234       # capability if we're in a paranoid multi-server implementation?
2235       return ( "Can't (yet) ban encrypted credit cards" )
2236         if $cust_payby->is_encrypted($cust_payby->payinfo);
2237
2238       my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2239       my $error = $ban->insert;
2240       if ($error) {
2241         savepoint_rollback_and_release('cancel_pkgs');
2242         dbh->rollback if $oldAutoCommit;
2243         return ( $error );
2244       }
2245
2246     }
2247
2248   }
2249
2250   my @pkgs = @{ delete $opt{'cust_pkg'} };
2251   my $cancel_time = $opt{'time'} || time;
2252
2253   # bill all packages first, so we don't lose usage, service counts for
2254   # bulk billing, etc.
2255   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2256     $opt{nobill} = 1;
2257     my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2258                              'cancel'   => 1,
2259                              'time'     => $cancel_time );
2260     if ($error) {
2261       warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2262       savepoint_rollback_and_release('cancel_pkgs');
2263       dbh->rollback if $oldAutoCommit;
2264       return ( "Error billing during cancellation: $error" );
2265     }
2266   }
2267   savepoint_release('cancel_pkgs');
2268   dbh->commit if $oldAutoCommit;
2269
2270   my @errors;
2271   # try to cancel each service, the same way we would for individual packages,
2272   # but in cancel weight order.
2273   my @cust_svc = map { $_->cust_svc } @pkgs;
2274   my @sorted_cust_svc =
2275     map  { $_->[0] }
2276     sort { $a->[1] <=> $b->[1] }
2277     map  { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2278   ;
2279   warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2280     $self->custnum."\n"
2281     if $DEBUG;
2282   my $i = 0;
2283   foreach my $cust_svc (@sorted_cust_svc) {
2284     my $savepoint = 'cancel_pkgs_'.$i++;
2285     savepoint_create( $savepoint );
2286     my $part_svc = $cust_svc->part_svc;
2287     next if ( defined($part_svc) and $part_svc->preserve );
2288     # immediate cancel, no date option
2289     # transactionize individually
2290     my $error = try { $cust_svc->cancel } catch { $_ };
2291     if ( $error ) {
2292       savepoint_rollback_and_release( $savepoint );
2293       dbh->rollback if $oldAutoCommit;
2294       push @errors, $error;
2295     } else {
2296       savepoint_release( $savepoint );
2297       dbh->commit if $oldAutoCommit;
2298     }
2299   }
2300   if (@errors) {
2301     return @errors;
2302   }
2303
2304   warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2305     $self->custnum. "\n"
2306     if $DEBUG;
2307
2308   my @cprs;
2309   if ($opt{'cust_pkg_reason'}) {
2310     @cprs = @{ delete $opt{'cust_pkg_reason'} };
2311   }
2312   my $null_reason;
2313   $i = 0;
2314   foreach (@pkgs) {
2315     my %lopt = %opt;
2316     my $savepoint = 'cancel_pkgs_'.$i++;
2317     savepoint_create( $savepoint );
2318     if (@cprs) {
2319       my $cpr = shift @cprs;
2320       if ( $cpr ) {
2321         $lopt{'reason'}        = $cpr->reasonnum;
2322         $lopt{'reason_otaker'} = $cpr->otaker;
2323       } else {
2324         warn "no reason found when canceling package ".$_->pkgnum."\n";
2325         # we're not actually required to pass a reason to cust_pkg::cancel,
2326         # but if we're getting to this point, something has gone awry.
2327         $null_reason ||= FS::reason->new_or_existing(
2328           reason  => 'unknown reason',
2329           type    => 'Cancel Reason',
2330           class   => 'C',
2331         );
2332         $lopt{'reason'} = $null_reason->reasonnum;
2333         $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2334       }
2335     }
2336     my $error = $_->cancel(%lopt);
2337     if ( $error ) {
2338       savepoint_rollback_and_release( $savepoint );
2339       dbh->rollback if $oldAutoCommit;
2340       push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2341     } else {
2342       savepoint_release( $savepoint );
2343       dbh->commit if $oldAutoCommit;
2344     }
2345   }
2346
2347   return @errors;
2348 }
2349
2350 sub _banned_pay_hashref {
2351   die 'cust_main->_banned_pay_hashref deprecated';
2352
2353   my $self = shift;
2354
2355   my %payby2ban = (
2356     'CARD' => 'CARD',
2357     'DCRD' => 'CARD',
2358     'CHEK' => 'CHEK',
2359     'DCHK' => 'CHEK'
2360   );
2361
2362   {
2363     'payby'   => $payby2ban{$self->payby},
2364     'payinfo' => $self->payinfo,
2365     #don't ever *search* on reason! #'reason'  =>
2366   };
2367 }
2368
2369 =item notes
2370
2371 Returns all notes (see L<FS::cust_main_note>) for this customer.
2372
2373 =cut
2374
2375 sub notes {
2376   my($self,$orderby_classnum) = (shift,shift);
2377   my $orderby = "sticky DESC, _date DESC";
2378   $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2379   qsearch( 'cust_main_note',
2380            { 'custnum' => $self->custnum },
2381            '',
2382            "ORDER BY $orderby",
2383          );
2384 }
2385
2386 =item agent
2387
2388 Returns the agent (see L<FS::agent>) for this customer.
2389
2390 =item agent_name
2391
2392 Returns the agent name (see L<FS::agent>) for this customer.
2393
2394 =cut
2395
2396 sub agent_name {
2397   my $self = shift;
2398   $self->agent->agent;
2399 }
2400
2401 =item cust_tag
2402
2403 Returns any tags associated with this customer, as FS::cust_tag objects,
2404 or an empty list if there are no tags.
2405
2406 =item part_tag
2407
2408 Returns any tags associated with this customer, as FS::part_tag objects,
2409 or an empty list if there are no tags.
2410
2411 =cut
2412
2413 sub part_tag {
2414   my $self = shift;
2415   map $_->part_tag, $self->cust_tag; 
2416 }
2417
2418
2419 =item cust_class
2420
2421 Returns the customer class, as an FS::cust_class object, or the empty string
2422 if there is no customer class.
2423
2424 =item categoryname 
2425
2426 Returns the customer category name, or the empty string if there is no customer
2427 category.
2428
2429 =cut
2430
2431 sub categoryname {
2432   my $self = shift;
2433   my $cust_class = $self->cust_class;
2434   $cust_class
2435     ? $cust_class->categoryname
2436     : '';
2437 }
2438
2439 =item classname 
2440
2441 Returns the customer class name, or the empty string if there is no customer
2442 class.
2443
2444 =cut
2445
2446 sub classname {
2447   my $self = shift;
2448   my $cust_class = $self->cust_class;
2449   $cust_class
2450     ? $cust_class->classname
2451     : '';
2452 }
2453
2454 =item tax_status
2455
2456 Returns the external tax status, as an FS::tax_status object, or the empty 
2457 string if there is no tax status.
2458
2459 =cut
2460
2461 sub tax_status {
2462   my $self = shift;
2463   if ( $self->taxstatusnum ) {
2464     qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2465   } else {
2466     return '';
2467   } 
2468 }
2469
2470 =item taxstatus
2471
2472 Returns the tax status code if there is one.
2473
2474 =cut
2475
2476 sub taxstatus {
2477   my $self = shift;
2478   my $tax_status = $self->tax_status;
2479   $tax_status
2480     ? $tax_status->taxstatus
2481     : '';
2482 }
2483
2484 =item BILLING METHODS
2485
2486 Documentation on billing methods has been moved to
2487 L<FS::cust_main::Billing>.
2488
2489 =item REALTIME BILLING METHODS
2490
2491 Documentation on realtime billing methods has been moved to
2492 L<FS::cust_main::Billing_Realtime>.
2493
2494 =item remove_cvv
2495
2496 Removes the I<paycvv> field from the database directly.
2497
2498 If there is an error, returns the error, otherwise returns false.
2499
2500 DEPRECATED.  Use L</remove_cvv_from_cust_payby> instead.
2501
2502 =cut
2503
2504 sub remove_cvv {
2505   die 'cust_main->remove_cvv deprecated';
2506   my $self = shift;
2507   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2508     or return dbh->errstr;
2509   $sth->execute($self->custnum)
2510     or return $sth->errstr;
2511   $self->paycvv('');
2512   '';
2513 }
2514
2515 =item total_owed
2516
2517 Returns the total owed for this customer on all invoices
2518 (see L<FS::cust_bill/owed>).
2519
2520 =cut
2521
2522 sub total_owed {
2523   my $self = shift;
2524   $self->total_owed_date(2145859200); #12/31/2037
2525 }
2526
2527 =item total_owed_date TIME
2528
2529 Returns the total owed for this customer on all invoices with date earlier than
2530 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2531 see L<Time::Local> and L<Date::Parse> for conversion functions.
2532
2533 =cut
2534
2535 sub total_owed_date {
2536   my $self = shift;
2537   my $time = shift;
2538
2539   my $custnum = $self->custnum;
2540
2541   my $owed_sql = FS::cust_bill->owed_sql;
2542
2543   my $sql = "
2544     SELECT SUM($owed_sql) FROM cust_bill
2545       WHERE custnum = $custnum
2546         AND _date <= $time
2547   ";
2548
2549   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2550
2551 }
2552
2553 =item total_owed_pkgnum PKGNUM
2554
2555 Returns the total owed on all invoices for this customer's specific package
2556 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2557
2558 =cut
2559
2560 sub total_owed_pkgnum {
2561   my( $self, $pkgnum ) = @_;
2562   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2563 }
2564
2565 =item total_owed_date_pkgnum TIME PKGNUM
2566
2567 Returns the total owed for this customer's specific package when using
2568 experimental package balances on all invoices with date earlier than
2569 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2570 see L<Time::Local> and L<Date::Parse> for conversion functions.
2571
2572 =cut
2573
2574 sub total_owed_date_pkgnum {
2575   my( $self, $time, $pkgnum ) = @_;
2576
2577   my $total_bill = 0;
2578   foreach my $cust_bill (
2579     grep { $_->_date <= $time }
2580       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2581   ) {
2582     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2583   }
2584   sprintf( "%.2f", $total_bill );
2585
2586 }
2587
2588 =item total_paid
2589
2590 Returns the total amount of all payments.
2591
2592 =cut
2593
2594 sub total_paid {
2595   my $self = shift;
2596   my $total = 0;
2597   $total += $_->paid foreach $self->cust_pay;
2598   sprintf( "%.2f", $total );
2599 }
2600
2601 =item total_unapplied_credits
2602
2603 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2604 customer.  See L<FS::cust_credit/credited>.
2605
2606 =item total_credited
2607
2608 Old name for total_unapplied_credits.  Don't use.
2609
2610 =cut
2611
2612 sub total_credited {
2613   #carp "total_credited deprecated, use total_unapplied_credits";
2614   shift->total_unapplied_credits(@_);
2615 }
2616
2617 sub total_unapplied_credits {
2618   my $self = shift;
2619
2620   my $custnum = $self->custnum;
2621
2622   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2623
2624   my $sql = "
2625     SELECT SUM($unapplied_sql) FROM cust_credit
2626       WHERE custnum = $custnum
2627   ";
2628
2629   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2630
2631 }
2632
2633 =item total_unapplied_credits_pkgnum PKGNUM
2634
2635 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2636 customer.  See L<FS::cust_credit/credited>.
2637
2638 =cut
2639
2640 sub total_unapplied_credits_pkgnum {
2641   my( $self, $pkgnum ) = @_;
2642   my $total_credit = 0;
2643   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2644   sprintf( "%.2f", $total_credit );
2645 }
2646
2647
2648 =item total_unapplied_payments
2649
2650 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2651 See L<FS::cust_pay/unapplied>.
2652
2653 =cut
2654
2655 sub total_unapplied_payments {
2656   my $self = shift;
2657
2658   my $custnum = $self->custnum;
2659
2660   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2661
2662   my $sql = "
2663     SELECT SUM($unapplied_sql) FROM cust_pay
2664       WHERE custnum = $custnum
2665   ";
2666
2667   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2668
2669 }
2670
2671 =item total_unapplied_payments_pkgnum PKGNUM
2672
2673 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2674 specific package when using experimental package balances.  See
2675 L<FS::cust_pay/unapplied>.
2676
2677 =cut
2678
2679 sub total_unapplied_payments_pkgnum {
2680   my( $self, $pkgnum ) = @_;
2681   my $total_unapplied = 0;
2682   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2683   sprintf( "%.2f", $total_unapplied );
2684 }
2685
2686
2687 =item total_unapplied_refunds
2688
2689 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2690 customer.  See L<FS::cust_refund/unapplied>.
2691
2692 =cut
2693
2694 sub total_unapplied_refunds {
2695   my $self = shift;
2696   my $custnum = $self->custnum;
2697
2698   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2699
2700   my $sql = "
2701     SELECT SUM($unapplied_sql) FROM cust_refund
2702       WHERE custnum = $custnum
2703   ";
2704
2705   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2706
2707 }
2708
2709 =item balance
2710
2711 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2712 total_unapplied_credits minus total_unapplied_payments).
2713
2714 =cut
2715
2716 sub balance {
2717   my $self = shift;
2718   $self->balance_date_range;
2719 }
2720
2721 =item balance_date TIME
2722
2723 Returns the balance for this customer, only considering invoices with date
2724 earlier than TIME (total_owed_date minus total_credited minus
2725 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2726 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2727 functions.
2728
2729 =cut
2730
2731 sub balance_date {
2732   my $self = shift;
2733   $self->balance_date_range(shift);
2734 }
2735
2736 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2737
2738 Returns the balance for this customer, optionally considering invoices with
2739 date earlier than START_TIME, and not later than END_TIME
2740 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2741
2742 Times are specified as SQL fragments or numeric
2743 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2744 L<Date::Parse> for conversion functions.  The empty string can be passed
2745 to disable that time constraint completely.
2746
2747 Accepts the same options as L<balance_date_sql>:
2748
2749 =over 4
2750
2751 =item unapplied_date
2752
2753 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)
2754
2755 =item cutoff
2756
2757 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this 
2758 time will be ignored.  Note that START_TIME and END_TIME only limit the date 
2759 range for invoices and I<unapplied> payments, credits, and refunds.
2760
2761 =back
2762
2763 =cut
2764
2765 sub balance_date_range {
2766   my $self = shift;
2767   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2768             ') FROM cust_main WHERE custnum='. $self->custnum;
2769   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2770 }
2771
2772 =item balance_pkgnum PKGNUM
2773
2774 Returns the balance for this customer's specific package when using
2775 experimental package balances (total_owed plus total_unrefunded, minus
2776 total_unapplied_credits minus total_unapplied_payments)
2777
2778 =cut
2779
2780 sub balance_pkgnum {
2781   my( $self, $pkgnum ) = @_;
2782
2783   sprintf( "%.2f",
2784       $self->total_owed_pkgnum($pkgnum)
2785 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2786 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2787     - $self->total_unapplied_credits_pkgnum($pkgnum)
2788     - $self->total_unapplied_payments_pkgnum($pkgnum)
2789   );
2790 }
2791
2792 =item payment_info
2793
2794 Returns a hash of useful information for making a payment.
2795
2796 =over 4
2797
2798 =item balance
2799
2800 Current balance.
2801
2802 =item payby
2803
2804 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2805 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2806 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2807
2808 =back
2809
2810 For credit card transactions:
2811
2812 =over 4
2813
2814 =item card_type 1
2815
2816 =item payname
2817
2818 Exact name on card
2819
2820 =back
2821
2822 For electronic check transactions:
2823
2824 =over 4
2825
2826 =item stateid_state
2827
2828 =back
2829
2830 =cut
2831
2832 #XXX i need to be updated for 4.x+
2833 sub payment_info {
2834   my $self = shift;
2835
2836   my %return = ();
2837
2838   $return{balance} = $self->balance;
2839
2840   $return{payname} = $self->payname
2841                      || ( $self->first. ' '. $self->get('last') );
2842
2843   $return{$_} = $self->bill_location->$_
2844     for qw(address1 address2 city state zip);
2845
2846   $return{payby} = $self->payby;
2847   $return{stateid_state} = $self->stateid_state;
2848
2849   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2850     $return{card_type} = cardtype($self->payinfo);
2851     $return{payinfo} = $self->paymask;
2852
2853     @return{'month', 'year'} = $self->paydate_monthyear;
2854
2855   }
2856
2857   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2858     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2859     $return{payinfo1} = $payinfo1;
2860     $return{payinfo2} = $payinfo2;
2861     $return{paytype}  = $self->paytype;
2862     $return{paystate} = $self->paystate;
2863
2864   }
2865
2866   #doubleclick protection
2867   my $_date = time;
2868   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2869
2870   %return;
2871
2872 }
2873
2874 =item paydate_epoch
2875
2876 Returns the next payment expiration date for this customer. If they have no
2877 payment methods that will expire, returns 0.
2878
2879 =cut
2880
2881 sub paydate_epoch {
2882   my $self = shift;
2883   # filter out the ones that individually return 0, but then return 0 if
2884   # there are no results
2885   my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
2886   min( @epochs ) || 0;
2887 }
2888
2889 =item paydate_epoch_sql
2890
2891 Returns an SQL expression to get the next payment expiration date for a
2892 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
2893 dates, so that it's safe to test for "will it expire before date X" for any
2894 date up to then.
2895
2896 =cut
2897
2898 sub paydate_epoch_sql {
2899   my $class = shift;
2900   my $paydate = FS::cust_payby->paydate_epoch_sql;
2901   "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
2902 }
2903
2904 sub tax_exemption {
2905   my( $self, $taxname ) = @_;
2906
2907   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2908                                      'taxname' => $taxname,
2909                                    },
2910           );
2911 }
2912
2913 =item cust_main_exemption
2914
2915 =item invoicing_list
2916
2917 Returns a list of email addresses (with svcnum entries expanded), and the word
2918 'POST' if the customer receives postal invoices.
2919
2920 =cut
2921
2922 sub invoicing_list {
2923   my( $self, $arrayref ) = @_;
2924
2925   if ( $arrayref ) {
2926     warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2927   }
2928   
2929   my @emails = $self->invoicing_list_emailonly;
2930   push @emails, 'POST' if $self->get('postal_invoice');
2931
2932   @emails;
2933 }
2934
2935 =item check_invoicing_list ARRAYREF
2936
2937 Checks these arguements as valid input for the invoicing_list method.  If there
2938 is an error, returns the error, otherwise returns false.
2939
2940 =cut
2941
2942 sub check_invoicing_list {
2943   my( $self, $arrayref ) = @_;
2944
2945   foreach my $address ( @$arrayref ) {
2946
2947     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2948       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2949     }
2950
2951     my $cust_main_invoice = new FS::cust_main_invoice ( {
2952       'custnum' => $self->custnum,
2953       'dest'    => $address,
2954     } );
2955     my $error = $self->custnum
2956                 ? $cust_main_invoice->check
2957                 : $cust_main_invoice->checkdest
2958     ;
2959     return $error if $error;
2960
2961   }
2962
2963   return "Email address required"
2964     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2965     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2966
2967   '';
2968 }
2969
2970 =item all_emails
2971
2972 Returns the email addresses of all accounts provisioned for this customer.
2973
2974 =cut
2975
2976 sub all_emails {
2977   my $self = shift;
2978   my %list;
2979   foreach my $cust_pkg ( $self->all_pkgs ) {
2980     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2981     my @svc_acct =
2982       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2983         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2984           @cust_svc;
2985     $list{$_}=1 foreach map { $_->email } @svc_acct;
2986   }
2987   keys %list;
2988 }
2989
2990 =item invoicing_list_addpost
2991
2992 Adds postal invoicing to this customer.  If this customer is already configured
2993 to receive postal invoices, does nothing.
2994
2995 =cut
2996
2997 sub invoicing_list_addpost {
2998   my $self = shift;
2999   if ( $self->get('postal_invoice') eq '' ) {
3000     $self->set('postal_invoice', 'Y');
3001     my $error = $self->replace;
3002     warn $error if $error; # should fail harder, but this is traditional
3003   }
3004 }
3005
3006 =item invoicing_list_emailonly
3007
3008 Returns the list of email invoice recipients (invoicing_list without non-email
3009 destinations such as POST and FAX).
3010
3011 =cut
3012
3013 sub invoicing_list_emailonly {
3014   my $self = shift;
3015   warn "$me invoicing_list_emailonly called"
3016     if $DEBUG;
3017   return () if !$self->custnum; # not yet inserted
3018   return map { $_->emailaddress }
3019     qsearch({
3020         table     => 'cust_contact',
3021         select    => 'emailaddress',
3022         addl_from => ' JOIN contact USING (contactnum) '.
3023                      ' JOIN contact_email USING (contactnum)',
3024         hashref   => { 'custnum' => $self->custnum, },
3025         extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
3026     });
3027 }
3028
3029 =item invoicing_list_emailonly_scalar
3030
3031 Returns the list of email invoice recipients (invoicing_list without non-email
3032 destinations such as POST and FAX) as a comma-separated scalar.
3033
3034 =cut
3035
3036 sub invoicing_list_emailonly_scalar {
3037   my $self = shift;
3038   warn "$me invoicing_list_emailonly_scalar called"
3039     if $DEBUG;
3040   join(', ', $self->invoicing_list_emailonly);
3041 }
3042
3043 =item contact_list [ CLASSNUM, DEST_FLAG... ]
3044
3045 Returns a list of contacts (L<FS::contact> objects) for the customer.
3046
3047 If no arguments are given, returns all contacts for the customer.
3048
3049 Arguments may contain classnums.  When classnums are specified, only
3050 contacts with a matching cust_contact.classnum are returned.  When a
3051 classnum of 0 is given, contacts with a null classnum are also included.
3052
3053 Arguments may also contain the dest flag names 'invoice' or 'message'.
3054 If given, contacts who's invoice_dest and/or message_dest flags are
3055 not set to 'Y' will be excluded.
3056
3057 =cut
3058
3059 sub contact_list {
3060   my $self = shift;
3061   my $search = {
3062     table       => 'contact',
3063     select      => join(', ',(
3064                     'contact.*',
3065                     'cust_contact.invoice_dest',
3066                     'cust_contact.message_dest',
3067     )),
3068     addl_from   => ' JOIN cust_contact USING (contactnum)',
3069     extra_sql   => ' WHERE cust_contact.custnum = '.$self->custnum,
3070   };
3071
3072   # Bugfix notes:
3073   #   Calling methods were relying on this method to use invoice_dest to
3074   #   block e-mail messages.  Depending on parameters, this may or may not
3075   #   have actually happened.
3076   #
3077   #   The bug could cause this SQL to be used to filter e-mail addresses:
3078   #
3079   #   AND (
3080   #     cust_contact.classnums IN (1,2,3)
3081   #     OR cust_contact.invoice_dest = 'Y'
3082   #   )
3083   #
3084   #   improperly including everybody with the opt-in flag AND everybody
3085   #   in the contact classes
3086   #
3087   # Possibility to introduce new bugs:
3088   #   If callers of this method called it incorrectly, and didn't notice
3089   #   because it seemed to send the e-mails they wanted.
3090
3091   # WHERE ...
3092   # AND (
3093   #   (
3094   #     cust_contact.classnum IN (1,2,3)
3095   #     OR
3096   #     cust_contact.classnum IS NULL
3097   #   )
3098   #   AND (
3099   #     cust_contact.invoice_dest = 'Y'
3100   #     OR
3101   #     cust_contact.message_dest = 'Y'
3102   #   )
3103   # )
3104
3105   my @and_dest;
3106   my @or_classnum;
3107   my @classnums;
3108   for (@_) {
3109     if ($_ eq 'invoice' || $_ eq 'message') {
3110       push @and_dest, " cust_contact.${_}_dest = 'Y' ";
3111     } elsif ($_ eq '0') {
3112       push @or_classnum, ' cust_contact.classnum IS NULL ';
3113     } elsif ( /^\d+$/ ) {
3114       push @classnums, $_;
3115     } else {
3116       croak "bad classnum argument '$_'";
3117     }
3118   }
3119
3120   push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
3121     if @classnums;
3122
3123   if (@or_classnum || @and_dest) { # catch, no arguments given
3124     $search->{extra_sql} .= ' AND ( ';
3125
3126       if (@or_classnum) {
3127         $search->{extra_sql} .= ' ( ';
3128         $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
3129         $search->{extra_sql} .= ' ) ';
3130         $search->{extra_sql} .= ' AND ( ' if @and_dest;
3131       }
3132
3133       if (@and_dest) {
3134         $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
3135         $search->{extra_sql} .= ' ) ' if @or_classnum;
3136       }
3137
3138     $search->{extra_sql} .= ' ) ';
3139
3140     warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
3141   }
3142
3143   qsearch($search);
3144 }
3145
3146 =item contact_list_email [ CLASSNUM, ... ]
3147
3148 Same as L</contact_list>, but returns email destinations instead of contact
3149 objects.
3150
3151 =cut
3152
3153 sub contact_list_email {
3154   my $self = shift;
3155   my @contacts = $self->contact_list(@_);
3156   my @emails;
3157   foreach my $contact (@contacts) {
3158     foreach my $contact_email ($contact->contact_email) {
3159       push @emails,  Email::Address->new( $contact->firstlast,
3160                                           $contact_email->emailaddress
3161                      )->format;
3162     }
3163   }
3164   @emails;
3165 }
3166
3167 =item referral_custnum_cust_main
3168
3169 Returns the customer who referred this customer (or the empty string, if
3170 this customer was not referred).
3171
3172 Note the difference with referral_cust_main method: This method,
3173 referral_custnum_cust_main returns the single customer (if any) who referred
3174 this customer, while referral_cust_main returns an array of customers referred
3175 BY this customer.
3176
3177 =cut
3178
3179 sub referral_custnum_cust_main {
3180   my $self = shift;
3181   return '' unless $self->referral_custnum;
3182   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3183 }
3184
3185 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3186
3187 Returns an array of customers referred by this customer (referral_custnum set
3188 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3189 customers referred by customers referred by this customer and so on, inclusive.
3190 The default behavior is DEPTH 1 (no recursion).
3191
3192 Note the difference with referral_custnum_cust_main method: This method,
3193 referral_cust_main, returns an array of customers referred BY this customer,
3194 while referral_custnum_cust_main returns the single customer (if any) who
3195 referred this customer.
3196
3197 =cut
3198
3199 sub referral_cust_main {
3200   my $self = shift;
3201   my $depth = @_ ? shift : 1;
3202   my $exclude = @_ ? shift : {};
3203
3204   my @cust_main =
3205     map { $exclude->{$_->custnum}++; $_; }
3206       grep { ! $exclude->{ $_->custnum } }
3207         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3208
3209   if ( $depth > 1 ) {
3210     push @cust_main,
3211       map { $_->referral_cust_main($depth-1, $exclude) }
3212         @cust_main;
3213   }
3214
3215   @cust_main;
3216 }
3217
3218 =item referral_cust_main_ncancelled
3219
3220 Same as referral_cust_main, except only returns customers with uncancelled
3221 packages.
3222
3223 =cut
3224
3225 sub referral_cust_main_ncancelled {
3226   my $self = shift;
3227   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3228 }
3229
3230 =item referral_cust_pkg [ DEPTH ]
3231
3232 Like referral_cust_main, except returns a flat list of all unsuspended (and
3233 uncancelled) packages for each customer.  The number of items in this list may
3234 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3235
3236 =cut
3237
3238 sub referral_cust_pkg {
3239   my $self = shift;
3240   my $depth = @_ ? shift : 1;
3241
3242   map { $_->unsuspended_pkgs }
3243     grep { $_->unsuspended_pkgs }
3244       $self->referral_cust_main($depth);
3245 }
3246
3247 =item referring_cust_main
3248
3249 Returns the single cust_main record for the customer who referred this customer
3250 (referral_custnum), or false.
3251
3252 =cut
3253
3254 sub referring_cust_main {
3255   my $self = shift;
3256   return '' unless $self->referral_custnum;
3257   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3258 }
3259
3260 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3261
3262 Applies a credit to this customer.  If there is an error, returns the error,
3263 otherwise returns false.
3264
3265 REASON can be a text string, an FS::reason object, or a scalar reference to
3266 a reasonnum.  If a text string, it will be automatically inserted as a new
3267 reason, and a 'reason_type' option must be passed to indicate the
3268 FS::reason_type for the new reason.
3269
3270 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3271 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3272 I<commission_pkgnum>.
3273
3274 Any other options are passed to FS::cust_credit::insert.
3275
3276 =cut
3277
3278 sub credit {
3279   my( $self, $amount, $reason, %options ) = @_;
3280
3281   my $cust_credit = new FS::cust_credit {
3282     'custnum' => $self->custnum,
3283     'amount'  => $amount,
3284   };
3285
3286   if ( ref($reason) ) {
3287
3288     if ( ref($reason) eq 'SCALAR' ) {
3289       $cust_credit->reasonnum( $$reason );
3290     } else {
3291       $cust_credit->reasonnum( $reason->reasonnum );
3292     }
3293
3294   } else {
3295     $cust_credit->set('reason', $reason)
3296   }
3297
3298   $cust_credit->$_( delete $options{$_} )
3299     foreach grep exists($options{$_}),
3300               qw( addlinfo eventnum ),
3301               map "commission_$_", qw( agentnum salesnum pkgnum );
3302
3303   $cust_credit->insert(%options);
3304
3305 }
3306
3307 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3308
3309 Creates a one-time charge for this customer.  If there is an error, returns
3310 the error, otherwise returns false.
3311
3312 New-style, with a hashref of options:
3313
3314   my $error = $cust_main->charge(
3315                                   {
3316                                     'amount'     => 54.32,
3317                                     'quantity'   => 1,
3318                                     'start_date' => str2time('7/4/2009'),
3319                                     'pkg'        => 'Description',
3320                                     'comment'    => 'Comment',
3321                                     'additional' => [], #extra invoice detail
3322                                     'classnum'   => 1,  #pkg_class
3323
3324                                     'setuptax'   => '', # or 'Y' for tax exempt
3325
3326                                     'locationnum'=> 1234, # optional
3327
3328                                     #internal taxation
3329                                     'taxclass'   => 'Tax class',
3330
3331                                     #vendor taxation
3332                                     'taxproduct' => 2,  #part_pkg_taxproduct
3333                                     'override'   => {}, #XXX describe
3334
3335                                     #will be filled in with the new object
3336                                     'cust_pkg_ref' => \$cust_pkg,
3337
3338                                     #generate an invoice immediately
3339                                     'bill_now' => 0,
3340                                     'invoice_terms' => '', #with these terms
3341                                   }
3342                                 );
3343
3344 Old-style:
3345
3346   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3347
3348 =cut
3349
3350 #super false laziness w/quotation::charge
3351 sub charge {
3352   my $self = shift;
3353   my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3354   my ( $pkg, $comment, $additional );
3355   my ( $setuptax, $taxclass );   #internal taxes
3356   my ( $taxproduct, $override ); #vendor (CCH) taxes
3357   my $no_auto = '';
3358   my $separate_bill = '';
3359   my $cust_pkg_ref = '';
3360   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3361   my $locationnum;
3362   my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3363   if ( ref( $_[0] ) ) {
3364     $amount     = $_[0]->{amount};
3365     $setup_cost = $_[0]->{setup_cost};
3366     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3367     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3368     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3369     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3370     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3371                                            : '$'. sprintf("%.2f",$amount);
3372     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3373     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3374     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3375     $additional = $_[0]->{additional} || [];
3376     $taxproduct = $_[0]->{taxproductnum};
3377     $override   = { '' => $_[0]->{tax_override} };
3378     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3379     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3380     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3381     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3382     $separate_bill = $_[0]->{separate_bill} || '';
3383     $discountnum = $_[0]->{setup_discountnum};
3384     $discountnum_amount = $_[0]->{setup_discountnum_amount};
3385     $discountnum_percent = $_[0]->{setup_discountnum_percent};
3386   } else { # yuck
3387     $amount     = shift;
3388     $setup_cost = '';
3389     $quantity   = 1;
3390     $start_date = '';
3391     $pkg        = @_ ? shift : 'One-time charge';
3392     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3393     $setuptax   = '';
3394     $taxclass   = @_ ? shift : '';
3395     $additional = [];
3396   }
3397
3398   local $SIG{HUP} = 'IGNORE';
3399   local $SIG{INT} = 'IGNORE';
3400   local $SIG{QUIT} = 'IGNORE';
3401   local $SIG{TERM} = 'IGNORE';
3402   local $SIG{TSTP} = 'IGNORE';
3403   local $SIG{PIPE} = 'IGNORE';
3404
3405   my $oldAutoCommit = $FS::UID::AutoCommit;
3406   local $FS::UID::AutoCommit = 0;
3407   my $dbh = dbh;
3408
3409   my $part_pkg = new FS::part_pkg ( {
3410     'pkg'           => $pkg,
3411     'comment'       => $comment,
3412     'plan'          => 'flat',
3413     'freq'          => 0,
3414     'disabled'      => 'Y',
3415     'classnum'      => ( $classnum ? $classnum : '' ),
3416     'setuptax'      => $setuptax,
3417     'taxclass'      => $taxclass,
3418     'taxproductnum' => $taxproduct,
3419     'setup_cost'    => $setup_cost,
3420   } );
3421
3422   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3423                         ( 0 .. @$additional - 1 )
3424                   ),
3425                   'additional_count' => scalar(@$additional),
3426                   'setup_fee' => $amount,
3427                 );
3428
3429   my $error = $part_pkg->insert( options       => \%options,
3430                                  tax_overrides => $override,
3431                                );
3432   if ( $error ) {
3433     $dbh->rollback if $oldAutoCommit;
3434     return $error;
3435   }
3436
3437   my $pkgpart = $part_pkg->pkgpart;
3438   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3439   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3440     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3441     $error = $type_pkgs->insert;
3442     if ( $error ) {
3443       $dbh->rollback if $oldAutoCommit;
3444       return $error;
3445     }
3446   }
3447
3448   my $cust_pkg = new FS::cust_pkg ( {
3449     'custnum'                   => $self->custnum,
3450     'pkgpart'                   => $pkgpart,
3451     'quantity'                  => $quantity,
3452     'start_date'                => $start_date,
3453     'no_auto'                   => $no_auto,
3454     'separate_bill'             => $separate_bill,
3455     'locationnum'               => $locationnum,
3456     'setup_discountnum'         => $discountnum,
3457     'setup_discountnum_amount'  => $discountnum_amount,
3458     'setup_discountnum_percent' => $discountnum_percent,
3459   } );
3460
3461   $error = $cust_pkg->insert;
3462   if ( $error ) {
3463     $dbh->rollback if $oldAutoCommit;
3464     return $error;
3465   } elsif ( $cust_pkg_ref ) {
3466     ${$cust_pkg_ref} = $cust_pkg;
3467   }
3468
3469   if ( $bill_now ) {
3470     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3471                              'pkg_list'      => [ $cust_pkg ],
3472                            );
3473     if ( $error ) {
3474       $dbh->rollback if $oldAutoCommit;
3475       return $error;
3476     }   
3477   }
3478
3479   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3480   return '';
3481
3482 }
3483
3484 #=item charge_postal_fee
3485 #
3486 #Applies a one time charge this customer.  If there is an error,
3487 #returns the error, returns the cust_pkg charge object or false
3488 #if there was no charge.
3489 #
3490 #=cut
3491 #
3492 # This should be a customer event.  For that to work requires that bill
3493 # also be a customer event.
3494
3495 sub charge_postal_fee {
3496   my $self = shift;
3497
3498   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3499   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3500
3501   my $cust_pkg = new FS::cust_pkg ( {
3502     'custnum'  => $self->custnum,
3503     'pkgpart'  => $pkgpart,
3504     'quantity' => 1,
3505   } );
3506
3507   my $error = $cust_pkg->insert;
3508   $error ? $error : $cust_pkg;
3509 }
3510
3511 =item num_cust_attachment_deleted
3512
3513 Returns the number of deleted attachments for this customer (see
3514 L<FS::num_cust_attachment>).
3515
3516 =cut
3517
3518 sub num_cust_attachments_deleted {
3519   my $self = shift;
3520   $self->scalar_sql(
3521     " SELECT COUNT(*) FROM cust_attachment ".
3522       " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3523     $self->custnum
3524   );
3525 }
3526
3527 =item max_invnum
3528
3529 Returns the most recent invnum (invoice number) for this customer.
3530
3531 =cut
3532
3533 sub max_invnum {
3534   my $self = shift;
3535   $self->scalar_sql(
3536     " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3537     $self->custnum
3538   );
3539 }
3540
3541 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3542
3543 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3544
3545 Optionally, a list or hashref of additional arguments to the qsearch call can
3546 be passed.
3547
3548 =cut
3549
3550 sub cust_bill {
3551   my $self = shift;
3552   my $opt = ref($_[0]) ? shift : { @_ };
3553
3554   #return $self->num_cust_bill unless wantarray || keys %$opt;
3555
3556   $opt->{'table'} = 'cust_bill';
3557   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3558   $opt->{'hashref'}{'custnum'} = $self->custnum;
3559   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3560
3561   map { $_ } #behavior of sort undefined in scalar context
3562     sort { $a->_date <=> $b->_date }
3563       qsearch($opt);
3564 }
3565
3566 =item open_cust_bill
3567
3568 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3569 customer.
3570
3571 =cut
3572
3573 sub open_cust_bill {
3574   my $self = shift;
3575
3576   $self->cust_bill(
3577     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3578     #@_
3579   );
3580
3581 }
3582
3583 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3584
3585 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3586
3587 =cut
3588
3589 sub legacy_cust_bill {
3590   my $self = shift;
3591
3592   #return $self->num_legacy_cust_bill unless wantarray;
3593
3594   map { $_ } #behavior of sort undefined in scalar context
3595     sort { $a->_date <=> $b->_date }
3596       qsearch({ 'table'    => 'legacy_cust_bill',
3597                 'hashref'  => { 'custnum' => $self->custnum, },
3598                 'order_by' => 'ORDER BY _date ASC',
3599              });
3600 }
3601
3602 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3603
3604 Returns all the statements (see L<FS::cust_statement>) for this customer.
3605
3606 Optionally, a list or hashref of additional arguments to the qsearch call can
3607 be passed.
3608
3609 =cut
3610
3611 =item cust_bill_void
3612
3613 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3614
3615 =cut
3616
3617 sub cust_bill_void {
3618   my $self = shift;
3619
3620   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3621   sort { $a->_date <=> $b->_date }
3622     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3623 }
3624
3625 sub cust_statement {
3626   my $self = shift;
3627   my $opt = ref($_[0]) ? shift : { @_ };
3628
3629   #return $self->num_cust_statement unless wantarray || keys %$opt;
3630
3631   $opt->{'table'} = 'cust_statement';
3632   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3633   $opt->{'hashref'}{'custnum'} = $self->custnum;
3634   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3635
3636   map { $_ } #behavior of sort undefined in scalar context
3637     sort { $a->_date <=> $b->_date }
3638       qsearch($opt);
3639 }
3640
3641 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3642
3643 Returns all services of type SVCDB (such as 'svc_acct') for this customer.  
3644
3645 Optionally, a list or hashref of additional arguments to the qsearch call can 
3646 be passed following the SVCDB.
3647
3648 =cut
3649
3650 sub svc_x {
3651   my $self = shift;
3652   my $svcdb = shift;
3653   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3654     warn "$me svc_x requires a svcdb";
3655     return;
3656   }
3657   my $opt = ref($_[0]) ? shift : { @_ };
3658
3659   $opt->{'table'} = $svcdb;
3660   $opt->{'addl_from'} = 
3661     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3662     ($opt->{'addl_from'} || '');
3663
3664   my $custnum = $self->custnum;
3665   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3666   my $where = "cust_pkg.custnum = $custnum";
3667
3668   my $extra_sql = $opt->{'extra_sql'} || '';
3669   if ( keys %{ $opt->{'hashref'} } ) {
3670     $extra_sql = " AND $where $extra_sql";
3671   }
3672   else {
3673     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3674       $extra_sql = "WHERE $where AND $1";
3675     }
3676     else {
3677       $extra_sql = "WHERE $where $extra_sql";
3678     }
3679   }
3680   $opt->{'extra_sql'} = $extra_sql;
3681
3682   qsearch($opt);
3683 }
3684
3685 # required for use as an eventtable; 
3686 sub svc_acct {
3687   my $self = shift;
3688   $self->svc_x('svc_acct', @_);
3689 }
3690
3691 =item cust_credit
3692
3693 Returns all the credits (see L<FS::cust_credit>) for this customer.
3694
3695 =cut
3696
3697 sub cust_credit {
3698   my $self = shift;
3699
3700   #return $self->num_cust_credit unless wantarray;
3701
3702   map { $_ } #behavior of sort undefined in scalar context
3703     sort { $a->_date <=> $b->_date }
3704       qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3705 }
3706
3707 =item cust_credit_pkgnum
3708
3709 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3710 package when using experimental package balances.
3711
3712 =cut
3713
3714 sub cust_credit_pkgnum {
3715   my( $self, $pkgnum ) = @_;
3716   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3717   sort { $a->_date <=> $b->_date }
3718     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3719                               'pkgnum'  => $pkgnum,
3720                             }
3721     );
3722 }
3723
3724 =item cust_credit_void
3725
3726 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3727
3728 =cut
3729
3730 sub cust_credit_void {
3731   my $self = shift;
3732   map { $_ }
3733   sort { $a->_date <=> $b->_date }
3734     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3735 }
3736
3737 =item cust_pay
3738
3739 Returns all the payments (see L<FS::cust_pay>) for this customer.
3740
3741 =cut
3742
3743 sub cust_pay {
3744   my $self = shift;
3745   my $opt = ref($_[0]) ? shift : { @_ };
3746
3747   return $self->num_cust_pay unless wantarray || keys %$opt;
3748
3749   $opt->{'table'} = 'cust_pay';
3750   $opt->{'hashref'}{'custnum'} = $self->custnum;
3751
3752   map { $_ } #behavior of sort undefined in scalar context
3753     sort { $a->_date <=> $b->_date }
3754       qsearch($opt);
3755
3756 }
3757
3758 =item num_cust_pay
3759
3760 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3761 called automatically when the cust_pay method is used in a scalar context.
3762
3763 =cut
3764
3765 sub num_cust_pay {
3766   my $self = shift;
3767   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3768   my $sth = dbh->prepare($sql) or die dbh->errstr;
3769   $sth->execute($self->custnum) or die $sth->errstr;
3770   $sth->fetchrow_arrayref->[0];
3771 }
3772
3773 =item unapplied_cust_pay
3774
3775 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3776
3777 =cut
3778
3779 sub unapplied_cust_pay {
3780   my $self = shift;
3781
3782   $self->cust_pay(
3783     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3784     #@_
3785   );
3786
3787 }
3788
3789 =item cust_pay_pkgnum
3790
3791 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3792 package when using experimental package balances.
3793
3794 =cut
3795
3796 sub cust_pay_pkgnum {
3797   my( $self, $pkgnum ) = @_;
3798   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3799   sort { $a->_date <=> $b->_date }
3800     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3801                            'pkgnum'  => $pkgnum,
3802                          }
3803     );
3804 }
3805
3806 =item cust_pay_void
3807
3808 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3809
3810 =cut
3811
3812 sub cust_pay_void {
3813   my $self = shift;
3814   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3815   sort { $a->_date <=> $b->_date }
3816     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3817 }
3818
3819 =item cust_pay_pending
3820
3821 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3822 (without status "done").
3823
3824 =cut
3825
3826 sub cust_pay_pending {
3827   my $self = shift;
3828   return $self->num_cust_pay_pending unless wantarray;
3829   sort { $a->_date <=> $b->_date }
3830     qsearch( 'cust_pay_pending', {
3831                                    'custnum' => $self->custnum,
3832                                    'status'  => { op=>'!=', value=>'done' },
3833                                  },
3834            );
3835 }
3836
3837 =item cust_pay_pending_attempt
3838
3839 Returns all payment attempts / declined payments for this customer, as pending
3840 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3841 a corresponding payment (see L<FS::cust_pay>).
3842
3843 =cut
3844
3845 sub cust_pay_pending_attempt {
3846   my $self = shift;
3847   return $self->num_cust_pay_pending_attempt unless wantarray;
3848   sort { $a->_date <=> $b->_date }
3849     qsearch( 'cust_pay_pending', {
3850                                    'custnum' => $self->custnum,
3851                                    'status'  => 'done',
3852                                    'paynum'  => '',
3853                                  },
3854            );
3855 }
3856
3857 =item num_cust_pay_pending
3858
3859 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3860 customer (without status "done").  Also called automatically when the
3861 cust_pay_pending method is used in a scalar context.
3862
3863 =cut
3864
3865 sub num_cust_pay_pending {
3866   my $self = shift;
3867   $self->scalar_sql(
3868     " SELECT COUNT(*) FROM cust_pay_pending ".
3869       " WHERE custnum = ? AND status != 'done' ",
3870     $self->custnum
3871   );
3872 }
3873
3874 =item num_cust_pay_pending_attempt
3875
3876 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3877 customer, with status "done" but without a corresp.  Also called automatically when the
3878 cust_pay_pending method is used in a scalar context.
3879
3880 =cut
3881
3882 sub num_cust_pay_pending_attempt {
3883   my $self = shift;
3884   $self->scalar_sql(
3885     " SELECT COUNT(*) FROM cust_pay_pending ".
3886       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3887     $self->custnum
3888   );
3889 }
3890
3891 =item cust_refund
3892
3893 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3894
3895 =cut
3896
3897 sub cust_refund {
3898   my $self = shift;
3899   map { $_ } #return $self->num_cust_refund unless wantarray;
3900   sort { $a->_date <=> $b->_date }
3901     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3902 }
3903
3904 =item display_custnum
3905
3906 Returns the displayed customer number for this customer: agent_custid if
3907 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3908
3909 =cut
3910
3911 sub display_custnum {
3912   my $self = shift;
3913
3914   return $self->agent_custid
3915     if $default_agent_custid && $self->agent_custid;
3916
3917   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3918
3919   if ( $prefix ) {
3920     return $prefix . 
3921            sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
3922   } elsif ( $custnum_display_length ) {
3923     return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
3924   } else {
3925     return $self->custnum;
3926   }
3927 }
3928
3929 =item name
3930
3931 Returns a name string for this customer, either "Company (Last, First)" or
3932 "Last, First".
3933
3934 =cut
3935
3936 sub name {
3937   my $self = shift;
3938   my $name = $self->contact;
3939   $name = $self->company. " ($name)" if $self->company;
3940   $name;
3941 }
3942
3943 =item batch_payment_payname
3944
3945 Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
3946 based on if a company name exists and is the account being used a business account.
3947
3948 =cut
3949
3950 sub batch_payment_payname {
3951   my $self = shift;
3952   my $cust_pay_batch = shift;
3953   my $name;
3954
3955   if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
3956   else { $name = $self->first .' '. $self->last; }
3957
3958   $name = $self->company
3959     if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
3960
3961   $name;
3962 }
3963
3964 =item service_contact
3965
3966 Returns the L<FS::contact> object for this customer that has the 'Service'
3967 contact class, or undef if there is no such contact.  Deprecated; don't use
3968 this in new code.
3969
3970 =cut
3971
3972 sub service_contact {
3973   my $self = shift;
3974   if ( !exists($self->{service_contact}) ) {
3975     my $classnum = $self->scalar_sql(
3976       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3977     ) || 0; #if it's zero, qsearchs will return nothing
3978     my $cust_contact = qsearchs('cust_contact', { 
3979         'classnum' => $classnum,
3980         'custnum'  => $self->custnum,
3981     });
3982     $self->{service_contact} = $cust_contact->contact if $cust_contact;
3983   }
3984   $self->{service_contact};
3985 }
3986
3987 =item ship_name
3988
3989 Returns a name string for this (service/shipping) contact, either
3990 "Company (Last, First)" or "Last, First".
3991
3992 =cut
3993
3994 sub ship_name {
3995   my $self = shift;
3996
3997   my $name = $self->ship_contact;
3998   $name = $self->company. " ($name)" if $self->company;
3999   $name;
4000 }
4001
4002 =item name_short
4003
4004 Returns a name string for this customer, either "Company" or "First Last".
4005
4006 =cut
4007
4008 sub name_short {
4009   my $self = shift;
4010   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4011 }
4012
4013 =item ship_name_short
4014
4015 Returns a name string for this (service/shipping) contact, either "Company"
4016 or "First Last".
4017
4018 =cut
4019
4020 sub ship_name_short {
4021   my $self = shift;
4022   $self->service_contact 
4023     ? $self->ship_contact_firstlast 
4024     : $self->name_short
4025 }
4026
4027 =item contact
4028
4029 Returns this customer's full (billing) contact name only, "Last, First"
4030
4031 =cut
4032
4033 sub contact {
4034   my $self = shift;
4035   $self->get('last'). ', '. $self->first;
4036 }
4037
4038 =item ship_contact
4039
4040 Returns this customer's full (shipping) contact name only, "Last, First"
4041
4042 =cut
4043
4044 sub ship_contact {
4045   my $self = shift;
4046   my $contact = $self->service_contact || $self;
4047   $contact->get('last') . ', ' . $contact->get('first');
4048 }
4049
4050 =item contact_firstlast
4051
4052 Returns this customers full (billing) contact name only, "First Last".
4053
4054 =cut
4055
4056 sub contact_firstlast {
4057   my $self = shift;
4058   $self->first. ' '. $self->get('last');
4059 }
4060
4061 =item ship_contact_firstlast
4062
4063 Returns this customer's full (shipping) contact name only, "First Last".
4064
4065 =cut
4066
4067 sub ship_contact_firstlast {
4068   my $self = shift;
4069   my $contact = $self->service_contact || $self;
4070   $contact->get('first') . ' '. $contact->get('last');
4071 }
4072
4073 sub bill_country_full {
4074   my $self = shift;
4075   $self->bill_location->country_full;
4076 }
4077
4078 sub ship_country_full {
4079   my $self = shift;
4080   $self->ship_location->country_full;
4081 }
4082
4083 =item county_state_county [ PREFIX ]
4084
4085 Returns a string consisting of just the county, state and country.
4086
4087 =cut
4088
4089 sub county_state_country {
4090   my $self = shift;
4091   my $locationnum;
4092   if ( @_ && $_[0] && $self->has_ship_address ) {
4093     $locationnum = $self->ship_locationnum;
4094   } else {
4095     $locationnum = $self->bill_locationnum;
4096   }
4097   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4098   $cust_location->county_state_country;
4099 }
4100
4101 =item geocode DATA_VENDOR
4102
4103 Returns a value for the customer location as encoded by DATA_VENDOR.
4104 Currently this only makes sense for "CCH" as DATA_VENDOR.
4105
4106 =cut
4107
4108 =item cust_status
4109
4110 =item status
4111
4112 Returns a status string for this customer, currently:
4113
4114 =over 4
4115
4116 =item prospect
4117
4118 No packages have ever been ordered.  Displayed as "No packages".
4119
4120 =item ordered
4121
4122 Recurring packages all are new (not yet billed).
4123
4124 =item active
4125
4126 One or more recurring packages is active.
4127
4128 =item inactive
4129
4130 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4131
4132 =item suspended
4133
4134 All non-cancelled recurring packages are suspended.
4135
4136 =item cancelled
4137
4138 All recurring packages are cancelled.
4139
4140 =back
4141
4142 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4143 cust_main-status_module configuration option.
4144
4145 =cut
4146
4147 sub status { shift->cust_status(@_); }
4148
4149 sub cust_status {
4150   my $self = shift;
4151   return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4152   for my $status ( FS::cust_main->statuses() ) {
4153     my $method = $status.'_sql';
4154     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4155     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4156     $sth->execute( ($self->custnum) x $numnum )
4157       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4158     if ( $sth->fetchrow_arrayref->[0] ) {
4159       $self->hashref->{cust_status} = $status;
4160       return $status;
4161     }
4162   }
4163 }
4164
4165 =item is_status_delay_cancel
4166
4167 Returns true if customer status is 'suspended'
4168 and all suspended cust_pkg return true for
4169 cust_pkg->is_status_delay_cancel.
4170
4171 This is not a real status, this only meant for hacking display 
4172 values, because otherwise treating the customer as suspended is 
4173 really the whole point of the delay_cancel option.
4174
4175 =cut
4176
4177 sub is_status_delay_cancel {
4178   my ($self) = @_;
4179   return 0 unless $self->status eq 'suspended';
4180   foreach my $cust_pkg ($self->ncancelled_pkgs) {
4181     return 0 unless $cust_pkg->is_status_delay_cancel;
4182   }
4183   return 1;
4184 }
4185
4186 =item ucfirst_cust_status
4187
4188 =item ucfirst_status
4189
4190 Deprecated, use the cust_status_label method instead.
4191
4192 Returns the status with the first character capitalized.
4193
4194 =cut
4195
4196 sub ucfirst_status {
4197   carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4198   local($ucfirst_nowarn) = 1;
4199   shift->ucfirst_cust_status(@_);
4200 }
4201
4202 sub ucfirst_cust_status {
4203   carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4204   my $self = shift;
4205   ucfirst($self->cust_status);
4206 }
4207
4208 =item cust_status_label
4209
4210 =item status_label
4211
4212 Returns the display label for this status.
4213
4214 =cut
4215
4216 sub status_label { shift->cust_status_label(@_); }
4217
4218 sub cust_status_label {
4219   my $self = shift;
4220   __PACKAGE__->statuslabels->{$self->cust_status};
4221 }
4222
4223 =item statuscolor
4224
4225 Returns a hex triplet color string for this customer's status.
4226
4227 =cut
4228
4229 sub statuscolor { shift->cust_statuscolor(@_); }
4230
4231 sub cust_statuscolor {
4232   my $self = shift;
4233   __PACKAGE__->statuscolors->{$self->cust_status};
4234 }
4235
4236 =item tickets [ STATUS ]
4237
4238 Returns an array of hashes representing the customer's RT tickets.
4239
4240 An optional status (or arrayref or hashref of statuses) may be specified.
4241
4242 =cut
4243
4244 sub tickets {
4245   my $self = shift;
4246   my $status = ( @_ && $_[0] ) ? shift : '';
4247
4248   my $num = $conf->config('cust_main-max_tickets') || 10;
4249   my @tickets = ();
4250
4251   if ( $conf->config('ticket_system') ) {
4252     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4253
4254       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4255                                                         $num,
4256                                                         undef,
4257                                                         $status,
4258                                                       )
4259                   };
4260
4261     } else {
4262
4263       foreach my $priority (
4264         $conf->config('ticket_system-custom_priority_field-values'), ''
4265       ) {
4266         last if scalar(@tickets) >= $num;
4267         push @tickets, 
4268           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4269                                                  $num - scalar(@tickets),
4270                                                  $priority,
4271                                                  $status,
4272                                                )
4273            };
4274       }
4275     }
4276   }
4277   (@tickets);
4278 }
4279
4280 =item appointments [ STATUS ]
4281
4282 Returns an array of hashes representing the customer's RT tickets which
4283 are appointments.
4284
4285 =cut
4286
4287 sub appointments {
4288   my $self = shift;
4289   my $status = ( @_ && $_[0] ) ? shift : '';
4290
4291   return () unless $conf->config('ticket_system');
4292
4293   my $queueid = $conf->config('ticket_system-appointment-queueid');
4294
4295   @{ FS::TicketSystem->customer_tickets( $self->custnum,
4296                                          99,
4297                                          undef,
4298                                          $status,
4299                                          $queueid,
4300                                        )
4301   };
4302 }
4303
4304 # Return services representing svc_accts in customer support packages
4305 sub support_services {
4306   my $self = shift;
4307   my %packages = map { $_ => 1 } $conf->config('support_packages');
4308
4309   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4310     grep { $_->part_svc->svcdb eq 'svc_acct' }
4311     map { $_->cust_svc }
4312     grep { exists $packages{ $_->pkgpart } }
4313     $self->ncancelled_pkgs;
4314
4315 }
4316
4317 # Return a list of latitude/longitude for one of the services (if any)
4318 sub service_coordinates {
4319   my $self = shift;
4320
4321   my @svc_X = 
4322     grep { $_->latitude && $_->longitude }
4323     map { $_->svc_x }
4324     map { $_->cust_svc }
4325     $self->ncancelled_pkgs;
4326
4327   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4328 }
4329
4330 =item masked FIELD
4331
4332 Returns a masked version of the named field
4333
4334 =cut
4335
4336 sub masked {
4337 my ($self,$field) = @_;
4338
4339 # Show last four
4340
4341 'x'x(length($self->getfield($field))-4).
4342   substr($self->getfield($field), (length($self->getfield($field))-4));
4343
4344 }
4345
4346 =item payment_history
4347
4348 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4349 cust_credit and cust_refund objects.  Each hashref has the following fields:
4350
4351 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4352
4353 I<date> - value of _date field, unix timestamp
4354
4355 I<date_pretty> - user-friendly date
4356
4357 I<description> - user-friendly description of item
4358
4359 I<amount> - impact of item on user's balance 
4360 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4361 Not to be confused with the native 'amount' field in cust_credit, see below.
4362
4363 I<amount_pretty> - includes money char
4364
4365 I<balance> - customer balance, chronologically as of this item
4366
4367 I<balance_pretty> - includes money char
4368
4369 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4370
4371 I<paid> - amount paid for cust_pay records, undef for other types
4372
4373 I<credit> - amount credited for cust_credit records, undef for other types.
4374 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4375
4376 I<refund> - amount refunded for cust_refund records, undef for other types
4377
4378 The four table-specific keys always have positive values, whether they reflect charges or payments.
4379
4380 The following options may be passed to this method:
4381
4382 I<line_items> - if true, returns charges ('Line item') rather than invoices
4383
4384 I<start_date> - unix timestamp, only include records on or after.
4385 If specified, an item of type 'Previous' will also be included.
4386 It does not have table-specific fields.
4387
4388 I<end_date> - unix timestamp, only include records before
4389
4390 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4391
4392 I<conf> - optional already-loaded FS::Conf object.
4393
4394 =cut
4395
4396 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4397 # and also for sending customer statements, which should both be kept customer-friendly.
4398 # If you add anything that shouldn't be passed on through the API or exposed 
4399 # to customers, add a new option to include it, don't include it by default
4400 sub payment_history {
4401   my $self = shift;
4402   my $opt = ref($_[0]) ? $_[0] : { @_ };
4403
4404   my $conf = $$opt{'conf'} || new FS::Conf;
4405   my $money_char = $conf->config("money_char") || '$',
4406
4407   #first load entire history, 
4408   #need previous to calculate previous balance
4409   #loading after end_date shouldn't hurt too much?
4410   my @history = ();
4411   if ( $$opt{'line_items'} ) {
4412
4413     foreach my $cust_bill ( $self->cust_bill ) {
4414
4415       push @history, {
4416         'type'        => 'Line item',
4417         'description' => $_->desc( $self->locale ).
4418                            ( $_->sdate && $_->edate
4419                                ? ' '. time2str('%d-%b-%Y', $_->sdate).
4420                                  ' To '. time2str('%d-%b-%Y', $_->edate)
4421                                : ''
4422                            ),
4423         'amount'      => sprintf('%.2f', $_->setup + $_->recur ),
4424         'charged'     => sprintf('%.2f', $_->setup + $_->recur ),
4425         'date'        => $cust_bill->_date,
4426         'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4427       }
4428         foreach $cust_bill->cust_bill_pkg;
4429
4430     }
4431
4432   } else {
4433
4434     push @history, {
4435                      'type'        => 'Invoice',
4436                      'description' => 'Invoice #'. $_->display_invnum,
4437                      'amount'      => sprintf('%.2f', $_->charged ),
4438                      'charged'     => sprintf('%.2f', $_->charged ),
4439                      'date'        => $_->_date,
4440                      'date_pretty' => $self->time2str_local('short', $_->_date ),
4441                    }
4442       foreach $self->cust_bill;
4443
4444   }
4445
4446   push @history, {
4447                    'type'        => 'Payment',
4448                    'description' => 'Payment', #XXX type
4449                    'amount'      => sprintf('%.2f', 0 - $_->paid ),
4450                    'paid'        => sprintf('%.2f', $_->paid ),
4451                    'date'        => $_->_date,
4452                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4453                  }
4454     foreach $self->cust_pay;
4455
4456   push @history, {
4457                    'type'        => 'Credit',
4458                    'description' => 'Credit', #more info?
4459                    'amount'      => sprintf('%.2f', 0 -$_->amount ),
4460                    'credit'      => sprintf('%.2f', $_->amount ),
4461                    'date'        => $_->_date,
4462                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4463                  }
4464     foreach $self->cust_credit;
4465
4466   push @history, {
4467                    'type'        => 'Refund',
4468                    'description' => 'Refund', #more info?  type, like payment?
4469                    'amount'      => $_->refund,
4470                    'refund'      => $_->refund,
4471                    'date'        => $_->_date,
4472                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4473                  }
4474     foreach $self->cust_refund;
4475
4476   #put it all in chronological order
4477   @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4478
4479   #calculate balance, filter items outside date range
4480   my $previous = 0;
4481   my $balance = 0;
4482   my @out = ();
4483   foreach my $item (@history) {
4484     last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4485     $balance += $$item{'amount'};
4486     if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4487       $previous += $$item{'amount'};
4488       next;
4489     }
4490     $$item{'balance'} = sprintf("%.2f",$balance);
4491     foreach my $key ( qw(amount balance) ) {
4492       $$item{$key.'_pretty'} = money_pretty($$item{$key});
4493     }
4494     push(@out,$item);
4495   }
4496
4497   # start with previous balance, if there was one
4498   if ($previous) {
4499     my $item = {
4500       'type'        => 'Previous',
4501       'description' => 'Previous balance',
4502       'amount'      => sprintf("%.2f",$previous),
4503       'balance'     => sprintf("%.2f",$previous),
4504       'date'        => $$opt{'start_date'},
4505       'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4506     };
4507     #false laziness with above
4508     foreach my $key ( qw(amount balance) ) {
4509       $$item{$key.'_pretty'} = $$item{$key};
4510       $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4511     }
4512     unshift(@out,$item);
4513   }
4514
4515   @out = reverse @history if $$opt{'reverse_sort'};
4516
4517   return @out;
4518 }
4519
4520 =item save_cust_payby
4521
4522 Saves a new cust_payby for this customer, replacing an existing entry only
4523 in select circumstances.  Does not validate input.
4524
4525 If auto is specified, marks this as the customer's primary method, or the 
4526 specified weight.  Existing payment methods have their weight incremented as
4527 appropriate.
4528
4529 If bill_location is specified with auto, also sets location in cust_main.
4530
4531 Will not insert complete duplicates of existing records, or records in which the
4532 only difference from an existing record is to turn off automatic payment (will
4533 return without error.)  Will replace existing records in which the only difference 
4534 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4535 Fields marked as preserved are optional, and existing values will not be overwritten with 
4536 blanks when replacing.
4537
4538 Accepts the following named parameters:
4539
4540 =over 4
4541
4542 =item payment_payby
4543
4544 either CARD or CHEK
4545
4546 =item auto
4547
4548 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4549
4550 =item weight
4551
4552 optional, set higher than 1 for secondary, etc.
4553
4554 =item payinfo
4555
4556 required
4557
4558 =item paymask
4559
4560 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4561
4562 =item payname
4563
4564 required
4565
4566 =item payip
4567
4568 optional, will be preserved when replacing
4569
4570 =item paydate
4571
4572 CARD only, required
4573
4574 =item bill_location
4575
4576 CARD only, required, FS::cust_location object
4577
4578 =item paystart_month
4579
4580 CARD only, optional, will be preserved when replacing
4581
4582 =item paystart_year
4583
4584 CARD only, optional, will be preserved when replacing
4585
4586 =item payissue
4587
4588 CARD only, optional, will be preserved when replacing
4589
4590 =item paycvv
4591
4592 CARD only, only used if conf cvv-save is set appropriately
4593
4594 =item paytype
4595
4596 CHEK only
4597
4598 =item paystate
4599
4600 CHEK only
4601
4602 =item saved_cust_payby