2 use base qw( FS::cust_main::Packages
4 FS::cust_main::NationalID
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
14 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
15 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
24 use Scalar::Util qw( blessed );
25 use List::Util qw(min);
27 use File::Temp; #qw( tempfile );
29 use Time::Local qw(timelocal);
33 use Business::CreditCard 0.28;
34 use FS::UID qw( dbh driver_name );
35 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
37 use FS::Misc qw( generate_ps do_print money_pretty card_types );
38 use FS::Msgcat qw(gettext);
45 use FS::cust_bill_void;
46 use FS::legacy_cust_bill;
48 use FS::cust_pay_pending;
49 use FS::cust_pay_void;
50 use FS::cust_pay_batch;
53 use FS::part_referral;
54 use FS::cust_main_county;
55 use FS::cust_location;
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;
64 use FS::prepay_credit;
70 use FS::payment_gateway;
71 use FS::agent_payment_gateway;
73 use FS::cust_main_note;
74 use FS::cust_attachment;
77 use FS::upgrade_journal;
82 use FS::Misc::Savepoint;
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
88 our $me = '[FS::cust_main]';
91 our $ignore_expired_card = 0;
92 our $ignore_banned_card = 0;
93 our $ignore_invalid_card = 0;
95 our $skip_fuzzyfiles = 0;
97 our $ucfirst_nowarn = 0;
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'); }
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');
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};
130 FS::cust_main - Object methods for cust_main records
136 $record = new FS::cust_main \%hash;
137 $record = new FS::cust_main { 'column' => 'value' };
139 $error = $record->insert;
141 $error = $new_record->replace($old_record);
143 $error = $record->delete;
145 $error = $record->check;
147 @cust_pkg = $record->all_pkgs;
149 @cust_pkg = $record->ncancelled_pkgs;
151 @cust_pkg = $record->suspended_pkgs;
153 $error = $record->bill;
154 $error = $record->bill %options;
155 $error = $record->bill 'time' => $time;
157 $error = $record->collect;
158 $error = $record->collect %options;
159 $error = $record->collect 'invoice_time' => $time,
164 An FS::cust_main object represents a customer. FS::cust_main inherits from
165 FS::Record. The following fields are currently supported:
171 Primary key (assigned automatically for new customers)
175 Agent (see L<FS::agent>)
179 Advertising source (see L<FS::part_referral>)
191 Cocial security number (optional)
215 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
219 Payment Information (See L<FS::payinfo_Mixin> for data format)
223 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
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
231 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
235 Start date month (maestro/solo cards only)
239 Start date year (maestro/solo cards only)
243 Issue number (maestro/solo cards only)
247 Name on card or billing name
251 IP address from which payment information was received
255 Tax exempt, empty or `Y'
259 Order taker (see L<FS::access_user>)
265 =item referral_custnum
267 Referring customer number
271 Enable individual CDR spooling, empty or `Y'
275 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
279 Discourage individual CDR printing, empty or `Y'
283 Allow self-service editing of ticket subjects, empty or 'Y'
285 =item calling_list_exempt
287 Do not call, empty or 'Y'
289 =item invoice_ship_address
291 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
301 Creates a new customer. To add the customer to the database, see L<"insert">.
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.
308 sub table { 'cust_main'; }
310 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
312 Adds this customer to the database. If there is an error, returns the error,
313 otherwise returns false.
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.
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:
328 tie %hash, 'Tie::RefHash'; #this part is important
330 $cust_pkg => [ $svc_acct ],
333 $cust_main->insert( \%hash );
335 INVOICING_LIST_ARYREF: No longer supported.
337 Currently available options are: I<depend_jobnum>, I<noexport>,
338 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
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).
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.)
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.
353 If I<prospectnum> is set, moves contacts and locations from that prospect.
355 If I<contact> is set to an arrayref of FS::contact objects, those will be
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
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
370 my $cust_pkgs = @_ ? shift : {};
372 if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
373 warn "cust_main::insert using deprecated invoicing list argument";
374 $invoicing_list = shift;
377 warn "$me insert called with options ".
378 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
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');
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';
392 my $oldAutoCommit = $FS::UID::AutoCommit;
393 local $FS::UID::AutoCommit = 0;
396 my $prepay_identifier = '';
397 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
399 if ( $self->payby eq 'PREPAY' ) {
401 $self->payby(''); #'BILL');
402 $prepay_identifier = $self->payinfo;
405 warn " looking up prepaid card $prepay_identifier\n"
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,
416 $dbh->rollback if $oldAutoCommit;
417 #return "error applying prepaid card (transaction rolled back): $error";
421 $payby = 'PREP' if $amount;
423 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
426 $self->payby(''); #'BILL');
427 $amount = $self->paid;
432 foreach my $l (qw(bill_location ship_location)) {
434 my $loc = delete $self->hashref->{$l} or next;
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"
441 my $error = $loc->insert;
443 $dbh->rollback if $oldAutoCommit;
444 my $label = $l eq 'ship_location' ? 'service' : 'billing';
445 return "$error (in $label location)";
448 } elsif ( $loc->prospectnum ) {
450 $loc->prospectnum('');
451 $loc->set(custnum_pending => 1);
452 my $error = $loc->replace;
454 $dbh->rollback if $oldAutoCommit;
455 my $label = $l eq 'ship_location' ? 'service' : 'billing';
456 return "$error (moving $label location)";
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;
464 # else it already belongs to this customer
465 # (happens when ship_location is identical to bill_location)
467 $self->set($l.'num', $loc->locationnum);
469 if ( $self->get($l.'num') eq '' ) {
470 $dbh->rollback if $oldAutoCommit;
475 warn " inserting $self\n"
478 $self->signupdate(time) unless $self->signupdate;
480 $self->auto_agent_custid()
481 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
483 my $error = $self->check_payinfo_cardtype
484 || $self->SUPER::insert;
486 $dbh->rollback if $oldAutoCommit;
487 #return "inserting cust_main record (transaction rolled back): $error";
491 # now set cust_location.custnum
492 foreach my $l (qw(bill_location ship_location)) {
493 warn " setting $l.custnum\n"
495 my $loc = $self->$l or next;
496 unless ( $loc->custnum ) {
497 $loc->set(custnum => $self->custnum);
498 $error ||= $loc->replace;
502 $dbh->rollback if $oldAutoCommit;
503 return "error setting $l custnum: $error";
507 warn " setting customer tags\n"
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;
515 $dbh->rollback if $oldAutoCommit;
520 my $prospectnum = delete $options{'prospectnum'};
521 if ( $prospectnum ) {
523 warn " moving contacts and locations from prospect $prospectnum\n"
527 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
528 unless ( $prospect_main ) {
529 $dbh->rollback if $oldAutoCommit;
530 return "Unknown prospectnum $prospectnum";
532 $prospect_main->custnum($self->custnum);
533 $prospect_main->disabled('Y');
534 my $error = $prospect_main->replace;
536 $dbh->rollback if $oldAutoCommit;
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 )
546 my $error = $cust_contact->insert
547 || $prospect_contact->delete;
549 $dbh->rollback if $oldAutoCommit;
554 my @cust_location = $prospect_main->cust_location;
555 my @qual = $prospect_main->qual;
557 foreach my $r ( @cust_location, @qual ) {
559 $r->custnum($self->custnum);
560 my $error = $r->replace;
562 $dbh->rollback if $oldAutoCommit;
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;
572 warn " setting contacts\n"
575 $invoicing_list ||= $options{'invoicing_list'};
576 if ( $invoicing_list ) {
578 $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
581 foreach my $dest (@$invoicing_list ) {
582 if ($dest eq 'POST') {
583 $self->set('postal_invoice', 'Y');
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,
592 $cust_contact->set('invoice_dest', 'Y');
593 my $error = $cust_contact->insert;
595 $dbh->rollback if $oldAutoCommit;
596 return "$error (linking to email address $dest)";
600 # this email address is not yet linked to any contact
601 $email .= ',' if length($email);
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
616 my $error = $contact->insert;
618 $dbh->rollback if $oldAutoCommit;
626 if ( my $contact = delete $options{'contact'} ) {
628 foreach my $c ( @$contact ) {
629 $c->custnum($self->custnum);
630 my $error = $c->insert;
632 $dbh->rollback if $oldAutoCommit;
638 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
640 my $error = $self->process_o2m( 'table' => 'contact',
641 'fields' => FS::contact->cgi_contact_fields,
642 'params' => $contact_params,
645 $dbh->rollback if $oldAutoCommit;
650 warn " setting cust_payby\n"
653 if ( $options{cust_payby} ) {
655 foreach my $cust_payby ( @{ $options{cust_payby} } ) {
656 $cust_payby->custnum($self->custnum);
657 my $error = $cust_payby->insert;
659 $dbh->rollback if $oldAutoCommit;
664 } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
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,
673 $dbh->rollback if $oldAutoCommit;
679 warn " setting cust_main_exemption\n"
682 my $tax_exemption = delete $options{'tax_exemption'};
683 if ( $tax_exemption ) {
685 $tax_exemption = { map { $_ => '' } @$tax_exemption }
686 if ref($tax_exemption) eq 'ARRAY';
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},
694 my $error = $cust_main_exemption->insert;
696 $dbh->rollback if $oldAutoCommit;
697 return "inserting cust_main_exemption (transaction rolled back): $error";
702 warn " ordering packages\n"
705 $error = $self->order_pkgs( $cust_pkgs,
707 'seconds_ref' => \$seconds,
708 'upbytes_ref' => \$upbytes,
709 'downbytes_ref' => \$downbytes,
710 'totalbytes_ref' => \$totalbytes,
713 $dbh->rollback if $oldAutoCommit;
718 $dbh->rollback if $oldAutoCommit;
719 return "No svc_acct record to apply pre-paid time";
721 if ( $upbytes || $downbytes || $totalbytes ) {
722 $dbh->rollback if $oldAutoCommit;
723 return "No svc_acct record to apply pre-paid data";
727 warn " inserting initial $payby payment of $amount\n"
729 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
731 $dbh->rollback if $oldAutoCommit;
732 return "inserting payment (transaction rolled back): $error";
736 unless ( $import || $skip_fuzzyfiles ) {
737 warn " queueing fuzzyfiles update\n"
739 $error = $self->queue_fuzzyfiles_update;
741 $dbh->rollback if $oldAutoCommit;
742 return "updating fuzzy search cache: $error";
747 warn " exporting\n" if $DEBUG > 1;
749 my $export_args = $options{'export_args'} || [];
752 map qsearch( 'part_export', {exportnum=>$_} ),
753 $conf->config('cust_main-exports'); #, $agentnum
755 foreach my $part_export ( @part_export ) {
756 my $error = $part_export->export_insert($self, @$export_args);
758 $dbh->rollback if $oldAutoCommit;
759 return "exporting to ". $part_export->exporttype.
760 " (transaction rolled back): $error";
764 #foreach my $depend_jobnum ( @$depend_jobnums ) {
765 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
767 # foreach my $jobnum ( @jobnums ) {
768 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
769 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
771 # my $error = $queue->depend_insert($depend_jobnum);
773 # $dbh->rollback if $oldAutoCommit;
774 # return "error queuing job dependancy: $error";
781 #if ( exists $options{'jobnums'} ) {
782 # push @{ $options{'jobnums'} }, @jobnums;
785 warn " insert complete; committing transaction\n"
788 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
793 use File::CounterFile;
794 sub auto_agent_custid {
797 my $format = $conf->config('cust_main-auto_agent_custid');
799 if ( $format eq '1YMMXXXXXXXX' ) {
801 my $counter = new File::CounterFile 'cust_main.agent_custid';
804 my $ym = 100000000000 + time2str('%y%m00000000', time);
805 if ( $ym > $counter->value ) {
806 $counter->{'value'} = $agent_custid = $ym;
807 $counter->{'updated'} = 1;
809 $agent_custid = $counter->inc;
815 die "Unknown cust_main-auto_agent_custid format: $format";
818 $self->agent_custid($agent_custid);
822 =item PACKAGE METHODS
824 Documentation on customer package methods has been moved to
825 L<FS::cust_main::Packages>.
827 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
829 Recharges this (existing) customer with the specified prepaid card (see
830 L<FS::prepay_credit>), specified either by I<identifier> or as an
831 FS::prepay_credit object. If there is an error, returns the error, otherwise
834 Optionally, five scalar references can be passed as well. They will have their
835 values filled in with the amount, number of seconds, and number of upload,
836 download, and total bytes applied by this prepaid card.
840 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
841 #the only place that uses these args
842 sub recharge_prepay {
843 my( $self, $prepay_credit, $amountref, $secondsref,
844 $upbytesref, $downbytesref, $totalbytesref ) = @_;
846 local $SIG{HUP} = 'IGNORE';
847 local $SIG{INT} = 'IGNORE';
848 local $SIG{QUIT} = 'IGNORE';
849 local $SIG{TERM} = 'IGNORE';
850 local $SIG{TSTP} = 'IGNORE';
851 local $SIG{PIPE} = 'IGNORE';
853 my $oldAutoCommit = $FS::UID::AutoCommit;
854 local $FS::UID::AutoCommit = 0;
857 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
859 my $error = $self->get_prepay( $prepay_credit,
860 'amount_ref' => \$amount,
861 'seconds_ref' => \$seconds,
862 'upbytes_ref' => \$upbytes,
863 'downbytes_ref' => \$downbytes,
864 'totalbytes_ref' => \$totalbytes,
866 || $self->increment_seconds($seconds)
867 || $self->increment_upbytes($upbytes)
868 || $self->increment_downbytes($downbytes)
869 || $self->increment_totalbytes($totalbytes)
870 || $self->insert_cust_pay_prepay( $amount,
872 ? $prepay_credit->identifier
877 $dbh->rollback if $oldAutoCommit;
881 if ( defined($amountref) ) { $$amountref = $amount; }
882 if ( defined($secondsref) ) { $$secondsref = $seconds; }
883 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
884 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
885 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
887 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
892 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
894 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
895 specified either by I<identifier> or as an FS::prepay_credit object.
897 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
898 incremented by the values of the prepaid card.
900 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
901 check or set this customer's I<agentnum>.
903 If there is an error, returns the error, otherwise returns false.
909 my( $self, $prepay_credit, %opt ) = @_;
911 local $SIG{HUP} = 'IGNORE';
912 local $SIG{INT} = 'IGNORE';
913 local $SIG{QUIT} = 'IGNORE';
914 local $SIG{TERM} = 'IGNORE';
915 local $SIG{TSTP} = 'IGNORE';
916 local $SIG{PIPE} = 'IGNORE';
918 my $oldAutoCommit = $FS::UID::AutoCommit;
919 local $FS::UID::AutoCommit = 0;
922 unless ( ref($prepay_credit) ) {
924 my $identifier = $prepay_credit;
926 $prepay_credit = qsearchs(
928 { 'identifier' => $identifier },
933 unless ( $prepay_credit ) {
934 $dbh->rollback if $oldAutoCommit;
935 return "Invalid prepaid card: ". $identifier;
940 if ( $prepay_credit->agentnum ) {
941 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
942 $dbh->rollback if $oldAutoCommit;
943 return "prepaid card not valid for agent ". $self->agentnum;
945 $self->agentnum($prepay_credit->agentnum);
948 my $error = $prepay_credit->delete;
950 $dbh->rollback if $oldAutoCommit;
951 return "removing prepay_credit (transaction rolled back): $error";
954 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
955 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
957 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
962 =item increment_upbytes SECONDS
964 Updates this customer's single or primary account (see L<FS::svc_acct>) by
965 the specified number of upbytes. If there is an error, returns the error,
966 otherwise returns false.
970 sub increment_upbytes {
971 _increment_column( shift, 'upbytes', @_);
974 =item increment_downbytes SECONDS
976 Updates this customer's single or primary account (see L<FS::svc_acct>) by
977 the specified number of downbytes. If there is an error, returns the error,
978 otherwise returns false.
982 sub increment_downbytes {
983 _increment_column( shift, 'downbytes', @_);
986 =item increment_totalbytes SECONDS
988 Updates this customer's single or primary account (see L<FS::svc_acct>) by
989 the specified number of totalbytes. If there is an error, returns the error,
990 otherwise returns false.
994 sub increment_totalbytes {
995 _increment_column( shift, 'totalbytes', @_);
998 =item increment_seconds SECONDS
1000 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1001 the specified number of seconds. If there is an error, returns the error,
1002 otherwise returns false.
1006 sub increment_seconds {
1007 _increment_column( shift, 'seconds', @_);
1010 =item _increment_column AMOUNT
1012 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1013 the specified number of seconds or bytes. If there is an error, returns
1014 the error, otherwise returns false.
1018 sub _increment_column {
1019 my( $self, $column, $amount ) = @_;
1020 warn "$me increment_column called: $column, $amount\n"
1023 return '' unless $amount;
1025 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1026 $self->ncancelled_pkgs;
1028 if ( ! @cust_pkg ) {
1029 return 'No packages with primary or single services found'.
1030 ' to apply pre-paid time';
1031 } elsif ( scalar(@cust_pkg) > 1 ) {
1032 #maybe have a way to specify the package/account?
1033 return 'Multiple packages found to apply pre-paid time';
1036 my $cust_pkg = $cust_pkg[0];
1037 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1041 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1043 if ( ! @cust_svc ) {
1044 return 'No account found to apply pre-paid time';
1045 } elsif ( scalar(@cust_svc) > 1 ) {
1046 return 'Multiple accounts found to apply pre-paid time';
1049 my $svc_acct = $cust_svc[0]->svc_x;
1050 warn " found service svcnum ". $svc_acct->pkgnum.
1051 ' ('. $svc_acct->email. ")\n"
1054 $column = "increment_$column";
1055 $svc_acct->$column($amount);
1059 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1061 Inserts a prepayment in the specified amount for this customer. An optional
1062 second argument can specify the prepayment identifier for tracking purposes.
1063 If there is an error, returns the error, otherwise returns false.
1067 sub insert_cust_pay_prepay {
1068 shift->insert_cust_pay('PREP', @_);
1071 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1073 Inserts a cash payment in the specified amount for this customer. An optional
1074 second argument can specify the payment identifier for tracking purposes.
1075 If there is an error, returns the error, otherwise returns false.
1079 sub insert_cust_pay_cash {
1080 shift->insert_cust_pay('CASH', @_);
1083 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1085 Inserts a Western Union payment in the specified amount for this customer. An
1086 optional second argument can specify the prepayment identifier for tracking
1087 purposes. If there is an error, returns the error, otherwise returns false.
1091 sub insert_cust_pay_west {
1092 shift->insert_cust_pay('WEST', @_);
1095 sub insert_cust_pay {
1096 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1097 my $payinfo = scalar(@_) ? shift : '';
1099 my $cust_pay = new FS::cust_pay {
1100 'custnum' => $self->custnum,
1101 'paid' => sprintf('%.2f', $amount),
1102 #'_date' => #date the prepaid card was purchased???
1104 'payinfo' => $payinfo,
1110 =item delete [ OPTION => VALUE ... ]
1112 This deletes the customer. If there is an error, returns the error, otherwise
1115 This will completely remove all traces of the customer record. This is not
1116 what you want when a customer cancels service; for that, cancel all of the
1117 customer's packages (see L</cancel>).
1119 If the customer has any uncancelled packages, you need to pass a new (valid)
1120 customer number for those packages to be transferred to, as the "new_customer"
1121 option. Cancelled packages will be deleted. Did I mention that this is NOT
1122 what you want when a customer cancels service and that you really should be
1123 looking at L<FS::cust_pkg/cancel>?
1125 You can't delete a customer with invoices (see L<FS::cust_bill>),
1126 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1127 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1128 set the "delete_financials" option to a true value.
1133 my( $self, %opt ) = @_;
1135 local $SIG{HUP} = 'IGNORE';
1136 local $SIG{INT} = 'IGNORE';
1137 local $SIG{QUIT} = 'IGNORE';
1138 local $SIG{TERM} = 'IGNORE';
1139 local $SIG{TSTP} = 'IGNORE';
1140 local $SIG{PIPE} = 'IGNORE';
1142 my $oldAutoCommit = $FS::UID::AutoCommit;
1143 local $FS::UID::AutoCommit = 0;
1146 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1147 $dbh->rollback if $oldAutoCommit;
1148 return "Can't delete a master agent customer";
1151 #use FS::access_user
1152 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1153 $dbh->rollback if $oldAutoCommit;
1154 return "Can't delete a master employee customer";
1157 tie my %financial_tables, 'Tie::IxHash',
1158 'cust_bill' => 'invoices',
1159 'cust_statement' => 'statements',
1160 'cust_credit' => 'credits',
1161 'cust_pay' => 'payments',
1162 'cust_refund' => 'refunds',
1165 foreach my $table ( keys %financial_tables ) {
1167 my @records = $self->$table();
1169 if ( @records && ! $opt{'delete_financials'} ) {
1170 $dbh->rollback if $oldAutoCommit;
1171 return "Can't delete a customer with ". $financial_tables{$table};
1174 foreach my $record ( @records ) {
1175 my $error = $record->delete;
1177 $dbh->rollback if $oldAutoCommit;
1178 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1184 my @cust_pkg = $self->ncancelled_pkgs;
1186 my $new_custnum = $opt{'new_custnum'};
1187 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1188 $dbh->rollback if $oldAutoCommit;
1189 return "Invalid new customer number: $new_custnum";
1191 foreach my $cust_pkg ( @cust_pkg ) {
1192 my %hash = $cust_pkg->hash;
1193 $hash{'custnum'} = $new_custnum;
1194 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1195 my $error = $new_cust_pkg->replace($cust_pkg,
1196 options => { $cust_pkg->options },
1199 $dbh->rollback if $oldAutoCommit;
1204 my @cancelled_cust_pkg = $self->all_pkgs;
1205 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1206 my $error = $cust_pkg->delete;
1208 $dbh->rollback if $oldAutoCommit;
1213 #cust_tax_adjustment in financials?
1214 #cust_pay_pending? ouch
1215 foreach my $table (qw(
1216 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1217 cust_payby cust_location cust_main_note cust_tax_adjustment
1218 cust_pay_void cust_pay_batch queue cust_tax_exempt
1220 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1221 my $error = $record->delete;
1223 $dbh->rollback if $oldAutoCommit;
1229 my $sth = $dbh->prepare(
1230 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1232 my $errstr = $dbh->errstr;
1233 $dbh->rollback if $oldAutoCommit;
1236 $sth->execute($self->custnum) or do {
1237 my $errstr = $sth->errstr;
1238 $dbh->rollback if $oldAutoCommit;
1244 my $ticket_dbh = '';
1245 if ($conf->config('ticket_system') eq 'RT_Internal') {
1247 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1248 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1249 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1250 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1253 if ( $ticket_dbh ) {
1255 my $ticket_sth = $ticket_dbh->prepare(
1256 'DELETE FROM Links WHERE Target = ?'
1258 my $errstr = $ticket_dbh->errstr;
1259 $dbh->rollback if $oldAutoCommit;
1262 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1264 my $errstr = $ticket_sth->errstr;
1265 $dbh->rollback if $oldAutoCommit;
1269 #check and see if the customer is the only link on the ticket, and
1270 #if so, set the ticket to deleted status in RT?
1271 #maybe someday, for now this will at least fix tickets not displaying
1275 #delete the customer record
1277 my $error = $self->SUPER::delete;
1279 $dbh->rollback if $oldAutoCommit;
1283 # cust_main exports!
1285 #my $export_args = $options{'export_args'} || [];
1288 map qsearch( 'part_export', {exportnum=>$_} ),
1289 $conf->config('cust_main-exports'); #, $agentnum
1291 foreach my $part_export ( @part_export ) {
1292 my $error = $part_export->export_delete( $self ); #, @$export_args);
1294 $dbh->rollback if $oldAutoCommit;
1295 return "exporting to ". $part_export->exporttype.
1296 " (transaction rolled back): $error";
1300 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1305 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1307 Replaces the OLD_RECORD with this one in the database. If there is an error,
1308 returns the error, otherwise returns false.
1310 To change the customer's address, set the pseudo-fields C<bill_location> and
1311 C<ship_location>. The address will still only change if at least one of the
1312 address fields differs from the existing values.
1314 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1315 set as the contact email address for a default contact with the same name as
1318 Currently available options are: I<tax_exemption>, I<cust_payby_params>,
1319 I<contact_params>, I<invoicing_list>.
1321 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1322 of tax names and exemption numbers. FS::cust_main_exemption records will be
1323 deleted and inserted as appropriate.
1325 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1326 groups (describing the customer's payment methods and contacts, respectively)
1327 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1328 and L<FS::contact> for the fields these can contain.
1330 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1331 should be used instead if possible.
1338 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1340 : $self->replace_old;
1344 warn "$me replace called\n"
1347 my $curuser = $FS::CurrentUser::CurrentUser;
1348 return "You are not permitted to create complimentary accounts."
1349 if $self->complimentary eq 'Y'
1350 && $self->complimentary ne $old->complimentary
1351 && ! $curuser->access_right('Complimentary customer');
1353 local($ignore_expired_card) = 1
1354 if $old->payby =~ /^(CARD|DCRD)$/
1355 && $self->payby =~ /^(CARD|DCRD)$/
1356 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1358 local($ignore_banned_card) = 1
1359 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1360 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1361 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1363 if ( $self->payby =~ /^(CARD|DCRD)$/
1364 && $old->payinfo ne $self->payinfo
1365 && $old->paymask ne $self->paymask )
1367 my $error = $self->check_payinfo_cardtype;
1368 return $error if $error;
1371 return "Invoicing locale is required"
1374 && $conf->exists('cust_main-require_locale');
1376 return "You are not permitted to change customer invoicing terms."
1377 if $old->invoice_terms ne $self->invoice_terms
1378 && ! $curuser->access_right('Edit customer invoice terms');
1380 local $SIG{HUP} = 'IGNORE';
1381 local $SIG{INT} = 'IGNORE';
1382 local $SIG{QUIT} = 'IGNORE';
1383 local $SIG{TERM} = 'IGNORE';
1384 local $SIG{TSTP} = 'IGNORE';
1385 local $SIG{PIPE} = 'IGNORE';
1387 my $oldAutoCommit = $FS::UID::AutoCommit;
1388 local $FS::UID::AutoCommit = 0;
1391 for my $l (qw(bill_location ship_location)) {
1392 #my $old_loc = $old->$l;
1393 my $new_loc = $self->$l or next;
1395 # find the existing location if there is one
1396 $new_loc->set('custnum' => $self->custnum);
1397 my $error = $new_loc->find_or_insert;
1399 $dbh->rollback if $oldAutoCommit;
1402 $self->set($l.'num', $new_loc->locationnum);
1406 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1407 warn "cust_main::replace: using deprecated invoicing list argument";
1408 $invoicing_list = shift @param;
1411 my %options = @param;
1413 $invoicing_list ||= $options{invoicing_list};
1415 my @contacts = map { $_->contact } $self->cust_contact;
1416 # find a contact that matches the customer's name
1417 my ($implicit_contact) = grep { $_->first eq $old->get('first')
1418 and $_->last eq $old->get('last') }
1420 $implicit_contact ||= FS::contact->new({
1421 'custnum' => $self->custnum,
1422 'locationnum' => $self->get('bill_locationnum'),
1425 # for any of these that are already contact emails, link to the existing
1427 if ( $invoicing_list ) {
1430 # kind of like process_m2m on these, except:
1431 # - the other side is two tables in a join
1432 # - and we might have to create new contact_emails
1433 # - and possibly a new contact
1435 # Find existing invoice emails that aren't on the implicit contact.
1436 # Any of these that are not on the new invoicing list will be removed.
1437 my %old_email_cust_contact;
1438 foreach my $cust_contact ($self->cust_contact) {
1439 next if !$cust_contact->invoice_dest;
1440 next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
1442 foreach my $contact_email ($cust_contact->contact->contact_email) {
1443 $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
1447 foreach my $dest (@$invoicing_list) {
1449 if ($dest eq 'POST') {
1451 $self->set('postal_invoice', 'Y');
1453 } elsif ( exists($old_email_cust_contact{$dest}) ) {
1455 delete $old_email_cust_contact{$dest}; # don't need to remove it, then
1459 # See if it belongs to some other contact; if so, link it.
1460 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
1462 and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
1463 my $cust_contact = qsearchs('cust_contact', {
1464 contactnum => $contact_email->contactnum,
1465 custnum => $self->custnum,
1466 }) || FS::cust_contact->new({
1467 contactnum => $contact_email->contactnum,
1468 custnum => $self->custnum,
1470 $cust_contact->set('invoice_dest', 'Y');
1471 my $error = $cust_contact->custcontactnum ?
1472 $cust_contact->replace : $cust_contact->insert;
1474 $dbh->rollback if $oldAutoCommit;
1475 return "$error (linking to email address $dest)";
1479 # This email address is not yet linked to any contact, so it will
1480 # be added to the implicit contact.
1481 $email .= ',' if length($email);
1487 foreach my $remove_dest (keys %old_email_cust_contact) {
1488 my $cust_contact = $old_email_cust_contact{$remove_dest};
1489 # These were not in the list of requested destinations, so take them off.
1490 $cust_contact->set('invoice_dest', '');
1491 my $error = $cust_contact->replace;
1493 $dbh->rollback if $oldAutoCommit;
1494 return "$error (unlinking email address $remove_dest)";
1498 # make sure it keeps up with the changed customer name, if any
1499 $implicit_contact->set('last', $self->get('last'));
1500 $implicit_contact->set('first', $self->get('first'));
1501 $implicit_contact->set('emailaddress', $email);
1502 $implicit_contact->set('invoice_dest', 'Y');
1503 $implicit_contact->set('custnum', $self->custnum);
1504 my $i_cust_contact =
1505 qsearchs('cust_contact', {
1506 contactnum => $implicit_contact->contactnum,
1507 custnum => $self->custnum,
1510 if ( $i_cust_contact ) {
1511 $implicit_contact->set($_, $i_cust_contact->$_)
1512 foreach qw( classnum selfservice_access comment );
1516 if ( $implicit_contact->contactnum ) {
1517 $error = $implicit_contact->replace;
1518 } elsif ( length($email) ) { # don't create a new contact if not needed
1519 $error = $implicit_contact->insert;
1523 $dbh->rollback if $oldAutoCommit;
1524 return "$error (adding email address $email)";
1529 # replace the customer record
1530 my $error = $self->SUPER::replace($old);
1533 $dbh->rollback if $oldAutoCommit;
1537 # now move packages to the new service location
1538 $self->set('ship_location', ''); #flush cache
1539 if ( $old->ship_locationnum and # should only be null during upgrade...
1540 $old->ship_locationnum != $self->ship_locationnum ) {
1541 $error = $old->ship_location->move_to($self->ship_location);
1543 $dbh->rollback if $oldAutoCommit;
1547 # don't move packages based on the billing location, but
1548 # disable it if it's no longer in use
1549 if ( $old->bill_locationnum and
1550 $old->bill_locationnum != $self->bill_locationnum ) {
1551 $error = $old->bill_location->disable_if_unused;
1553 $dbh->rollback if $oldAutoCommit;
1558 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1560 #this could be more efficient than deleting and re-inserting, if it matters
1561 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1562 my $error = $cust_tag->delete;
1564 $dbh->rollback if $oldAutoCommit;
1568 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1569 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1570 'custnum' => $self->custnum };
1571 my $error = $cust_tag->insert;
1573 $dbh->rollback if $oldAutoCommit;
1580 my $tax_exemption = delete $options{'tax_exemption'};
1581 if ( $tax_exemption ) {
1583 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1584 if ref($tax_exemption) eq 'ARRAY';
1586 my %cust_main_exemption =
1587 map { $_->taxname => $_ }
1588 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1590 foreach my $taxname ( keys %$tax_exemption ) {
1592 if ( $cust_main_exemption{$taxname} &&
1593 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1596 delete $cust_main_exemption{$taxname};
1600 my $cust_main_exemption = new FS::cust_main_exemption {
1601 'custnum' => $self->custnum,
1602 'taxname' => $taxname,
1603 'exempt_number' => $tax_exemption->{$taxname},
1605 my $error = $cust_main_exemption->insert;
1607 $dbh->rollback if $oldAutoCommit;
1608 return "inserting cust_main_exemption (transaction rolled back): $error";
1612 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1613 my $error = $cust_main_exemption->delete;
1615 $dbh->rollback if $oldAutoCommit;
1616 return "deleting cust_main_exemption (transaction rolled back): $error";
1622 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1624 my $error = $self->process_o2m(
1625 'table' => 'cust_payby',
1626 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1627 'params' => $cust_payby_params,
1628 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1631 $dbh->rollback if $oldAutoCommit;
1637 if ( my $contact_params = delete $options{'contact_params'} ) {
1639 # this can potentially replace contacts that were created by the
1640 # invoicing list argument, but the UI shouldn't allow both of them
1643 my $error = $self->process_o2m(
1644 'table' => 'contact',
1645 'fields' => FS::contact->cgi_contact_fields,
1646 'params' => $contact_params,
1649 $dbh->rollback if $oldAutoCommit;
1655 unless ( $import || $skip_fuzzyfiles ) {
1656 $error = $self->queue_fuzzyfiles_update;
1658 $dbh->rollback if $oldAutoCommit;
1659 return "updating fuzzy search cache: $error";
1663 # tax district update in cust_location
1665 # cust_main exports!
1667 my $export_args = $options{'export_args'} || [];
1670 map qsearch( 'part_export', {exportnum=>$_} ),
1671 $conf->config('cust_main-exports'); #, $agentnum
1673 foreach my $part_export ( @part_export ) {
1674 my $error = $part_export->export_replace( $self, $old, @$export_args);
1676 $dbh->rollback if $oldAutoCommit;
1677 return "exporting to ". $part_export->exporttype.
1678 " (transaction rolled back): $error";
1682 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1687 =item queue_fuzzyfiles_update
1689 Used by insert & replace to update the fuzzy search cache
1693 use FS::cust_main::Search;
1694 sub queue_fuzzyfiles_update {
1697 local $SIG{HUP} = 'IGNORE';
1698 local $SIG{INT} = 'IGNORE';
1699 local $SIG{QUIT} = 'IGNORE';
1700 local $SIG{TERM} = 'IGNORE';
1701 local $SIG{TSTP} = 'IGNORE';
1702 local $SIG{PIPE} = 'IGNORE';
1704 my $oldAutoCommit = $FS::UID::AutoCommit;
1705 local $FS::UID::AutoCommit = 0;
1708 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1709 my $queue = new FS::queue {
1710 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1712 my @args = "cust_main.$field", $self->get($field);
1713 my $error = $queue->insert( @args );
1715 $dbh->rollback if $oldAutoCommit;
1716 return "queueing job (transaction rolled back): $error";
1721 push @locations, $self->bill_location if $self->bill_locationnum;
1722 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1723 foreach my $location (@locations) {
1724 my $queue = new FS::queue {
1725 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1727 my @args = 'cust_location.address1', $location->address1;
1728 my $error = $queue->insert( @args );
1730 $dbh->rollback if $oldAutoCommit;
1731 return "queueing job (transaction rolled back): $error";
1735 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1742 Checks all fields to make sure this is a valid customer record. If there is
1743 an error, returns the error, otherwise returns false. Called by the insert
1744 and replace methods.
1751 warn "$me check BEFORE: \n". $self->_dump
1755 $self->ut_numbern('custnum')
1756 || $self->ut_number('agentnum')
1757 || $self->ut_textn('agent_custid')
1758 || $self->ut_number('refnum')
1759 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1760 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1761 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1762 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1763 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1764 || $self->ut_textn('custbatch')
1765 || $self->ut_name('last')
1766 || $self->ut_name('first')
1767 || $self->ut_snumbern('signupdate')
1768 || $self->ut_snumbern('birthdate')
1769 || $self->ut_namen('spouse_last')
1770 || $self->ut_namen('spouse_first')
1771 || $self->ut_snumbern('spouse_birthdate')
1772 || $self->ut_snumbern('anniversary_date')
1773 || $self->ut_textn('company')
1774 || $self->ut_textn('ship_company')
1775 || $self->ut_anything('comments')
1776 || $self->ut_numbern('referral_custnum')
1777 || $self->ut_textn('stateid')
1778 || $self->ut_textn('stateid_state')
1779 || $self->ut_textn('invoice_terms')
1780 || $self->ut_floatn('cdr_termination_percentage')
1781 || $self->ut_floatn('credit_limit')
1782 || $self->ut_numbern('billday')
1783 || $self->ut_numbern('prorate_day')
1784 || $self->ut_flag('force_prorate_day')
1785 || $self->ut_flag('edit_subject')
1786 || $self->ut_flag('calling_list_exempt')
1787 || $self->ut_flag('invoice_noemail')
1788 || $self->ut_flag('message_noemail')
1789 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1790 || $self->ut_currencyn('currency')
1791 || $self->ut_textn('po_number')
1792 || $self->ut_enum('complimentary', [ '', 'Y' ])
1793 || $self->ut_flag('invoice_ship_address')
1794 || $self->ut_flag('invoice_dest')
1797 foreach (qw(company ship_company)) {
1798 my $company = $self->get($_);
1799 $company =~ s/^\s+//;
1800 $company =~ s/\s+$//;
1801 $company =~ s/\s+/ /g;
1802 $self->set($_, $company);
1805 #barf. need message catalogs. i18n. etc.
1806 $error .= "Please select an advertising source."
1807 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1808 return $error if $error;
1810 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1811 or return "Unknown agent";
1813 if ( $self->currency ) {
1814 my $agent_currency = qsearchs( 'agent_currency', {
1815 'agentnum' => $agent->agentnum,
1816 'currency' => $self->currency,
1818 or return "Agent ". $agent->agent.
1819 " not permitted to offer ". $self->currency. " invoicing";
1822 return "Unknown refnum"
1823 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1825 return "Unknown referring custnum: ". $self->referral_custnum
1826 unless ! $self->referral_custnum
1827 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1829 if ( $self->ss eq '' ) {
1834 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1835 or return "Illegal social security number: ". $self->ss;
1836 $self->ss("$1-$2-$3");
1839 #turn off invoice_ship_address if ship & bill are the same
1840 if ($self->bill_locationnum eq $self->ship_locationnum) {
1841 $self->invoice_ship_address('');
1844 # cust_main_county verification now handled by cust_location check
1847 $self->ut_phonen('daytime', $self->country)
1848 || $self->ut_phonen('night', $self->country)
1849 || $self->ut_phonen('fax', $self->country)
1850 || $self->ut_phonen('mobile', $self->country)
1852 return $error if $error;
1854 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1856 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1859 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1861 : FS::Msgcat::_gettext('daytime');
1862 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1864 : FS::Msgcat::_gettext('night');
1866 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1868 : FS::Msgcat::_gettext('mobile');
1870 return "$daytime_label, $night_label or $mobile_label is required"
1874 ### start of stuff moved to cust_payby
1875 # then mostly kept here to support upgrades (can remove in 5.x)
1876 # but modified to allow everything to be empty
1878 if ( $self->payby ) {
1879 FS::payby->can_payby($self->table, $self->payby)
1880 or return "Illegal payby: ". $self->payby;
1885 $error = $self->ut_numbern('paystart_month')
1886 || $self->ut_numbern('paystart_year')
1887 || $self->ut_numbern('payissue')
1888 || $self->ut_textn('paytype')
1890 return $error if $error;
1892 if ( $self->payip eq '' ) {
1895 $error = $self->ut_ip('payip');
1896 return $error if $error;
1899 # If it is encrypted and the private key is not availaible then we can't
1900 # check the credit card.
1901 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1903 # Need some kind of global flag to accept invalid cards, for testing
1905 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1906 $self->payby =~ /^(CARD|DCRD)$/ ) {
1908 my $payinfo = $self->payinfo;
1909 $payinfo =~ s/\D//g;
1910 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1911 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1913 $self->payinfo($payinfo);
1915 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1917 return gettext('unknown_card_type')
1918 if $self->payinfo !~ /^99\d{14}$/ #token
1919 && cardtype($self->payinfo) eq "Unknown";
1921 unless ( $ignore_banned_card ) {
1922 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1924 if ( $ban->bantype eq 'warn' ) {
1925 #or others depending on value of $ban->reason ?
1926 return '_duplicate_card'.
1927 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1928 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1929 ' (ban# '. $ban->bannum. ')'
1930 unless $self->override_ban_warn;
1932 return 'Banned credit card: banned on '.
1933 time2str('%a %h %o at %r', $ban->_date).
1934 ' by '. $ban->otaker.
1935 ' (ban# '. $ban->bannum. ')';
1940 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1941 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1942 $self->paycvv =~ /^(\d{4})$/
1943 or return "CVV2 (CID) for American Express cards is four digits.";
1946 $self->paycvv =~ /^(\d{3})$/
1947 or return "CVV2 (CVC2/CID) is three digits.";
1954 my $cardtype = cardtype($payinfo);
1955 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1957 return "Start date or issue number is required for $cardtype cards"
1958 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1960 return "Start month must be between 1 and 12"
1961 if $self->paystart_month
1962 and $self->paystart_month < 1 || $self->paystart_month > 12;
1964 return "Start year must be 1990 or later"
1965 if $self->paystart_year
1966 and $self->paystart_year < 1990;
1968 return "Issue number must be beween 1 and 99"
1970 and $self->payissue < 1 || $self->payissue > 99;
1973 $self->paystart_month('');
1974 $self->paystart_year('');
1975 $self->payissue('');
1978 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1979 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1981 my $payinfo = $self->payinfo;
1982 $payinfo =~ s/[^\d\@\.]//g;
1983 if ( $conf->config('echeck-country') eq 'CA' ) {
1984 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1985 or return 'invalid echeck account@branch.bank';
1986 $payinfo = "$1\@$2.$3";
1987 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1988 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1989 $payinfo = "$1\@$2";
1991 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1992 $payinfo = "$1\@$2";
1994 $self->payinfo($payinfo);
1997 unless ( $ignore_banned_card ) {
1998 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2000 if ( $ban->bantype eq 'warn' ) {
2001 #or others depending on value of $ban->reason ?
2002 return '_duplicate_ach' unless $self->override_ban_warn;
2004 return 'Banned ACH account: banned on '.
2005 time2str('%a %h %o at %r', $ban->_date).
2006 ' by '. $ban->otaker.
2007 ' (ban# '. $ban->bannum. ')';
2012 } elsif ( $self->payby eq 'LECB' ) {
2014 my $payinfo = $self->payinfo;
2015 $payinfo =~ s/\D//g;
2016 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2018 $self->payinfo($payinfo);
2021 } elsif ( $self->payby eq 'BILL' ) {
2023 $error = $self->ut_textn('payinfo');
2024 return "Illegal P.O. number: ". $self->payinfo if $error;
2027 } elsif ( $self->payby eq 'COMP' ) {
2029 my $curuser = $FS::CurrentUser::CurrentUser;
2030 if ( ! $self->custnum
2031 && ! $curuser->access_right('Complimentary customer')
2034 return "You are not permitted to create complimentary accounts."
2037 $error = $self->ut_textn('payinfo');
2038 return "Illegal comp account issuer: ". $self->payinfo if $error;
2041 } elsif ( $self->payby eq 'PREPAY' ) {
2043 my $payinfo = $self->payinfo;
2044 $payinfo =~ s/\W//g; #anything else would just confuse things
2045 $self->payinfo($payinfo);
2046 $error = $self->ut_alpha('payinfo');
2047 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2048 return "Unknown prepayment identifier"
2049 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2054 return "You are not permitted to create complimentary accounts."
2056 && $self->complimentary eq 'Y'
2057 && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer');
2059 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2060 return "Expiration date required"
2061 # shouldn't payinfo_check do this?
2062 unless ! $self->payby
2063 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2067 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2068 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2069 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2070 ( $m, $y ) = ( $2, "19$1" );
2071 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2072 ( $m, $y ) = ( $3, "20$2" );
2074 return "Illegal expiration date: ". $self->paydate;
2076 $m = sprintf('%02d',$m);
2077 $self->paydate("$y-$m-01");
2078 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2079 return gettext('expired_card')
2081 && !$ignore_expired_card
2082 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2085 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2086 ( ! $conf->exists('require_cardname')
2087 || $self->payby !~ /^(CARD|DCRD)$/ )
2089 $self->payname( $self->first. " ". $self->getfield('last') );
2092 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2093 $self->payname =~ /^([\w \,\.\-\']*)$/
2094 or return gettext('illegal_name'). " payname: ". $self->payname;
2097 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2098 or return gettext('illegal_name'). " payname: ". $self->payname;
2104 ### end of stuff moved to cust_payby
2106 return "Please select an invoicing locale"
2109 && $conf->exists('cust_main-require_locale');
2111 return "Please select a customer class"
2112 if ! $self->classnum
2113 && $conf->exists('cust_main-require_classnum');
2115 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2116 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2120 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2122 warn "$me check AFTER: \n". $self->_dump
2125 $self->SUPER::check;
2128 sub check_payinfo_cardtype {
2131 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
2133 my $payinfo = $self->payinfo;
2134 $payinfo =~ s/\D//g;
2136 return '' if $self->tokenized($payinfo); #token
2138 my %bop_card_types = map { $_=>1 } values %{ card_types() };
2139 my $cardtype = cardtype($payinfo);
2141 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
2149 Additional checks for replace only.
2154 my ($new,$old) = @_;
2155 #preserve old value if global config is set
2156 if ($old && $conf->exists('invoice-ship_address')) {
2157 $new->invoice_ship_address($old->invoice_ship_address);
2164 Returns a list of fields which have ship_ duplicates.
2169 qw( last first company
2171 address1 address2 city county state zip country
2173 daytime night fax mobile
2177 =item has_ship_address
2179 Returns true if this customer record has a separate shipping address.
2183 sub has_ship_address {
2185 $self->bill_locationnum != $self->ship_locationnum;
2190 Returns a list of key/value pairs, with the following keys: address1,
2191 adddress2, city, county, state, zip, country, district, and geocode. The
2192 shipping address is used if present.
2198 $self->ship_location->location_hash;
2203 Returns all locations (see L<FS::cust_location>) for this customer.
2210 'table' => 'cust_location',
2211 'hashref' => { 'custnum' => $self->custnum,
2212 'prospectnum' => '',
2214 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
2220 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2226 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2229 =item cust_payby PAYBY
2231 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2233 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2234 Does not validate PAYBY.
2242 'table' => 'cust_payby',
2243 'hashref' => { 'custnum' => $self->custnum },
2244 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2246 $search->{'extra_sql'} = ' AND payby IN ( '.
2247 join(',', map dbh->quote($_), @payby).
2254 =item has_cust_payby_auto
2256 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2260 sub has_cust_payby_auto {
2263 'table' => 'cust_payby',
2264 'hashref' => { 'custnum' => $self->custnum, },
2265 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2266 'order_by' => 'LIMIT 1',
2273 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2274 and L<FS::cust_pkg>) for this customer, except those on hold.
2276 Returns a list: an empty list on success or a list of errors.
2282 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
2287 Unsuspends all suspended packages in the on-hold state (those without setup
2288 dates) for this customer.
2294 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2299 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2301 Returns a list: an empty list on success or a list of errors.
2307 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2310 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2312 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2313 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2314 of a list of pkgparts; the hashref has the following keys:
2318 =item pkgparts - listref of pkgparts
2320 =item (other options are passed to the suspend method)
2325 Returns a list: an empty list on success or a list of errors.
2329 sub suspend_if_pkgpart {
2331 my (@pkgparts, %opt);
2332 if (ref($_[0]) eq 'HASH'){
2333 @pkgparts = @{$_[0]{pkgparts}};
2338 grep { $_->suspend(%opt) }
2339 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2340 $self->unsuspended_pkgs;
2343 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2345 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2346 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2347 instead of a list of pkgparts; the hashref has the following keys:
2351 =item pkgparts - listref of pkgparts
2353 =item (other options are passed to the suspend method)
2357 Returns a list: an empty list on success or a list of errors.
2361 sub suspend_unless_pkgpart {
2363 my (@pkgparts, %opt);
2364 if (ref($_[0]) eq 'HASH'){
2365 @pkgparts = @{$_[0]{pkgparts}};
2370 grep { $_->suspend(%opt) }
2371 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2372 $self->unsuspended_pkgs;
2375 =item cancel [ OPTION => VALUE ... ]
2377 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2378 The cancellation time will be now.
2382 Always returns a list: an empty list on success or a list of errors.
2389 warn "$me cancel called on customer ". $self->custnum. " with options ".
2390 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2392 my @pkgs = $self->ncancelled_pkgs;
2394 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2397 =item cancel_pkgs OPTIONS
2399 Cancels a specified list of packages. OPTIONS can include:
2403 =item cust_pkg - an arrayref of the packages. Required.
2405 =item time - the cancellation time, used to calculate final bills and
2406 unused-time credits if any. Will be passed through to the bill() and
2407 FS::cust_pkg::cancel() methods.
2409 =item quiet - can be set true to supress email cancellation notices.
2411 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2412 reasonnum of an existing reason, or passing a hashref will create a new reason.
2413 The hashref should have the following keys:
2414 typenum - Reason type (see L<FS::reason_type>)
2415 reason - Text of the new reason.
2417 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2418 for the individual packages, parallel to the C<cust_pkg> argument. The
2419 reason and reason_otaker arguments will be taken from those objects.
2421 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2423 =item nobill - can be set true to skip billing if it might otherwise be done.
2428 my( $self, %opt ) = @_;
2430 # we're going to cancel services, which is not reversible
2431 # unless exports are suppressed
2432 die "cancel_pkgs cannot be run inside a transaction"
2433 if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
2435 my $oldAutoCommit = $FS::UID::AutoCommit;
2436 local $FS::UID::AutoCommit = 0;
2438 savepoint_create('cancel_pkgs');
2440 return ( 'access denied' )
2441 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2443 if ( $opt{'ban'} ) {
2445 foreach my $cust_payby ( $self->cust_payby ) {
2447 #well, if they didn't get decrypted on search, then we don't have to
2448 # try again... queue a job for the server that does have decryption
2449 # capability if we're in a paranoid multi-server implementation?
2450 return ( "Can't (yet) ban encrypted credit cards" )
2451 if $cust_payby->is_encrypted($cust_payby->payinfo);
2453 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2454 my $error = $ban->insert;
2456 savepoint_rollback_and_release('cancel_pkgs');
2457 dbh->rollback if $oldAutoCommit;
2465 my @pkgs = @{ delete $opt{'cust_pkg'} };
2466 my $cancel_time = $opt{'time'} || time;
2468 # bill all packages first, so we don't lose usage, service counts for
2469 # bulk billing, etc.
2470 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2472 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2474 'time' => $cancel_time );
2476 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2477 savepoint_rollback_and_release('cancel_pkgs');
2478 dbh->rollback if $oldAutoCommit;
2479 return ( "Error billing during cancellation: $error" );
2482 savepoint_release('cancel_pkgs');
2483 dbh->commit if $oldAutoCommit;
2486 # now cancel all services, the same way we would for individual packages.
2487 # if any of them fail, cancel the rest anyway.
2488 my @cust_svc = map { $_->cust_svc } @pkgs;
2489 my @sorted_cust_svc =
2491 sort { $a->[1] <=> $b->[1] }
2492 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2494 warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2498 foreach my $cust_svc (@sorted_cust_svc) {
2499 my $savepoint = 'cancel_pkgs_'.$i++;
2500 savepoint_create( $savepoint );
2501 my $part_svc = $cust_svc->part_svc;
2502 next if ( defined($part_svc) and $part_svc->preserve );
2503 # immediate cancel, no date option
2504 # transactionize individually
2505 my $error = try { $cust_svc->cancel } catch { $_ };
2507 savepoint_rollback_and_release( $savepoint );
2508 dbh->rollback if $oldAutoCommit;
2509 push @errors, $error;
2511 savepoint_release( $savepoint );
2512 dbh->commit if $oldAutoCommit;
2519 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2520 $self->custnum. "\n"
2524 if ($opt{'cust_pkg_reason'}) {
2525 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2531 my $savepoint = 'cancel_pkgs_'.$i++;
2532 savepoint_create( $savepoint );
2534 my $cpr = shift @cprs;
2536 $lopt{'reason'} = $cpr->reasonnum;
2537 $lopt{'reason_otaker'} = $cpr->otaker;
2539 warn "no reason found when canceling package ".$_->pkgnum."\n";
2540 # we're not actually required to pass a reason to cust_pkg::cancel,
2541 # but if we're getting to this point, something has gone awry.
2542 $null_reason ||= FS::reason->new_or_existing(
2543 reason => 'unknown reason',
2544 type => 'Cancel Reason',
2547 $lopt{'reason'} = $null_reason->reasonnum;
2548 $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2551 my $error = $_->cancel(%lopt);
2553 savepoint_rollback_and_release( $savepoint );
2554 dbh->rollback if $oldAutoCommit;
2555 push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2557 savepoint_release( $savepoint );
2558 dbh->commit if $oldAutoCommit;
2565 sub _banned_pay_hashref {
2576 'payby' => $payby2ban{$self->payby},
2577 'payinfo' => $self->payinfo,
2578 #don't ever *search* on reason! #'reason' =>
2584 Returns all notes (see L<FS::cust_main_note>) for this customer.
2589 my($self,$orderby_classnum) = (shift,shift);
2590 my $orderby = "sticky DESC, _date DESC";
2591 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2592 qsearch( 'cust_main_note',
2593 { 'custnum' => $self->custnum },
2595 "ORDER BY $orderby",
2601 Returns the agent (see L<FS::agent>) for this customer.
2605 Returns the agent name (see L<FS::agent>) for this customer.
2611 $self->agent->agent;
2616 Returns any tags associated with this customer, as FS::cust_tag objects,
2617 or an empty list if there are no tags.
2621 Returns any tags associated with this customer, as FS::part_tag objects,
2622 or an empty list if there are no tags.
2628 map $_->part_tag, $self->cust_tag;
2634 Returns the customer class, as an FS::cust_class object, or the empty string
2635 if there is no customer class.
2639 Returns the customer category name, or the empty string if there is no customer
2646 my $cust_class = $self->cust_class;
2648 ? $cust_class->categoryname
2654 Returns the customer class name, or the empty string if there is no customer
2661 my $cust_class = $self->cust_class;
2663 ? $cust_class->classname
2669 Returns the external tax status, as an FS::tax_status object, or the empty
2670 string if there is no tax status.
2676 if ( $self->taxstatusnum ) {
2677 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2685 Returns the tax status code if there is one.
2691 my $tax_status = $self->tax_status;
2693 ? $tax_status->taxstatus
2697 =item BILLING METHODS
2699 Documentation on billing methods has been moved to
2700 L<FS::cust_main::Billing>.
2702 =item REALTIME BILLING METHODS
2704 Documentation on realtime billing methods has been moved to
2705 L<FS::cust_main::Billing_Realtime>.
2709 Removes the I<paycvv> field from the database directly.
2711 If there is an error, returns the error, otherwise returns false.
2713 DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
2719 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2720 or return dbh->errstr;
2721 $sth->execute($self->custnum)
2722 or return $sth->errstr;
2729 Returns the total owed for this customer on all invoices
2730 (see L<FS::cust_bill/owed>).
2736 $self->total_owed_date(2145859200); #12/31/2037
2739 =item total_owed_date TIME
2741 Returns the total owed for this customer on all invoices with date earlier than
2742 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2743 see L<Time::Local> and L<Date::Parse> for conversion functions.
2747 sub total_owed_date {
2751 my $custnum = $self->custnum;
2753 my $owed_sql = FS::cust_bill->owed_sql;
2756 SELECT SUM($owed_sql) FROM cust_bill
2757 WHERE custnum = $custnum
2761 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2765 =item total_owed_pkgnum PKGNUM
2767 Returns the total owed on all invoices for this customer's specific package
2768 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2772 sub total_owed_pkgnum {
2773 my( $self, $pkgnum ) = @_;
2774 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2777 =item total_owed_date_pkgnum TIME PKGNUM
2779 Returns the total owed for this customer's specific package when using
2780 experimental package balances on all invoices with date earlier than
2781 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2782 see L<Time::Local> and L<Date::Parse> for conversion functions.
2786 sub total_owed_date_pkgnum {
2787 my( $self, $time, $pkgnum ) = @_;
2790 foreach my $cust_bill (
2791 grep { $_->_date <= $time }
2792 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2794 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2796 sprintf( "%.2f", $total_bill );
2802 Returns the total amount of all payments.
2809 $total += $_->paid foreach $self->cust_pay;
2810 sprintf( "%.2f", $total );
2813 =item total_unapplied_credits
2815 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2816 customer. See L<FS::cust_credit/credited>.
2818 =item total_credited
2820 Old name for total_unapplied_credits. Don't use.
2824 sub total_credited {
2825 #carp "total_credited deprecated, use total_unapplied_credits";
2826 shift->total_unapplied_credits(@_);
2829 sub total_unapplied_credits {
2832 my $custnum = $self->custnum;
2834 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2837 SELECT SUM($unapplied_sql) FROM cust_credit
2838 WHERE custnum = $custnum
2841 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2845 =item total_unapplied_credits_pkgnum PKGNUM
2847 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2848 customer. See L<FS::cust_credit/credited>.
2852 sub total_unapplied_credits_pkgnum {
2853 my( $self, $pkgnum ) = @_;
2854 my $total_credit = 0;
2855 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2856 sprintf( "%.2f", $total_credit );
2860 =item total_unapplied_payments
2862 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2863 See L<FS::cust_pay/unapplied>.
2867 sub total_unapplied_payments {
2870 my $custnum = $self->custnum;
2872 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2875 SELECT SUM($unapplied_sql) FROM cust_pay
2876 WHERE custnum = $custnum
2879 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2883 =item total_unapplied_payments_pkgnum PKGNUM
2885 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2886 specific package when using experimental package balances. See
2887 L<FS::cust_pay/unapplied>.
2891 sub total_unapplied_payments_pkgnum {
2892 my( $self, $pkgnum ) = @_;
2893 my $total_unapplied = 0;
2894 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2895 sprintf( "%.2f", $total_unapplied );
2899 =item total_unapplied_refunds
2901 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2902 customer. See L<FS::cust_refund/unapplied>.
2906 sub total_unapplied_refunds {
2908 my $custnum = $self->custnum;
2910 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2913 SELECT SUM($unapplied_sql) FROM cust_refund
2914 WHERE custnum = $custnum
2917 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2923 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2924 total_unapplied_credits minus total_unapplied_payments).
2930 $self->balance_date_range;
2933 =item balance_date TIME
2935 Returns the balance for this customer, only considering invoices with date
2936 earlier than TIME (total_owed_date minus total_credited minus
2937 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2938 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2945 $self->balance_date_range(shift);
2948 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2950 Returns the balance for this customer, optionally considering invoices with
2951 date earlier than START_TIME, and not later than END_TIME
2952 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2954 Times are specified as SQL fragments or numeric
2955 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2956 L<Date::Parse> for conversion functions. The empty string can be passed
2957 to disable that time constraint completely.
2959 Accepts the same options as L<balance_date_sql>:
2963 =item unapplied_date
2965 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)
2969 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2970 time will be ignored. Note that START_TIME and END_TIME only limit the date
2971 range for invoices and I<unapplied> payments, credits, and refunds.
2977 sub balance_date_range {
2979 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2980 ') FROM cust_main WHERE custnum='. $self->custnum;
2981 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2984 =item balance_pkgnum PKGNUM
2986 Returns the balance for this customer's specific package when using
2987 experimental package balances (total_owed plus total_unrefunded, minus
2988 total_unapplied_credits minus total_unapplied_payments)
2992 sub balance_pkgnum {
2993 my( $self, $pkgnum ) = @_;
2996 $self->total_owed_pkgnum($pkgnum)
2997 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2998 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2999 - $self->total_unapplied_credits_pkgnum($pkgnum)
3000 - $self->total_unapplied_payments_pkgnum($pkgnum)
3006 Returns a hash of useful information for making a payment.
3016 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3017 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3018 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3022 For credit card transactions:
3034 For electronic check transactions:
3049 $return{balance} = $self->balance;
3051 $return{payname} = $self->payname
3052 || ( $self->first. ' '. $self->get('last') );
3054 $return{$_} = $self->bill_location->$_
3055 for qw(address1 address2 city state zip);
3057 $return{payby} = $self->payby;
3058 $return{stateid_state} = $self->stateid_state;
3060 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3061 $return{card_type} = cardtype($self->payinfo);
3062 $return{payinfo} = $self->paymask;
3064 @return{'month', 'year'} = $self->paydate_monthyear;
3068 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3069 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3070 $return{payinfo1} = $payinfo1;
3071 $return{payinfo2} = $payinfo2;
3072 $return{paytype} = $self->paytype;
3073 $return{paystate} = $self->paystate;
3077 #doubleclick protection
3079 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3087 Returns the next payment expiration date for this customer. If they have no
3088 payment methods that will expire, returns 0.
3094 # filter out the ones that individually return 0, but then return 0 if
3095 # there are no results
3096 my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
3097 min( @epochs ) || 0;
3100 =item paydate_epoch_sql
3102 Returns an SQL expression to get the next payment expiration date for a
3103 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
3104 dates, so that it's safe to test for "will it expire before date X" for any
3109 sub paydate_epoch_sql {
3111 my $paydate = FS::cust_payby->paydate_epoch_sql;
3112 "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
3116 my( $self, $taxname ) = @_;
3118 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3119 'taxname' => $taxname,
3124 =item cust_main_exemption
3126 =item invoicing_list
3128 Returns a list of email addresses (with svcnum entries expanded), and the word
3129 'POST' if the customer receives postal invoices.
3133 sub invoicing_list {
3134 my( $self, $arrayref ) = @_;
3137 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
3140 my @emails = $self->invoicing_list_emailonly;
3141 push @emails, 'POST' if $self->get('postal_invoice');
3146 =item check_invoicing_list ARRAYREF
3148 Checks these arguements as valid input for the invoicing_list method. If there
3149 is an error, returns the error, otherwise returns false.
3153 sub check_invoicing_list {
3154 my( $self, $arrayref ) = @_;
3156 foreach my $address ( @$arrayref ) {
3158 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3159 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3162 my $cust_main_invoice = new FS::cust_main_invoice ( {
3163 'custnum' => $self->custnum,
3166 my $error = $self->custnum
3167 ? $cust_main_invoice->check
3168 : $cust_main_invoice->checkdest
3170 return $error if $error;
3174 return "Email address required"
3175 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3176 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3183 Returns the email addresses of all accounts provisioned for this customer.
3190 foreach my $cust_pkg ( $self->all_pkgs ) {
3191 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3193 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3194 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3196 $list{$_}=1 foreach map { $_->email } @svc_acct;
3201 =item invoicing_list_addpost
3203 Adds postal invoicing to this customer. If this customer is already configured
3204 to receive postal invoices, does nothing.
3208 sub invoicing_list_addpost {
3210 if ( $self->get('postal_invoice') eq '' ) {
3211 $self->set('postal_invoice', 'Y');
3212 my $error = $self->replace;
3213 warn $error if $error; # should fail harder, but this is traditional
3217 =item invoicing_list_emailonly
3219 Returns the list of email invoice recipients (invoicing_list without non-email
3220 destinations such as POST and FAX).
3224 sub invoicing_list_emailonly {
3226 warn "$me invoicing_list_emailonly called"
3228 return () if !$self->custnum; # not yet inserted
3229 return map { $_->emailaddress }
3231 table => 'cust_contact',
3232 select => 'emailaddress',
3233 addl_from => ' JOIN contact USING (contactnum) '.
3234 ' JOIN contact_email USING (contactnum)',
3235 hashref => { 'custnum' => $self->custnum, },
3236 extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
3240 =item invoicing_list_emailonly_scalar
3242 Returns the list of email invoice recipients (invoicing_list without non-email
3243 destinations such as POST and FAX) as a comma-separated scalar.
3247 sub invoicing_list_emailonly_scalar {
3249 warn "$me invoicing_list_emailonly_scalar called"
3251 join(', ', $self->invoicing_list_emailonly);
3254 =item contact_list [ CLASSNUM, DEST_FLAG... ]
3256 Returns a list of contacts (L<FS::contact> objects) for the customer.
3258 If no arguments are given, returns all contacts for the customer.
3260 Arguments may contain classnums. When classnums are specified, only
3261 contacts with a matching cust_contact.classnum are returned. When a
3262 classnum of 0 is given, contacts with a null classnum are also included.
3264 Arguments may also contain the dest flag names 'invoice' or 'message'.
3265 If given, contacts who's invoice_dest and/or message_dest flags are
3266 not set to 'Y' will be excluded.
3274 select => join(', ',(
3276 'cust_contact.invoice_dest',
3277 'cust_contact.message_dest',
3279 addl_from => ' JOIN cust_contact USING (contactnum)',
3280 extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
3284 # Calling methods were relying on this method to use invoice_dest to
3285 # block e-mail messages. Depending on parameters, this may or may not
3286 # have actually happened.
3288 # The bug could cause this SQL to be used to filter e-mail addresses:
3291 # cust_contact.classnums IN (1,2,3)
3292 # OR cust_contact.invoice_dest = 'Y'
3295 # improperly including everybody with the opt-in flag AND everybody
3296 # in the contact classes
3298 # Possibility to introduce new bugs:
3299 # If callers of this method called it incorrectly, and didn't notice
3300 # because it seemed to send the e-mails they wanted.
3305 # cust_contact.classnum IN (1,2,3)
3307 # cust_contact.classnum IS NULL
3310 # cust_contact.invoice_dest = 'Y'
3312 # cust_contact.message_dest = 'Y'
3320 if ($_ eq 'invoice' || $_ eq 'message') {
3321 push @and_dest, " cust_contact.${_}_dest = 'Y' ";
3322 } elsif ($_ eq '0') {
3323 push @or_classnum, ' cust_contact.classnum IS NULL ';
3324 } elsif ( /^\d+$/ ) {
3325 push @classnums, $_;
3327 croak "bad classnum argument '$_'";
3331 push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
3334 if (@or_classnum || @and_dest) { # catch, no arguments given
3335 $search->{extra_sql} .= ' AND ( ';
3338 $search->{extra_sql} .= ' ( ';
3339 $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
3340 $search->{extra_sql} .= ' ) ';
3341 $search->{extra_sql} .= ' AND ( ' if @and_dest;
3345 $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
3346 $search->{extra_sql} .= ' ) ' if @or_classnum;
3349 $search->{extra_sql} .= ' ) ';
3351 warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
3357 =item contact_list_email [ CLASSNUM, ... ]
3359 Same as L</contact_list>, but returns email destinations instead of contact
3364 sub contact_list_email {
3366 my @contacts = $self->contact_list(@_);
3368 foreach my $contact (@contacts) {
3369 foreach my $contact_email ($contact->contact_email) {
3370 push @emails, Email::Address->new( $contact->firstlast,
3371 $contact_email->emailaddress
3378 =item referral_custnum_cust_main
3380 Returns the customer who referred this customer (or the empty string, if
3381 this customer was not referred).
3383 Note the difference with referral_cust_main method: This method,
3384 referral_custnum_cust_main returns the single customer (if any) who referred
3385 this customer, while referral_cust_main returns an array of customers referred
3390 sub referral_custnum_cust_main {
3392 return '' unless $self->referral_custnum;
3393 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3396 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3398 Returns an array of customers referred by this customer (referral_custnum set
3399 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3400 customers referred by customers referred by this customer and so on, inclusive.
3401 The default behavior is DEPTH 1 (no recursion).
3403 Note the difference with referral_custnum_cust_main method: This method,
3404 referral_cust_main, returns an array of customers referred BY this customer,
3405 while referral_custnum_cust_main returns the single customer (if any) who
3406 referred this customer.
3410 sub referral_cust_main {
3412 my $depth = @_ ? shift : 1;
3413 my $exclude = @_ ? shift : {};
3416 map { $exclude->{$_->custnum}++; $_; }
3417 grep { ! $exclude->{ $_->custnum } }
3418 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3422 map { $_->referral_cust_main($depth-1, $exclude) }
3429 =item referral_cust_main_ncancelled
3431 Same as referral_cust_main, except only returns customers with uncancelled
3436 sub referral_cust_main_ncancelled {
3438 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3441 =item referral_cust_pkg [ DEPTH ]
3443 Like referral_cust_main, except returns a flat list of all unsuspended (and
3444 uncancelled) packages for each customer. The number of items in this list may
3445 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3449 sub referral_cust_pkg {
3451 my $depth = @_ ? shift : 1;
3453 map { $_->unsuspended_pkgs }
3454 grep { $_->unsuspended_pkgs }
3455 $self->referral_cust_main($depth);
3458 =item referring_cust_main
3460 Returns the single cust_main record for the customer who referred this customer
3461 (referral_custnum), or false.
3465 sub referring_cust_main {
3467 return '' unless $self->referral_custnum;
3468 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3471 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3473 Applies a credit to this customer. If there is an error, returns the error,
3474 otherwise returns false.
3476 REASON can be a text string, an FS::reason object, or a scalar reference to
3477 a reasonnum. If a text string, it will be automatically inserted as a new
3478 reason, and a 'reason_type' option must be passed to indicate the
3479 FS::reason_type for the new reason.
3481 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3482 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3483 I<commission_pkgnum>.
3485 Any other options are passed to FS::cust_credit::insert.
3490 my( $self, $amount, $reason, %options ) = @_;
3492 my $cust_credit = new FS::cust_credit {
3493 'custnum' => $self->custnum,
3494 'amount' => $amount,
3497 if ( ref($reason) ) {
3499 if ( ref($reason) eq 'SCALAR' ) {
3500 $cust_credit->reasonnum( $$reason );
3502 $cust_credit->reasonnum( $reason->reasonnum );
3506 $cust_credit->set('reason', $reason)
3509 $cust_credit->$_( delete $options{$_} )
3510 foreach grep exists($options{$_}),
3511 qw( addlinfo eventnum ),
3512 map "commission_$_", qw( agentnum salesnum pkgnum );
3514 $cust_credit->insert(%options);
3518 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3520 Creates a one-time charge for this customer. If there is an error, returns
3521 the error, otherwise returns false.
3523 New-style, with a hashref of options:
3525 my $error = $cust_main->charge(
3529 'start_date' => str2time('7/4/2009'),
3530 'pkg' => 'Description',
3531 'comment' => 'Comment',
3532 'additional' => [], #extra invoice detail
3533 'classnum' => 1, #pkg_class
3535 'setuptax' => '', # or 'Y' for tax exempt
3537 'locationnum'=> 1234, # optional
3540 'taxclass' => 'Tax class',
3543 'taxproduct' => 2, #part_pkg_taxproduct
3544 'override' => {}, #XXX describe
3546 #will be filled in with the new object
3547 'cust_pkg_ref' => \$cust_pkg,
3549 #generate an invoice immediately
3551 'invoice_terms' => '', #with these terms
3557 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3561 #super false laziness w/quotation::charge
3564 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3565 my ( $pkg, $comment, $additional );
3566 my ( $setuptax, $taxclass ); #internal taxes
3567 my ( $taxproduct, $override ); #vendor (CCH) taxes
3569 my $separate_bill = '';
3570 my $cust_pkg_ref = '';
3571 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3573 my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3574 if ( ref( $_[0] ) ) {
3575 $amount = $_[0]->{amount};
3576 $setup_cost = $_[0]->{setup_cost};
3577 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3578 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3579 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3580 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3581 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3582 : '$'. sprintf("%.2f",$amount);
3583 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3584 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3585 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3586 $additional = $_[0]->{additional} || [];
3587 $taxproduct = $_[0]->{taxproductnum};
3588 $override = { '' => $_[0]->{tax_override} };
3589 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3590 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3591 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3592 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3593 $separate_bill = $_[0]->{separate_bill} || '';
3594 $discountnum = $_[0]->{setup_discountnum};
3595 $discountnum_amount = $_[0]->{setup_discountnum_amount};
3596 $discountnum_percent = $_[0]->{setup_discountnum_percent};
3602 $pkg = @_ ? shift : 'One-time charge';
3603 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3605 $taxclass = @_ ? shift : '';
3609 local $SIG{HUP} = 'IGNORE';
3610 local $SIG{INT} = 'IGNORE';
3611 local $SIG{QUIT} = 'IGNORE';
3612 local $SIG{TERM} = 'IGNORE';
3613 local $SIG{TSTP} = 'IGNORE';
3614 local $SIG{PIPE} = 'IGNORE';
3616 my $oldAutoCommit = $FS::UID::AutoCommit;
3617 local $FS::UID::AutoCommit = 0;
3620 my $part_pkg = new FS::part_pkg ( {
3622 'comment' => $comment,
3626 'classnum' => ( $classnum ? $classnum : '' ),
3627 'setuptax' => $setuptax,
3628 'taxclass' => $taxclass,
3629 'taxproductnum' => $taxproduct,
3630 'setup_cost' => $setup_cost,
3633 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3634 ( 0 .. @$additional - 1 )
3636 'additional_count' => scalar(@$additional),
3637 'setup_fee' => $amount,
3640 my $error = $part_pkg->insert( options => \%options,
3641 tax_overrides => $override,
3644 $dbh->rollback if $oldAutoCommit;
3648 my $pkgpart = $part_pkg->pkgpart;
3649 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3650 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3651 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3652 $error = $type_pkgs->insert;
3654 $dbh->rollback if $oldAutoCommit;
3659 my $cust_pkg = new FS::cust_pkg ( {
3660 'custnum' => $self->custnum,
3661 'pkgpart' => $pkgpart,
3662 'quantity' => $quantity,
3663 'start_date' => $start_date,
3664 'no_auto' => $no_auto,
3665 'separate_bill' => $separate_bill,
3666 'locationnum' => $locationnum,
3667 'setup_discountnum' => $discountnum,
3668 'setup_discountnum_amount' => $discountnum_amount,
3669 'setup_discountnum_percent' => $discountnum_percent,
3672 $error = $cust_pkg->insert;
3674 $dbh->rollback if $oldAutoCommit;
3676 } elsif ( $cust_pkg_ref ) {
3677 ${$cust_pkg_ref} = $cust_pkg;
3681 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3682 'pkg_list' => [ $cust_pkg ],
3685 $dbh->rollback if $oldAutoCommit;
3690 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3695 #=item charge_postal_fee
3697 #Applies a one time charge this customer. If there is an error,
3698 #returns the error, returns the cust_pkg charge object or false
3699 #if there was no charge.
3703 # This should be a customer event. For that to work requires that bill
3704 # also be a customer event.
3706 sub charge_postal_fee {
3709 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3710 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3712 my $cust_pkg = new FS::cust_pkg ( {
3713 'custnum' => $self->custnum,
3714 'pkgpart' => $pkgpart,
3718 my $error = $cust_pkg->insert;
3719 $error ? $error : $cust_pkg;
3722 =item num_cust_attachment_deleted
3724 Returns the number of deleted attachments for this customer (see
3725 L<FS::num_cust_attachment>).
3729 sub num_cust_attachments_deleted {
3732 " SELECT COUNT(*) FROM cust_attachment ".
3733 " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3740 Returns the most recent invnum (invoice number) for this customer.
3747 " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3752 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3754 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3756 Optionally, a list or hashref of additional arguments to the qsearch call can
3763 my $opt = ref($_[0]) ? shift : { @_ };
3765 #return $self->num_cust_bill unless wantarray || keys %$opt;
3767 $opt->{'table'} = 'cust_bill';
3768 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3769 $opt->{'hashref'}{'custnum'} = $self->custnum;
3770 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3772 map { $_ } #behavior of sort undefined in scalar context
3773 sort { $a->_date <=> $b->_date }
3777 =item open_cust_bill
3779 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3784 sub open_cust_bill {
3788 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3794 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3796 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3800 sub legacy_cust_bill {
3803 #return $self->num_legacy_cust_bill unless wantarray;
3805 map { $_ } #behavior of sort undefined in scalar context
3806 sort { $a->_date <=> $b->_date }
3807 qsearch({ 'table' => 'legacy_cust_bill',
3808 'hashref' => { 'custnum' => $self->custnum, },
3809 'order_by' => 'ORDER BY _date ASC',
3813 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3815 Returns all the statements (see L<FS::cust_statement>) for this customer.
3817 Optionally, a list or hashref of additional arguments to the qsearch call can
3822 =item cust_bill_void
3824 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3828 sub cust_bill_void {
3831 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3832 sort { $a->_date <=> $b->_date }
3833 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3836 sub cust_statement {
3838 my $opt = ref($_[0]) ? shift : { @_ };
3840 #return $self->num_cust_statement unless wantarray || keys %$opt;
3842 $opt->{'table'} = 'cust_statement';
3843 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3844 $opt->{'hashref'}{'custnum'} = $self->custnum;
3845 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3847 map { $_ } #behavior of sort undefined in scalar context
3848 sort { $a->_date <=> $b->_date }
3852 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3854 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3856 Optionally, a list or hashref of additional arguments to the qsearch call can
3857 be passed following the SVCDB.
3864 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3865 warn "$me svc_x requires a svcdb";
3868 my $opt = ref($_[0]) ? shift : { @_ };
3870 $opt->{'table'} = $svcdb;
3871 $opt->{'addl_from'} =
3872 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3873 ($opt->{'addl_from'} || '');
3875 my $custnum = $self->custnum;
3876 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3877 my $where = "cust_pkg.custnum = $custnum";
3879 my $extra_sql = $opt->{'extra_sql'} || '';
3880 if ( keys %{ $opt->{'hashref'} } ) {
3881 $extra_sql = " AND $where $extra_sql";
3884 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3885 $extra_sql = "WHERE $where AND $1";
3888 $extra_sql = "WHERE $where $extra_sql";
3891 $opt->{'extra_sql'} = $extra_sql;
3896 # required for use as an eventtable;
3899 $self->svc_x('svc_acct', @_);
3904 Returns all the credits (see L<FS::cust_credit>) for this customer.
3911 #return $self->num_cust_credit unless wantarray;
3913 map { $_ } #behavior of sort undefined in scalar context
3914 sort { $a->_date <=> $b->_date }
3915 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3918 =item cust_credit_pkgnum
3920 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3921 package when using experimental package balances.
3925 sub cust_credit_pkgnum {
3926 my( $self, $pkgnum ) = @_;
3927 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3928 sort { $a->_date <=> $b->_date }
3929 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3930 'pkgnum' => $pkgnum,
3935 =item cust_credit_void
3937 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3941 sub cust_credit_void {
3944 sort { $a->_date <=> $b->_date }
3945 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3950 Returns all the payments (see L<FS::cust_pay>) for this customer.
3956 my $opt = ref($_[0]) ? shift : { @_ };
3958 return $self->num_cust_pay unless wantarray || keys %$opt;
3960 $opt->{'table'} = 'cust_pay';
3961 $opt->{'hashref'}{'custnum'} = $self->custnum;
3963 map { $_ } #behavior of sort undefined in scalar context
3964 sort { $a->_date <=> $b->_date }
3971 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3972 called automatically when the cust_pay method is used in a scalar context.
3978 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3979 my $sth = dbh->prepare($sql) or die dbh->errstr;
3980 $sth->execute($self->custnum) or die $sth->errstr;
3981 $sth->fetchrow_arrayref->[0];
3984 =item unapplied_cust_pay
3986 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3990 sub unapplied_cust_pay {
3994 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
4000 =item cust_pay_pkgnum
4002 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4003 package when using experimental package balances.
4007 sub cust_pay_pkgnum {
4008 my( $self, $pkgnum ) = @_;
4009 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4010 sort { $a->_date <=> $b->_date }
4011 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4012 'pkgnum' => $pkgnum,
4019 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4025 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4026 sort { $a->_date <=> $b->_date }
4027 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4030 =item cust_pay_pending
4032 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4033 (without status "done").
4037 sub cust_pay_pending {
4039 return $self->num_cust_pay_pending unless wantarray;
4040 sort { $a->_date <=> $b->_date }
4041 qsearch( 'cust_pay_pending', {
4042 'custnum' => $self->custnum,
4043 'status' => { op=>'!=', value=>'done' },
4048 =item cust_pay_pending_attempt
4050 Returns all payment attempts / declined payments for this customer, as pending
4051 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4052 a corresponding payment (see L<FS::cust_pay>).
4056 sub cust_pay_pending_attempt {
4058 return $self->num_cust_pay_pending_attempt unless wantarray;
4059 sort { $a->_date <=> $b->_date }
4060 qsearch( 'cust_pay_pending', {
4061 'custnum' => $self->custnum,
4068 =item num_cust_pay_pending
4070 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4071 customer (without status "done"). Also called automatically when the
4072 cust_pay_pending method is used in a scalar context.
4076 sub num_cust_pay_pending {
4079 " SELECT COUNT(*) FROM cust_pay_pending ".
4080 " WHERE custnum = ? AND status != 'done' ",
4085 =item num_cust_pay_pending_attempt
4087 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4088 customer, with status "done" but without a corresp. Also called automatically when the
4089 cust_pay_pending method is used in a scalar context.
4093 sub num_cust_pay_pending_attempt {
4096 " SELECT COUNT(*) FROM cust_pay_pending ".
4097 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4104 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4110 map { $_ } #return $self->num_cust_refund unless wantarray;
4111 sort { $a->_date <=> $b->_date }
4112 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4115 =item display_custnum
4117 Returns the displayed customer number for this customer: agent_custid if
4118 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4122 sub display_custnum {
4125 return $self->agent_custid
4126 if $default_agent_custid && $self->agent_custid;
4128 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4132 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
4133 } elsif ( $custnum_display_length ) {
4134 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
4136 return $self->custnum;
4142 Returns a name string for this customer, either "Company (Last, First)" or
4149 my $name = $self->contact;
4150 $name = $self->company. " ($name)" if $self->company;
4154 =item batch_payment_payname
4156 Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
4157 based on if a company name exists and is the account being used a business account.
4161 sub batch_payment_payname {
4163 my $cust_pay_batch = shift;
4166 if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
4167 else { $name = $self->first .' '. $self->last; }
4169 $name = $self->company
4170 if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
4175 =item service_contact
4177 Returns the L<FS::contact> object for this customer that has the 'Service'
4178 contact class, or undef if there is no such contact. Deprecated; don't use
4183 sub service_contact {
4185 if ( !exists($self->{service_contact}) ) {
4186 my $classnum = $self->scalar_sql(
4187 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4188 ) || 0; #if it's zero, qsearchs will return nothing
4189 my $cust_contact = qsearchs('cust_contact', {
4190 'classnum' => $classnum,
4191 'custnum' => $self->custnum,
4193 $self->{service_contact} = $cust_contact->contact if $cust_contact;
4195 $self->{service_contact};
4200 Returns a name string for this (service/shipping) contact, either
4201 "Company (Last, First)" or "Last, First".
4208 my $name = $self->ship_contact;
4209 $name = $self->company. " ($name)" if $self->company;
4215 Returns a name string for this customer, either "Company" or "First Last".
4221 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4224 =item ship_name_short
4226 Returns a name string for this (service/shipping) contact, either "Company"
4231 sub ship_name_short {
4233 $self->service_contact
4234 ? $self->ship_contact_firstlast
4240 Returns this customer's full (billing) contact name only, "Last, First"
4246 $self->get('last'). ', '. $self->first;
4251 Returns this customer's full (shipping) contact name only, "Last, First"
4257 my $contact = $self->service_contact || $self;
4258 $contact->get('last') . ', ' . $contact->get('first');
4261 =item contact_firstlast
4263 Returns this customers full (billing) contact name only, "First Last".
4267 sub contact_firstlast {
4269 $self->first. ' '. $self->get('last');
4272 =item ship_contact_firstlast
4274 Returns this customer's full (shipping) contact name only, "First Last".
4278 sub ship_contact_firstlast {
4280 my $contact = $self->service_contact || $self;
4281 $contact->get('first') . ' '. $contact->get('last');
4284 sub bill_country_full {
4286 $self->bill_location->country_full;
4289 sub ship_country_full {
4291 $self->ship_location->country_full;
4294 =item county_state_county [ PREFIX ]
4296 Returns a string consisting of just the county, state and country.
4300 sub county_state_country {
4303 if ( @_ && $_[0] && $self->has_ship_address ) {
4304 $locationnum = $self->ship_locationnum;
4306 $locationnum = $self->bill_locationnum;
4308 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4309 $cust_location->county_state_country;
4312 =item geocode DATA_VENDOR
4314 Returns a value for the customer location as encoded by DATA_VENDOR.
4315 Currently this only makes sense for "CCH" as DATA_VENDOR.
4323 Returns a status string for this customer, currently:
4329 No packages have ever been ordered. Displayed as "No packages".
4333 Recurring packages all are new (not yet billed).
4337 One or more recurring packages is active.
4341 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4345 All non-cancelled recurring packages are suspended.
4349 All recurring packages are cancelled.
4353 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4354 cust_main-status_module configuration option.
4358 sub status { shift->cust_status(@_); }
4362 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4363 for my $status ( FS::cust_main->statuses() ) {
4364 my $method = $status.'_sql';
4365 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4366 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4367 $sth->execute( ($self->custnum) x $numnum )
4368 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4369 if ( $sth->fetchrow_arrayref->[0] ) {
4370 $self->hashref->{cust_status} = $status;
4376 =item is_status_delay_cancel
4378 Returns true if customer status is 'suspended'
4379 and all suspended cust_pkg return true for
4380 cust_pkg->is_status_delay_cancel.
4382 This is not a real status, this only meant for hacking display
4383 values, because otherwise treating the customer as suspended is
4384 really the whole point of the delay_cancel option.
4388 sub is_status_delay_cancel {
4390 return 0 unless $self->status eq 'suspended';
4391 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4392 return 0 unless $cust_pkg->is_status_delay_cancel;
4397 =item ucfirst_cust_status
4399 =item ucfirst_status
4401 Deprecated, use the cust_status_label method instead.
4403 Returns the status with the first character capitalized.
4407 sub ucfirst_status {
4408 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4409 local($ucfirst_nowarn) = 1;
4410 shift->ucfirst_cust_status(@_);
4413 sub ucfirst_cust_status {
4414 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4416 ucfirst($self->cust_status);
4419 =item cust_status_label
4423 Returns the display label for this status.
4427 sub status_label { shift->cust_status_label(@_); }
4429 sub cust_status_label {
4431 __PACKAGE__->statuslabels->{$self->cust_status};
4436 Returns a hex triplet color string for this customer's status.
4440 sub statuscolor { shift->cust_statuscolor(@_); }
4442 sub cust_statuscolor {
4444 __PACKAGE__->statuscolors->{$self->cust_status};
4447 =item tickets [ STATUS ]
4449 Returns an array of hashes representing the customer's RT tickets.
4451 An optional status (or arrayref or hashref of statuses) may be specified.
4457 my $status = ( @_ && $_[0] ) ? shift : '';
4459 my $num = $conf->config('cust_main-max_tickets') || 10;
4462 if ( $conf->config('ticket_system') ) {
4463 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4465 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4474 foreach my $priority (
4475 $conf->config('ticket_system-custom_priority_field-values'), ''
4477 last if scalar(@tickets) >= $num;
4479 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4480 $num - scalar(@tickets),
4491 =item appointments [ STATUS ]
4493 Returns an array of hashes representing the customer's RT tickets which
4500 my $status = ( @_ && $_[0] ) ? shift : '';
4502 return () unless $conf->config('ticket_system');
4504 my $queueid = $conf->config('ticket_system-appointment-queueid');
4506 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4515 # Return services representing svc_accts in customer support packages
4516 sub support_services {
4518 my %packages = map { $_ => 1 } $conf->config('support_packages');
4520 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4521 grep { $_->part_svc->svcdb eq 'svc_acct' }
4522 map { $_->cust_svc }
4523 grep { exists $packages{ $_->pkgpart } }
4524 $self->ncancelled_pkgs;
4528 # Return a list of latitude/longitude for one of the services (if any)
4529 sub service_coordinates {
4533 grep { $_->latitude && $_->longitude }
4535 map { $_->cust_svc }
4536 $self->ncancelled_pkgs;
4538 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4543 Returns a masked version of the named field
4548 my ($self,$field) = @_;
4552 'x'x(length($self->getfield($field))-4).
4553 substr($self->getfield($field), (length($self->getfield($field))-4));
4557 =item payment_history
4559 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4560 cust_credit and cust_refund objects. Each hashref has the following fields:
4562 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4564 I<date> - value of _date field, unix timestamp
4566 I<date_pretty> - user-friendly date
4568 I<description> - user-friendly description of item
4570 I<amount> - impact of item on user's balance
4571 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4572 Not to be confused with the native 'amount' field in cust_credit, see below.
4574 I<amount_pretty> - includes money char
4576 I<balance> - customer balance, chronologically as of this item
4578 I<balance_pretty> - includes money char
4580 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4582 I<paid> - amount paid for cust_pay records, undef for other types
4584 I<credit> - amount credited for cust_credit records, undef for other types.
4585 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4587 I<refund> - amount refunded for cust_refund records, undef for other types
4589 The four table-specific keys always have positive values, whether they reflect charges or payments.
4591 The following options may be passed to this method:
4593 I<line_items> - if true, returns charges ('Line item') rather than invoices
4595 I<start_date> - unix timestamp, only include records on or after.
4596 If specified, an item of type 'Previous' will also be included.
4597 It does not have table-specific fields.
4599 I<end_date> - unix timestamp, only include records before
4601 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4603 I<conf> - optional already-loaded FS::Conf object.
4607 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4608 # and also for sending customer statements, which should both be kept customer-friendly.
4609 # If you add anything that shouldn't be passed on through the API or exposed
4610 # to customers, add a new option to include it, don't include it by default
4611 sub payment_history {
4613 my $opt = ref($_[0]) ? $_[0] : { @_ };
4615 my $conf = $$opt{'conf'} || new FS::Conf;
4616 my $money_char = $conf->config("money_char") || '$',
4618 #first load entire history,
4619 #need previous to calculate previous balance
4620 #loading after end_date shouldn't hurt too much?
4622 if ( $$opt{'line_items'} ) {
4624 foreach my $cust_bill ( $self->cust_bill ) {
4627 'type' => 'Line item',
4628 'description' => $_->desc( $self->locale ).
4629 ( $_->sdate && $_->edate
4630 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4631 ' To '. time2str('%d-%b-%Y', $_->edate)
4634 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4635 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4636 'date' => $cust_bill->_date,
4637 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4639 foreach $cust_bill->cust_bill_pkg;
4646 'type' => 'Invoice',
4647 'description' => 'Invoice #'. $_->display_invnum,
4648 'amount' => sprintf('%.2f', $_->charged ),
4649 'charged' => sprintf('%.2f', $_->charged ),
4650 'date' => $_->_date,
4651 'date_pretty' => $self->time2str_local('short', $_->_date ),
4653 foreach $self->cust_bill;
4658 'type' => 'Payment',
4659 'description' => 'Payment', #XXX type
4660 'amount' => sprintf('%.2f', 0 - $_->paid ),
4661 'paid' => sprintf('%.2f', $_->paid ),
4662 'date' => $_->_date,
4663 'date_pretty' => $self->time2str_local('short', $_->_date ),
4665 foreach $self->cust_pay;
4669 'description' => 'Credit', #more info?
4670 'amount' => sprintf('%.2f', 0 -$_->amount ),
4671 'credit' => sprintf('%.2f', $_->amount ),
4672 'date' => $_->_date,
4673 'date_pretty' => $self->time2str_local('short', $_->_date ),
4675 foreach $self->cust_credit;
4679 'description' => 'Refund', #more info? type, like payment?
4680 'amount' => $_->refund,
4681 'refund' => $_->refund,
4682 'date' => $_->_date,
4683 'date_pretty' => $self->time2str_local('short', $_->_date ),
4685 foreach $self->cust_refund;
4687 #put it all in chronological order
4688 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4690 #calculate balance, filter items outside date range
4694 foreach my $item (@history) {
4695 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4696 $balance += $$item{'amount'};
4697 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4698 $previous += $$item{'amount'};
4701 $$item{'balance'} = sprintf("%.2f",$balance);
4702 foreach my $key ( qw(amount balance) ) {
4703 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4708 # start with previous balance, if there was one
4711 'type' => 'Previous',
4712 'description' => 'Previous balance',
4713 'amount' => sprintf("%.2f",$previous),
4714 'balance' => sprintf("%.2f",$previous),
4715 'date' => $$opt{'start_date'},
4716 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4718 #false laziness with above
4719 foreach my $key ( qw(amount balance) ) {
4720 $$item{$key.'_pretty'} = $$item{$key};
4721 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4723 unshift(@out,$item);
4726 @out = reverse @history if $$opt{'reverse_sort'};
4731 =item save_cust_payby
4733 Saves a new cust_payby for this customer, replacing an existing entry only
4734 in select circumstances. Does not validate input.
4736 If auto is specified, marks this as the customer's primary method, or the
4737 specified weight. Existing payment methods have their weight incremented as
4740 If bill_location is specified with auto, also sets location in cust_main.
4742 Will not insert complete duplicates of existing records, or records in which the
4743 only difference from an existing record is to turn off automatic payment (will
4744 return without error.) Will replace existing records in which the only difference
4745 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4746 Fields marked as preserved are optional, and existing values will not be overwritten with
4747 blanks when replacing.
4749 Accepts the following named parameters:
4759 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4763 optional, set higher than 1 for secondary, etc.
4771 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4779 optional, will be preserved when replacing
4787 CARD only, required, FS::cust_location object
4789 =item paystart_month
4791 CARD only, optional, will be preserved when replacing
4795 CARD only, optional, will be preserved when replacing
4799 CARD only, optional, will be preserved when replacing
4803 CARD only, only used if conf cvv-save is set appropriately
4813 =item saved_cust_payby
4815 scalar reference, for returning saved object
4821 #The code for this option is in place, but it's not currently used
4825 # existing cust_payby object to be replaced (must match custnum)
4827 # stateid/stateid_state/ss are not currently supported in cust_payby,
4828 # might not even work properly in 4.x, but will need to work here if ever added
4830 sub save_cust_payby {
4834 my $old = $opt{'replace'};
4835 my $new = new FS::cust_payby { $old ? $old->hash : () };
4836 return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4837 $new->set( 'custnum' => $self->custnum );
4839 my $payby = $opt{'payment_payby'};
4840 return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4842 # don't allow turning off auto when replacing
4843 $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4845 my @check_existing; # payby relevant to this payment_payby
4847 # set payby based on auto
4848 if ( $payby eq 'CARD' ) {
4849 $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4850 @check_existing = qw( CARD DCRD );
4851 } elsif ( $payby eq 'CHEK' ) {
4852 $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4853 @check_existing = qw( CHEK DCHK );
4856 $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4859 $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4860 $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4861 $new->set( 'payname' => $opt{'payname'} );
4862 $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4864 my $conf = new FS::Conf;
4866 # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4867 if ( $payby eq 'CARD' &&
4868 ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4869 || $conf->exists('business-onlinepayment-verification')
4872 $new->set( 'paycvv' => $opt{'paycvv'} );
4874 $new->set( 'paycvv' => '');
4877 local $SIG{HUP} = 'IGNORE';
4878 local $SIG{INT} = 'IGNORE';
4879 local $SIG{QUIT} = 'IGNORE';
4880 local $SIG{TERM} = 'IGNORE';
4881 local $SIG{TSTP} = 'IGNORE';
4882 local $SIG{PIPE} = 'IGNORE';
4884 my $oldAutoCommit = $FS::UID::AutoCommit;
4885 local $FS::UID::AutoCommit = 0;
4888 # set fields specific to payment_payby
4889 if ( $payby eq 'CARD' ) {
4890 if ($opt{'bill_location'}) {
4891 $opt{'bill_location'}->set('custnum' => $self->custnum);
4892 my $error = $opt{'bill_location'}->find_or_insert;
4894 $dbh->rollback if $oldAutoCommit;
4897 $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4899 foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4900 $new->set( $field => $opt{$field} );
4903 foreach my $field ( qw(paytype paystate) ) {
4904 $new->set( $field => $opt{$field} );
4908 # other cust_payby to compare this to
4909 my @existing = $self->cust_payby(@check_existing);
4911 # fields that can overwrite blanks with values, but not values with blanks
4912 my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4914 my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4916 # generally, we don't want to overwrite existing cust_payby with this,
4917 # but we can replace if we're only marking it auto or adding a preserved field
4918 # and we can avoid saving a total duplicate or merely turning off auto
4920 foreach my $cust_payby (@existing) {
4921 # check fields that absolutely should not change
4922 foreach my $field ($new->fields) {
4923 next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4924 next if grep(/^$field$/, @preserve );
4925 next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4926 # check if paymask exists, if so stop and don't save, no need for a duplicate.
4927 return '' if $new->get('paymask') eq $cust_payby->get('paymask');
4929 # now check fields that can replace if one value is blank
4931 foreach my $field (@preserve) {
4933 ( $new->get($field) and !$cust_payby->get($field) ) or
4934 ( $cust_payby->get($field) and !$new->get($field) )
4936 # prevention of overwriting values with blanks happens farther below
4938 } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4942 unless ( $replace ) {
4943 # nearly identical, now check weight
4944 if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4945 # ignore identical cust_payby, and ignore attempts to turn off auto
4946 # no need to save or re-weight cust_payby (but still need to update/commit $self)
4947 $skip_cust_payby = 1;
4950 # otherwise, only change is to mark this as primary
4952 # if we got this far, we're definitely replacing
4959 $new->set( 'custpaybynum' => $old->custpaybynum );
4960 # don't turn off automatic payment (but allow it to be turned on)
4961 if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4963 $new->set( 'payby' => $old->payby );
4964 $new->set( 'weight' => 1 );
4966 # make sure we're not overwriting values with blanks
4967 foreach my $field (@preserve) {
4968 if ( $old->get($field) and !$new->get($field) ) {
4969 $new->set( $field => $old->get($field) );
4974 # only overwrite cust_main bill_location if auto
4975 if ($opt{'auto'} && $opt{'bill_location'}) {
4976 $self->set('bill_location' => $opt{'bill_location'});
4977 my $error = $self->replace;
4979 $dbh->rollback if $oldAutoCommit;
4984 # done with everything except reweighting and saving cust_payby
4985 # still need to commit changes to cust_main and cust_location
4986 if ($skip_cust_payby) {
4987 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4991 # re-weight existing primary cust_pay for this payby
4993 foreach my $cust_payby (@existing) {
4994 # relies on cust_payby return order
4995 last unless $cust_payby->payby !~ /^D/;
4996 last if $cust_payby->weight > 1;
4997 next if $new->custpaybynum eq $cust_payby->custpaybynum;
4998 next if $cust_payby->weight < ($opt{'weight'} || 1);
4999 $cust_payby->weight( $cust_payby->weight + 1 );
5000 my $error = $cust_payby->replace;
5002 $dbh->rollback if $oldAutoCommit;
5003 return "Error reweighting cust_payby: $error";
5008 # finally, save cust_payby
5009 my $error = $old ? $new->replace($old) : $new->insert;
5011 $dbh->rollback if $oldAutoCommit;
5015 ${$opt{'saved_cust_payby'}} = $new
5016 if $opt{'saved_cust_payby'};
5018 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5023 =item remove_cvv_from_cust_payby PAYINFO
5025 Removes paycvv from associated cust_payby with matching PAYINFO.
5029 sub remove_cvv_from_cust_payby {
5030 my ($self,$payinfo) = @_;
5032 my $oldAutoCommit = $FS::UID::AutoCommit;
5033 local $FS::UID::AutoCommit = 0;
5036 foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
5037 next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
5038 $cust_payby->paycvv('');
5039 my $error = $cust_payby->replace;
5041 $dbh->rollback if $oldAutoCommit;
5046 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5052 =head1 CLASS METHODS
5058 Class method that returns the list of possible status strings for customers
5059 (see L<the status method|/status>). For example:
5061 @statuses = FS::cust_main->statuses();
5067 keys %{ $self->statuscolors };
5070 =item cust_status_sql
5072 Returns an SQL fragment to determine the status of a cust_main record, as a
5077 sub cust_status_sql {
5079 for my $status ( FS::cust_main->statuses() ) {
5080 my $method = $status.'_sql';
5081 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
5090 Returns an SQL expression identifying prospective cust_main records (customers
5091 with no packages ever ordered)
5095 use vars qw($select_count_pkgs);
5096 $select_count_pkgs =
5097 "SELECT COUNT(*) FROM cust_pkg
5098 WHERE cust_pkg.custnum = cust_main.custnum";
5100 sub select_count_pkgs_sql {
5105 " 0 = ( $select_count_pkgs ) ";
5110 Returns an SQL expression identifying ordered cust_main records (customers with
5111 no active packages, but recurring packages not yet setup or one time charges
5117 FS::cust_main->none_active_sql.
5118 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
5123 Returns an SQL expression identifying active cust_main records (customers with
5124 active recurring packages).
5129 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5132 =item none_active_sql
5134 Returns an SQL expression identifying cust_main records with no active
5135 recurring packages. This includes customers of status prospect, ordered,
5136 inactive, and suspended.
5140 sub none_active_sql {
5141 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5146 Returns an SQL expression identifying inactive cust_main records (customers with
5147 no active recurring packages, but otherwise unsuspended/uncancelled).
5152 FS::cust_main->none_active_sql.
5153 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
5159 Returns an SQL expression identifying suspended cust_main records.
5164 sub suspended_sql { susp_sql(@_); }
5166 FS::cust_main->none_active_sql.
5167 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
5173 Returns an SQL expression identifying cancelled cust_main records.
5177 sub cancel_sql { shift->cancelled_sql(@_); }
5180 =item uncancelled_sql
5182 Returns an SQL expression identifying un-cancelled cust_main records.
5186 sub uncancelled_sql { uncancel_sql(@_); }
5189 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
5194 Returns an SQL fragment to retreive the balance.
5199 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5200 WHERE cust_bill.custnum = cust_main.custnum )
5201 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5202 WHERE cust_pay.custnum = cust_main.custnum )
5203 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5204 WHERE cust_credit.custnum = cust_main.custnum )
5205 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5206 WHERE cust_refund.custnum = cust_main.custnum )
5209 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
5211 Returns an SQL fragment to retreive the balance for this customer, optionally
5212 considering invoices with date earlier than START_TIME, and not
5213 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5214 total_unapplied_payments).
5216 Times are specified as SQL fragments or numeric
5217 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5218 L<Date::Parse> for conversion functions. The empty string can be passed
5219 to disable that time constraint completely.
5221 Available options are:
5225 =item unapplied_date
5227 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)
5232 set to true to remove all customer comparison clauses, for totals
5237 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5242 JOIN clause (typically used with the total option)
5246 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5247 time will be ignored. Note that START_TIME and END_TIME only limit the date
5248 range for invoices and I<unapplied> payments, credits, and refunds.
5254 sub balance_date_sql {
5255 my( $class, $start, $end, %opt ) = @_;
5257 my $cutoff = $opt{'cutoff'};
5259 my $owed = FS::cust_bill->owed_sql($cutoff);
5260 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5261 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5262 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5264 my $j = $opt{'join'} || '';
5266 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5267 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5268 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5269 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5271 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5272 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5273 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5274 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5279 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5281 Returns an SQL fragment to retreive the total unapplied payments for this
5282 customer, only considering payments with date earlier than START_TIME, and
5283 optionally not later than END_TIME.
5285 Times are specified as SQL fragments or numeric
5286 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5287 L<Date::Parse> for conversion functions. The empty string can be passed
5288 to disable that time constraint completely.
5290 Available options are:
5294 sub unapplied_payments_date_sql {
5295 my( $class, $start, $end, %opt ) = @_;
5297 my $cutoff = $opt{'cutoff'};
5299 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5301 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5302 'unapplied_date'=>1 );
5304 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5307 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5309 Helper method for balance_date_sql; name (and usage) subject to change
5310 (suggestions welcome).
5312 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5313 cust_refund, cust_credit or cust_pay).
5315 If TABLE is "cust_bill" or the unapplied_date option is true, only
5316 considers records with date earlier than START_TIME, and optionally not
5317 later than END_TIME .
5321 sub _money_table_where {
5322 my( $class, $table, $start, $end, %opt ) = @_;
5325 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5326 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5327 push @where, "$table._date <= $start" if defined($start) && length($start);
5328 push @where, "$table._date > $end" if defined($end) && length($end);
5330 push @where, @{$opt{'where'}} if $opt{'where'};
5331 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5337 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5338 use FS::cust_main::Search;
5341 FS::cust_main::Search->search(@_);
5350 #=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5352 #Deprecated. Use event notification and message templates
5353 #(L<FS::msg_template>) instead.
5355 #Sends a templated email notification to the customer (see L<Text::Template>).
5357 #OPTIONS is a hash and may include
5359 #I<from> - the email sender (default is invoice_from)
5361 #I<to> - comma-separated scalar or arrayref of recipients
5362 # (default is invoicing_list)
5364 #I<subject> - The subject line of the sent email notification
5365 # (default is "Notice from company_name")
5367 #I<extra_fields> - a hashref of name/value pairs which will be substituted
5370 #The following variables are vavailable in the template.
5372 #I<$first> - the customer first name
5373 #I<$last> - the customer last name
5374 #I<$company> - the customer company
5375 #I<$payby> - a description of the method of payment for the customer
5376 # # would be nice to use FS::payby::shortname
5377 #I<$payinfo> - the account information used to collect for this customer
5378 #I<$expdate> - the expiration of the customer payment in seconds from epoch
5383 # my ($self, $template, %options) = @_;
5385 # return unless $conf->exists($template);
5387 # my $from = $conf->invoice_from_full($self->agentnum)
5388 # if $conf->exists('invoice_from', $self->agentnum);
5389 # $from = $options{from} if exists($options{from});
5391 # my $to = join(',', $self->invoicing_list_emailonly);
5392 # $to = $options{to} if exists($options{to});
5394 # my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5395 # if $conf->exists('company_name', $self->agentnum);
5396 # $subject = $options{subject} if exists($options{subject});
5398 # my $notify_template = new Text::Template (TYPE => 'ARRAY',
5399 # SOURCE => [ map "$_\n",
5400 # $conf->config($template)]
5402 # or die "can't create new Text::Template object: Text::Template::ERROR";
5403 # $notify_template->compile()
5404 # or die "can't compile template: Text::Template::ERROR";
5406 # $FS::notify_template::_template::company_name =
5407 # $conf->config('company_name', $self->agentnum);
5408 # $FS::notify_template::_template::company_address =
5409 # join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5411 # my $paydate = $self->paydate || '2037-12-31';
5412 # $FS::notify_template::_template::first = $self->first;
5413 # $FS::notify_template::_template::last = $self->last;
5414 # $FS::notify_template::_template::company = $self->company;
5415 # $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5416 # my $payby = $self->payby;
5417 # my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5418 # my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5420 # #credit cards expire at the end of the month/year of their exp date
5421 # if ($payby eq 'CARD' || $payby eq 'DCRD') {
5422 # $FS::notify_template::_template::payby = 'credit card';
5423 # ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5424 # $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5426 # }elsif ($payby eq 'COMP') {
5427 # $FS::notify_template::_template::payby = 'complimentary account';
5429 # $FS::notify_template::_template::payby = 'current method';
5431 # $FS::notify_template::_template::expdate = $expire_time;
5433 # for (keys %{$options{extra_fields}}){
5435 # ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5438 # send_email(from => $from,
5440 # subject => $subject,
5441 # body => $notify_template->fill_in( PACKAGE =>
5442 # 'FS::notify_template::_template' ),
5447 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5449 Generates a templated notification to the customer (see L<Text::Template>).
5451 OPTIONS is a hash and may include
5453 I<extra_fields> - a hashref of name/value pairs which will be substituted
5454 into the template. These values may override values mentioned below
5455 and those from the customer record.
5457 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5459 The following variables are available in the template instead of or in addition
5460 to the fields of the customer record.
5462 I<$payby> - a description of the method of payment for the customer
5463 # would be nice to use FS::payby::shortname
5464 I<$payinfo> - the masked account information used to collect for this customer
5465 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5466 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5470 # a lot like cust_bill::print_latex
5471 sub generate_letter {
5472 my ($self, $template, %options) = @_;
5474 warn "Template $template does not exist" && return
5475 unless $conf->exists($template) || $options{'template_text'};
5477 my $template_source = $options{'template_text'}
5478 ? [ $options{'template_text'} ]
5479 : [ map "$_\n", $conf->config($template) ];
5481 my $letter_template = new Text::Template
5483 SOURCE => $template_source,
5484 DELIMITERS => [ '[@--', '--@]' ],
5486 or die "can't create new Text::Template object: Text::Template::ERROR";
5488 $letter_template->compile()
5489 or die "can't compile template: Text::Template::ERROR";
5491 my %letter_data = map { $_ => $self->$_ } $self->fields;
5492 $letter_data{payinfo} = $self->mask_payinfo;
5494 #my $paydate = $self->paydate || '2037-12-31';
5495 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5497 my $payby = $self->payby;
5498 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5499 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5501 #credit cards expire at the end of the month/year of their exp date
5502 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5503 $letter_data{payby} = 'credit card';
5504 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5505 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5507 }elsif ($payby eq 'COMP') {
5508 $letter_data{payby} = 'complimentary account';
5510 $letter_data{payby} = 'current method';
5512 $letter_data{expdate} = $expire_time;
5514 for (keys %{$options{extra_fields}}){
5515 $letter_data{$_} = $options{extra_fields}->{$_};
5518 unless(exists($letter_data{returnaddress})){
5519 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5520 $self->agent_template)
5522 if ( length($retadd) ) {
5523 $letter_data{returnaddress} = $retadd;
5524 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5525 $letter_data{returnaddress} =
5526 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5530 ( $conf->config('company_name', $self->agentnum),
5531 $conf->config('company_address', $self->agentnum),
5535 $letter_data{returnaddress} = '~';
5539 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5541 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5543 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5545 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5549 ) or die "can't open temp file: $!\n";
5550 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5551 or die "can't write temp file: $!\n";
5553 $letter_data{'logo_file'} = $lh->filename;
5555 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5559 ) or die "can't open temp file: $!\n";
5561 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5563 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5564 return ($1, $letter_data{'logo_file'});
5568 =item print_ps TEMPLATE
5570 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5576 my($file, $lfile) = $self->generate_letter(@_);
5577 my $ps = FS::Misc::generate_ps($file);
5578 unlink($file.'.tex');
5584 =item print TEMPLATE
5586 Prints the filled in template.
5588 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5592 sub queueable_print {
5595 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5596 or die "invalid customer number: " . $opt{custnum};
5598 #do not backport this change to 3.x
5599 # my $error = $self->print( { 'template' => $opt{template} } );
5600 my $error = $self->print( $opt{'template'} );
5601 die $error if $error;
5605 my ($self, $template) = (shift, shift);
5607 [ $self->print_ps($template) ],
5608 'agentnum' => $self->agentnum,
5612 #these three subs should just go away once agent stuff is all config overrides
5614 sub agent_template {
5616 $self->_agent_plandata('agent_templatename');
5619 sub agent_invoice_from {
5621 $self->_agent_plandata('agent_invoice_from');
5624 sub _agent_plandata {
5625 my( $self, $option ) = @_;
5627 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5628 #agent-specific Conf
5630 use FS::part_event::Condition;
5632 my $agentnum = $self->agentnum;
5634 my $regexp = regexp_sql();
5636 my $part_event_option =
5638 'select' => 'part_event_option.*',
5639 'table' => 'part_event_option',
5641 LEFT JOIN part_event USING ( eventpart )
5642 LEFT JOIN part_event_option AS peo_agentnum
5643 ON ( part_event.eventpart = peo_agentnum.eventpart
5644 AND peo_agentnum.optionname = 'agentnum'
5645 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5647 LEFT JOIN part_event_condition
5648 ON ( part_event.eventpart = part_event_condition.eventpart
5649 AND part_event_condition.conditionname = 'cust_bill_age'
5651 LEFT JOIN part_event_condition_option
5652 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5653 AND part_event_condition_option.optionname = 'age'
5656 #'hashref' => { 'optionname' => $option },
5657 #'hashref' => { 'part_event_option.optionname' => $option },
5659 " WHERE part_event_option.optionname = ". dbh->quote($option).
5660 " AND action = 'cust_bill_send_agent' ".
5661 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5662 " AND peo_agentnum.optionname = 'agentnum' ".
5663 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5665 CASE WHEN part_event_condition_option.optionname IS NULL
5667 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5669 , part_event.weight".
5673 unless ( $part_event_option ) {
5674 return $self->agent->invoice_template || ''
5675 if $option eq 'agent_templatename';
5679 $part_event_option->optionvalue;
5683 sub process_o2m_qsearch {
5686 return qsearch($table, @_) unless $table eq 'contact';
5688 my $hashref = shift;
5689 my %hash = %$hashref;
5690 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5691 or die 'guru meditation #4343';
5693 qsearch({ 'table' => 'contact',
5694 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5695 'hashref' => \%hash,
5696 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5697 " cust_contact.custnum = $custnum "
5701 sub process_o2m_qsearchs {
5704 return qsearchs($table, @_) unless $table eq 'contact';
5706 my $hashref = shift;
5707 my %hash = %$hashref;
5708 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5709 or die 'guru meditation #2121';
5711 qsearchs({ 'table' => 'contact',
5712 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5713 'hashref' => \%hash,
5714 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5715 " cust_contact.custnum = $custnum "
5719 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5721 Subroutine (not a method), designed to be called from the queue.
5723 Takes a list of options and values.
5725 Pulls up the customer record via the custnum option and calls bill_and_collect.
5730 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5732 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5733 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5735 #without this errors don't get rolled back
5736 $args{'fatal'} = 1; # runs from job queue, will be caught
5738 $cust_main->bill_and_collect( %args );
5741 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5743 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5744 C<collect> part. This is used in batch tax calculation, where invoice
5745 generation and collection events have to be completely separated.
5749 sub queued_collect {
5751 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5753 $cust_main->collect(%args);
5756 sub process_bill_and_collect {
5759 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5760 or die "custnum '$param->{custnum}' not found!\n";
5761 $param->{'job'} = $job;
5762 $param->{'fatal'} = 1; # runs from job queue, will be caught
5763 $param->{'retry'} = 1;
5766 eval { $cust_main->bill_and_collect( %$param) };
5768 die $@ =~ /cancel_pkgs cannot be run inside a transaction/
5769 ? "Bill Now unavailable for customer with pending package expiration\n"
5774 =item pending_invoice_count
5776 Return number of cust_bill with pending=Y for this customer
5780 sub pending_invoice_count {
5781 FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
5784 =item cust_locations_missing_district
5786 Always returns empty list, unless tax_district_method eq 'wa_sales'
5788 Return cust_location rows for this customer, associated with active
5789 customer packages, where tax district column is empty. Presense of
5790 these rows should block billing, because invoice would be generated
5791 with incorrect taxes
5795 sub cust_locations_missing_district {
5798 my $tax_district_method = FS::Conf->new->config('tax_district_method');
5801 unless $tax_district_method
5802 && $tax_district_method eq 'wa_sales';
5805 table => 'cust_location',
5806 select => 'cust_location.*',
5808 LEFT JOIN cust_main USING (custnum)
5809 LEFT JOIN cust_pkg ON cust_location.locationnum = cust_pkg.locationnum
5811 extra_sql => sprintf(q{
5812 WHERE cust_location.state = 'WA'
5813 AND cust_location.custnum = %s
5815 cust_location.district IS NULL
5816 or cust_location.district = ''
5818 AND cust_pkg.pkgnum IS NOT NULL
5820 cust_pkg.cancel > %s
5821 OR cust_pkg.cancel IS NULL
5824 $self->custnum, time()
5829 #starting to take quite a while for big dbs
5830 # (JRNL: journaled so it only happens once per database)
5831 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5832 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5833 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5834 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5835 # JRNL leading/trailing spaces in first, last, company
5836 # JRNL migrate to cust_payby
5837 # - otaker upgrade? journal and call it good? (double check to make sure
5838 # we're not still setting otaker here)
5840 #only going to get worse with new location stuff...
5842 sub _upgrade_data { #class method
5843 my ($class, %opts) = @_;
5846 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5849 #this seems to be the only expensive one.. why does it take so long?
5850 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5852 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL';
5853 FS::upgrade_journal->set_done('cust_main__signupdate');
5856 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5858 # fix yyyy-m-dd formatted paydates
5859 if ( driver_name =~ /^mysql/i ) {
5861 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5862 } else { # the SQL standard
5864 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5866 FS::upgrade_journal->set_done('cust_main__paydate');
5869 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5871 push @statements, #fix the weird BILL with a cc# in payinfo problem
5873 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5875 FS::upgrade_journal->set_done('cust_main__payinfo');
5880 foreach my $sql ( @statements ) {
5881 my $sth = dbh->prepare($sql) or die dbh->errstr;
5882 $sth->execute or die $sth->errstr;
5883 #warn ( (time - $t). " seconds\n" );
5887 local($ignore_expired_card) = 1;
5888 local($ignore_banned_card) = 1;
5889 local($skip_fuzzyfiles) = 1;
5890 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5892 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
5894 #we don't want to decrypt them, just stuff them as-is into cust_payby
5895 local(@encrypted_fields) = ();
5897 local($FS::cust_payby::ignore_expired_card) = 1;
5898 local($FS::cust_payby::ignore_banned_card) = 1;
5899 local($FS::cust_payby::ignore_cardtype) = 1;
5901 my @payfields = qw( payby payinfo paycvv paymask
5902 paydate paystart_month paystart_year payissue
5903 payname paystate paytype payip
5906 my $search = new FS::Cursor {
5907 'table' => 'cust_main',
5908 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
5911 while (my $cust_main = $search->fetch) {
5913 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
5915 my $cust_payby = new FS::cust_payby {
5916 'custnum' => $cust_main->custnum,
5918 map { $_ => $cust_main->$_(); } @payfields
5921 my $error = $cust_payby->insert;
5922 die $error if $error;
5926 # at the time we do this, also migrate paytype into cust_pay_batch
5927 # so that batches that are open before the migration can still be
5929 if ( $cust_main->get('paytype') ) {
5930 my @cust_pay_batch = qsearch('cust_pay_batch', {
5931 'custnum' => $cust_main->custnum,
5935 foreach my $cust_pay_batch (@cust_pay_batch) {
5936 $cust_pay_batch->set('paytype', $cust_main->get('paytype'));
5937 my $error = $cust_pay_batch->replace;
5938 die "$error (setting cust_pay_batch.paytype)" if $error;
5942 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
5944 $cust_main->invoice_attn( $cust_main->payname )
5945 if $cust_main->payby eq 'BILL' && $cust_main->payname;
5946 $cust_main->po_number( $cust_main->payinfo )
5947 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
5949 $cust_main->setfield($_, '') foreach @payfields;
5950 my $error = $cust_main->replace;
5951 die "Error upgradging payment information for custnum ".
5952 $cust_main->custnum. ": $error"
5957 FS::upgrade_journal->set_done('cust_main__cust_payby');
5960 FS::cust_main::Location->_upgrade_data(%opts);
5962 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5964 foreach my $cust_main ( qsearch({
5965 'table' => 'cust_main',
5967 'extra_sql' => 'WHERE '.
5969 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5970 qw( first last company )
5973 my $error = $cust_main->replace;
5974 die $error if $error;
5977 FS::upgrade_journal->set_done('cust_main__trimspaces');
5981 $class->_upgrade_otaker(%opts);
5983 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5984 # existing records will be encrypted in queueable_upgrade (below)
5985 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5986 eval "use FS::Setup";
5988 FS::Setup::enable_encryption();
5993 sub queueable_upgrade {
5996 ### encryption gets turned on in _upgrade_data, above
5998 eval "use FS::upgrade_journal";
6001 # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
6002 # clear that out before encrypting/tokenizing anything else
6003 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
6004 foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
6005 my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
6006 my $sth = dbh->prepare($sql) or die dbh->errstr;
6007 $sth->execute or die $sth->errstr;
6009 FS::upgrade_journal->set_done('clear_payinfo_history');
6012 # fix Tokenized paycardtype and encrypt old records
6013 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
6014 || ! FS::upgrade_journal->is_done('encryption_check')
6018 # allow replacement of closed cust_pay/cust_refund records
6019 local $FS::payinfo_Mixin::allow_closed_replace = 1;
6021 # because it looks like nothing's changing
6022 local $FS::Record::no_update_diff = 1;
6024 # commit everything immediately
6025 local $FS::UID::AutoCommit = 1;
6027 # encrypt what's there
6028 foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
6029 my $tclass = 'FS::'.$table;
6032 while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
6033 my $record = $tclass->by_key($recnum);
6034 next unless $record; # small chance it's been deleted, that's ok
6035 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
6036 # window for possible conflict is practically nonexistant,
6037 # but just in case...
6038 $record = $record->select_for_update;
6039 if (!$record->custnum && $table eq 'cust_pay_pending') {
6040 $record->set('custnum_pending',1);
6042 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
6044 local($ignore_expired_card) = 1;
6045 local($ignore_banned_card) = 1;
6046 local($skip_fuzzyfiles) = 1;
6047 local($import) = 1;#prevent automatic geocoding (need its own variable?)
6049 my $error = $record->replace;
6050 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
6054 FS::upgrade_journal->set_done('paycardtype_Tokenized');
6055 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
6058 # now that everything's encrypted, tokenize...
6059 FS::cust_main::Billing_Realtime::token_check(@_);
6062 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
6063 # cust_payby might get deleted while this runs
6065 sub _upgrade_next_recnum {
6066 my ($dbh,$table,$lastrecnum,$recnums) = @_;
6067 my $recnum = shift @$recnums;
6068 return $recnum if $recnum;
6069 my $tclass = 'FS::'.$table;
6070 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
6071 my $sql = 'SELECT '.$tclass->primary_key.
6073 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
6074 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
6075 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
6076 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
6077 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
6078 $sth->execute() or die $sth->errstr;
6080 while (my $rec = $sth->fetchrow_hashref) {
6081 push @$recnums, $rec->{$tclass->primary_key};
6084 $$lastrecnum = $$recnums[-1];
6085 return shift @$recnums;
6094 The delete method should possibly take an FS::cust_main object reference
6095 instead of a scalar customer number.
6097 Bill and collect options should probably be passed as references instead of a
6100 There should probably be a configuration file with a list of allowed credit
6103 No multiple currency support (probably a larger project than just this module).
6105 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6107 Birthdates rely on negative epoch values.
6109 The payby for card/check batches is broken. With mixed batching, bad
6112 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6116 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6117 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6118 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.