5 use base qw( FS::cust_main::Packages FS::cust_main::Status
6 FS::cust_main::NationalID
7 FS::cust_main::Billing FS::cust_main::Billing_Realtime
8 FS::cust_main::Billing_Discount
9 FS::cust_main::Billing_ThirdParty
10 FS::cust_main::Location
11 FS::cust_main::Credit_Limit
12 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
13 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
17 use vars qw( $DEBUG $me $conf $default_agent_custid $custnum_display_length
20 $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
25 use Scalar::Util qw( blessed );
26 use Time::Local qw(timelocal);
27 use Storable qw(thaw);
31 use Digest::MD5 qw(md5_base64);
34 use File::Temp; #qw( tempfile );
36 use Business::CreditCard 0.28;
38 use FS::UID qw( getotaker dbh driver_name );
39 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
40 use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty card_types );
41 use FS::Msgcat qw(gettext);
48 use FS::cust_bill_void;
49 use FS::legacy_cust_bill;
51 use FS::cust_pay_pending;
52 use FS::cust_pay_void;
53 use FS::cust_pay_batch;
56 use FS::part_referral;
57 use FS::cust_main_county;
58 use FS::cust_location;
60 use FS::cust_main_exemption;
61 use FS::cust_tax_adjustment;
62 use FS::cust_tax_location;
64 use FS::cust_main_invoice;
66 use FS::prepay_credit;
72 use FS::payment_gateway;
73 use FS::agent_payment_gateway;
75 use FS::cust_main_note;
76 use FS::cust_attachment;
79 use FS::upgrade_journal;
82 # 1 is mostly method/subroutine entry and options
83 # 2 traces progress of some operations
84 # 3 is even more information including possibly sensitive data
86 $me = '[FS::cust_main]';
89 $ignore_expired_card = 0;
90 $ignore_banned_card = 0;
94 @encrypted_fields = ('payinfo', 'paycvv');
95 sub nohistory_fields { ('payinfo', 'paycvv'); }
97 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
99 #ask FS::UID to run this stuff for us later
100 #$FS::UID::callback{'FS::cust_main'} = sub {
101 install_callback FS::UID sub {
102 $conf = new FS::Conf;
103 $default_agent_custid = $conf->exists('cust_main-default_agent_custid');
104 $custnum_display_length = $conf->config('cust_main-custnum-display_length');
109 my ( $hashref, $cache ) = @_;
110 if ( exists $hashref->{'pkgnum'} ) {
111 #@{ $self->{'_pkgnum'} } = ();
112 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
113 $self->{'_pkgnum'} = $subcache;
114 #push @{ $self->{'_pkgnum'} },
115 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
121 FS::cust_main - Object methods for cust_main records
127 $record = new FS::cust_main \%hash;
128 $record = new FS::cust_main { 'column' => 'value' };
130 $error = $record->insert;
132 $error = $new_record->replace($old_record);
134 $error = $record->delete;
136 $error = $record->check;
138 @cust_pkg = $record->all_pkgs;
140 @cust_pkg = $record->ncancelled_pkgs;
142 @cust_pkg = $record->suspended_pkgs;
144 $error = $record->bill;
145 $error = $record->bill %options;
146 $error = $record->bill 'time' => $time;
148 $error = $record->collect;
149 $error = $record->collect %options;
150 $error = $record->collect 'invoice_time' => $time,
155 An FS::cust_main object represents a customer. FS::cust_main inherits from
156 FS::Record. The following fields are currently supported:
162 Primary key (assigned automatically for new customers)
166 Agent (see L<FS::agent>)
170 Advertising source (see L<FS::part_referral>)
182 Cocial security number (optional)
206 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
210 Payment Information (See L<FS::payinfo_Mixin> for data format)
214 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
218 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
222 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
226 Start date month (maestro/solo cards only)
230 Start date year (maestro/solo cards only)
234 Issue number (maestro/solo cards only)
238 Name on card or billing name
242 IP address from which payment information was received
246 The credit card type (deduced from the card number).
250 Tax exempt, empty or `Y'
254 Order taker (see L<FS::access_user>)
260 =item referral_custnum
262 Referring customer number
266 Enable individual CDR spooling, empty or `Y'
270 A suggestion to events (see L<FS::part_bill_event>) to delay until this unix timestamp
274 Discourage individual CDR printing, empty or `Y'
278 Allow self-service editing of ticket subjects, empty or 'Y'
280 =item calling_list_exempt
282 Do not call, empty or 'Y'
284 =item invoice_ship_address
286 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
296 Creates a new customer. To add the customer to the database, see L<"insert">.
298 Note that this stores the hash reference, not a distinct copy of the hash it
299 points to. You can ask the object for a copy with the I<hash> method.
303 sub table { 'cust_main'; }
305 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
307 Adds this customer to the database. If there is an error, returns the error,
308 otherwise returns false.
310 Usually the customer's location will not yet exist in the database, and
311 the C<bill_location> and C<ship_location> pseudo-fields must be set to
312 uninserted L<FS::cust_location> objects. These will be inserted and linked
313 (in both directions) to the new customer record. If they're references
314 to the same object, they will become the same location.
316 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
317 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
318 are inserted atomicly, or the transaction is rolled back. Passing an empty
319 hash reference is equivalent to not supplying this parameter. There should be
320 a better explanation of this, but until then, here's an example:
323 tie %hash, 'Tie::RefHash'; #this part is important
325 $cust_pkg => [ $svc_acct ],
328 $cust_main->insert( \%hash );
330 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
331 be set as the invoicing list (see L<"invoicing_list">). Errors return as
332 expected and rollback the entire transaction; it is not necessary to call
333 check_invoicing_list first. The invoicing_list is set after the records in the
334 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
335 invoicing_list destination to the newly-created svc_acct. Here's an example:
337 $cust_main->insert( {}, [ $email, 'POST' ] );
339 Currently available options are: I<depend_jobnum>, I<noexport>,
340 I<tax_exemption> and I<prospectnum>.
342 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
343 on the supplied jobnum (they will not run until the specific job completes).
344 This can be used to defer provisioning until some action completes (such
345 as running the customer's credit card successfully).
347 The I<noexport> option is deprecated. If I<noexport> is set true, no
348 provisioning jobs (exports) are scheduled. (You can schedule them later with
349 the B<reexport> method.)
351 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
352 of tax names and exemption numbers. FS::cust_main_exemption records will be
353 created and inserted.
355 If I<prospectnum> is set, moves contacts and locations from that prospect.
361 my $cust_pkgs = @_ ? shift : {};
362 my $invoicing_list = @_ ? shift : '';
364 warn "$me insert called with options ".
365 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
368 local $SIG{HUP} = 'IGNORE';
369 local $SIG{INT} = 'IGNORE';
370 local $SIG{QUIT} = 'IGNORE';
371 local $SIG{TERM} = 'IGNORE';
372 local $SIG{TSTP} = 'IGNORE';
373 local $SIG{PIPE} = 'IGNORE';
375 my $oldAutoCommit = $FS::UID::AutoCommit;
376 local $FS::UID::AutoCommit = 0;
379 my $prepay_identifier = '';
380 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
382 if ( $self->payby eq 'PREPAY' ) {
384 $self->payby('BILL');
385 $prepay_identifier = $self->payinfo;
388 warn " looking up prepaid card $prepay_identifier\n"
391 my $error = $self->get_prepay( $prepay_identifier,
392 'amount_ref' => \$amount,
393 'seconds_ref' => \$seconds,
394 'upbytes_ref' => \$upbytes,
395 'downbytes_ref' => \$downbytes,
396 'totalbytes_ref' => \$totalbytes,
399 $dbh->rollback if $oldAutoCommit;
400 #return "error applying prepaid card (transaction rolled back): $error";
404 $payby = 'PREP' if $amount;
406 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
409 $self->payby('BILL');
410 $amount = $self->paid;
415 foreach my $l (qw(bill_location ship_location)) {
417 my $loc = delete $self->hashref->{$l} or return "$l not set";
419 if ( !$loc->locationnum ) {
420 # warn the location that we're going to insert it with no custnum
421 $loc->set(custnum_pending => 1);
422 warn " inserting $l\n"
424 my $error = $loc->insert;
426 $dbh->rollback if $oldAutoCommit;
427 my $label = $l eq 'ship_location' ? 'service' : 'billing';
428 return "$error (in $label location)";
431 } elsif ( $loc->prospectnum ) {
433 $loc->prospectnum('');
434 $loc->set(custnum_pending => 1);
435 my $error = $loc->replace;
437 $dbh->rollback if $oldAutoCommit;
438 my $label = $l eq 'ship_location' ? 'service' : 'billing';
439 return "$error (moving $label location)";
442 } elsif ( ($loc->custnum || 0) > 0 ) {
443 # then it somehow belongs to another customer--shouldn't happen
444 $dbh->rollback if $oldAutoCommit;
445 return "$l belongs to customer ".$loc->custnum;
447 # else it already belongs to this customer
448 # (happens when ship_location is identical to bill_location)
450 $self->set($l.'num', $loc->locationnum);
452 if ( $self->get($l.'num') eq '' ) {
453 $dbh->rollback if $oldAutoCommit;
458 warn " inserting $self\n"
461 $self->signupdate(time) unless $self->signupdate;
463 $self->auto_agent_custid()
464 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
466 my $error = $self->check_payinfo_cardtype
467 || $self->SUPER::insert;
469 $dbh->rollback if $oldAutoCommit;
470 #return "inserting cust_main record (transaction rolled back): $error";
474 # now set cust_location.custnum
475 foreach my $l (qw(bill_location ship_location)) {
476 warn " setting $l.custnum\n"
479 unless ( $loc->custnum ) {
480 $loc->set(custnum => $self->custnum);
481 $error ||= $loc->replace;
485 $dbh->rollback if $oldAutoCommit;
486 return "error setting $l custnum: $error";
490 warn " setting invoicing list\n"
493 if ( $invoicing_list ) {
494 $error = $self->check_invoicing_list( $invoicing_list );
496 $dbh->rollback if $oldAutoCommit;
497 #return "checking invoicing_list (transaction rolled back): $error";
500 $self->invoicing_list( $invoicing_list );
503 warn " setting customer tags\n"
506 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
507 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
508 'custnum' => $self->custnum };
509 my $error = $cust_tag->insert;
511 $dbh->rollback if $oldAutoCommit;
516 my $prospectnum = delete $options{'prospectnum'};
517 if ( $prospectnum ) {
519 warn " moving contacts and locations from prospect $prospectnum\n"
523 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
524 unless ( $prospect_main ) {
525 $dbh->rollback if $oldAutoCommit;
526 return "Unknown prospectnum $prospectnum";
528 $prospect_main->custnum($self->custnum);
529 $prospect_main->disabled('Y');
530 my $error = $prospect_main->replace;
532 $dbh->rollback if $oldAutoCommit;
536 my @contact = $prospect_main->contact;
537 my @cust_location = $prospect_main->cust_location;
538 my @qual = $prospect_main->qual;
540 foreach my $r ( @contact, @cust_location, @qual ) {
542 $r->custnum($self->custnum);
543 my $error = $r->replace;
545 $dbh->rollback if $oldAutoCommit;
552 # validate card (needs custnum already set)
553 if ( $self->payby =~ /^(CARD|DCRD)$/
554 && $conf->exists('business-onlinepayment-verification') ) {
555 $error = $self->realtime_verify_bop({ 'method'=>'CC' });
557 $dbh->rollback if $oldAutoCommit;
562 warn " setting contacts\n"
565 if ( my $contact = delete $options{'contact'} ) {
567 foreach my $c ( @$contact ) {
568 $c->custnum($self->custnum);
569 my $error = $c->insert;
571 $dbh->rollback if $oldAutoCommit;
577 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
579 my $error = $self->process_o2m( 'table' => 'contact',
580 'fields' => FS::contact->cgi_contact_fields,
581 'params' => $contact_params,
584 $dbh->rollback if $oldAutoCommit;
589 warn " setting cust_main_exemption\n"
592 my $tax_exemption = delete $options{'tax_exemption'};
593 if ( $tax_exemption ) {
595 $tax_exemption = { map { $_ => '' } @$tax_exemption }
596 if ref($tax_exemption) eq 'ARRAY';
598 foreach my $taxname ( keys %$tax_exemption ) {
599 my $cust_main_exemption = new FS::cust_main_exemption {
600 'custnum' => $self->custnum,
601 'taxname' => $taxname,
602 'exempt_number' => $tax_exemption->{$taxname},
604 my $error = $cust_main_exemption->insert;
606 $dbh->rollback if $oldAutoCommit;
607 return "inserting cust_main_exemption (transaction rolled back): $error";
612 warn " ordering packages\n"
615 $error = $self->order_pkgs( $cust_pkgs,
617 'seconds_ref' => \$seconds,
618 'upbytes_ref' => \$upbytes,
619 'downbytes_ref' => \$downbytes,
620 'totalbytes_ref' => \$totalbytes,
623 $dbh->rollback if $oldAutoCommit;
628 $dbh->rollback if $oldAutoCommit;
629 return "No svc_acct record to apply pre-paid time";
631 if ( $upbytes || $downbytes || $totalbytes ) {
632 $dbh->rollback if $oldAutoCommit;
633 return "No svc_acct record to apply pre-paid data";
637 warn " inserting initial $payby payment of $amount\n"
639 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
641 $dbh->rollback if $oldAutoCommit;
642 return "inserting payment (transaction rolled back): $error";
646 unless ( $import || $skip_fuzzyfiles ) {
647 warn " queueing fuzzyfiles update\n"
649 $error = $self->queue_fuzzyfiles_update;
651 $dbh->rollback if $oldAutoCommit;
652 return "updating fuzzy search cache: $error";
656 # FS::geocode_Mixin::after_insert or something?
657 if ( $conf->config('tax_district_method') and !$import ) {
658 # if anything non-empty, try to look it up
659 my $queue = new FS::queue {
660 'job' => 'FS::geocode_Mixin::process_district_update',
661 'custnum' => $self->custnum,
663 my $error = $queue->insert( ref($self), $self->custnum );
665 $dbh->rollback if $oldAutoCommit;
666 return "queueing tax district update: $error";
671 warn " exporting\n" if $DEBUG > 1;
673 my $export_args = $options{'export_args'} || [];
676 map qsearch( 'part_export', {exportnum=>$_} ),
677 $conf->config('cust_main-exports'); #, $agentnum
679 foreach my $part_export ( @part_export ) {
680 my $error = $part_export->export_insert($self, @$export_args);
682 $dbh->rollback if $oldAutoCommit;
683 return "exporting to ". $part_export->exporttype.
684 " (transaction rolled back): $error";
688 #foreach my $depend_jobnum ( @$depend_jobnums ) {
689 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
691 # foreach my $jobnum ( @jobnums ) {
692 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
693 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
695 # my $error = $queue->depend_insert($depend_jobnum);
697 # $dbh->rollback if $oldAutoCommit;
698 # return "error queuing job dependancy: $error";
705 #if ( exists $options{'jobnums'} ) {
706 # push @{ $options{'jobnums'} }, @jobnums;
709 warn " insert complete; committing transaction\n"
712 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
717 use File::CounterFile;
718 sub auto_agent_custid {
721 my $format = $conf->config('cust_main-auto_agent_custid');
723 if ( $format eq '1YMMXXXXXXXX' ) {
725 my $counter = new File::CounterFile 'cust_main.agent_custid';
728 my $ym = 100000000000 + time2str('%y%m00000000', time);
729 if ( $ym > $counter->value ) {
730 $counter->{'value'} = $agent_custid = $ym;
731 $counter->{'updated'} = 1;
733 $agent_custid = $counter->inc;
739 die "Unknown cust_main-auto_agent_custid format: $format";
742 $self->agent_custid($agent_custid);
746 =item PACKAGE METHODS
748 Documentation on customer package methods has been moved to
749 L<FS::cust_main::Packages>.
751 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
753 Recharges this (existing) customer with the specified prepaid card (see
754 L<FS::prepay_credit>), specified either by I<identifier> or as an
755 FS::prepay_credit object. If there is an error, returns the error, otherwise
758 Optionally, five scalar references can be passed as well. They will have their
759 values filled in with the amount, number of seconds, and number of upload,
760 download, and total bytes applied by this prepaid card.
764 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
765 #the only place that uses these args
766 sub recharge_prepay {
767 my( $self, $prepay_credit, $amountref, $secondsref,
768 $upbytesref, $downbytesref, $totalbytesref ) = @_;
770 local $SIG{HUP} = 'IGNORE';
771 local $SIG{INT} = 'IGNORE';
772 local $SIG{QUIT} = 'IGNORE';
773 local $SIG{TERM} = 'IGNORE';
774 local $SIG{TSTP} = 'IGNORE';
775 local $SIG{PIPE} = 'IGNORE';
777 my $oldAutoCommit = $FS::UID::AutoCommit;
778 local $FS::UID::AutoCommit = 0;
781 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
783 my $error = $self->get_prepay( $prepay_credit,
784 'amount_ref' => \$amount,
785 'seconds_ref' => \$seconds,
786 'upbytes_ref' => \$upbytes,
787 'downbytes_ref' => \$downbytes,
788 'totalbytes_ref' => \$totalbytes,
790 || $self->increment_seconds($seconds)
791 || $self->increment_upbytes($upbytes)
792 || $self->increment_downbytes($downbytes)
793 || $self->increment_totalbytes($totalbytes)
794 || $self->insert_cust_pay_prepay( $amount,
796 ? $prepay_credit->identifier
801 $dbh->rollback if $oldAutoCommit;
805 if ( defined($amountref) ) { $$amountref = $amount; }
806 if ( defined($secondsref) ) { $$secondsref = $seconds; }
807 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
808 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
809 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
811 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
816 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
818 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
819 specified either by I<identifier> or as an FS::prepay_credit object.
821 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
822 incremented by the values of the prepaid card.
824 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
825 check or set this customer's I<agentnum>.
827 If there is an error, returns the error, otherwise returns false.
833 my( $self, $prepay_credit, %opt ) = @_;
835 local $SIG{HUP} = 'IGNORE';
836 local $SIG{INT} = 'IGNORE';
837 local $SIG{QUIT} = 'IGNORE';
838 local $SIG{TERM} = 'IGNORE';
839 local $SIG{TSTP} = 'IGNORE';
840 local $SIG{PIPE} = 'IGNORE';
842 my $oldAutoCommit = $FS::UID::AutoCommit;
843 local $FS::UID::AutoCommit = 0;
846 unless ( ref($prepay_credit) ) {
848 my $identifier = $prepay_credit;
850 $prepay_credit = qsearchs(
852 { 'identifier' => $identifier },
857 unless ( $prepay_credit ) {
858 $dbh->rollback if $oldAutoCommit;
859 return "Invalid prepaid card: ". $identifier;
864 if ( $prepay_credit->agentnum ) {
865 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
866 $dbh->rollback if $oldAutoCommit;
867 return "prepaid card not valid for agent ". $self->agentnum;
869 $self->agentnum($prepay_credit->agentnum);
872 my $error = $prepay_credit->delete;
874 $dbh->rollback if $oldAutoCommit;
875 return "removing prepay_credit (transaction rolled back): $error";
878 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
879 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
881 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
886 =item increment_upbytes SECONDS
888 Updates this customer's single or primary account (see L<FS::svc_acct>) by
889 the specified number of upbytes. If there is an error, returns the error,
890 otherwise returns false.
894 sub increment_upbytes {
895 _increment_column( shift, 'upbytes', @_);
898 =item increment_downbytes SECONDS
900 Updates this customer's single or primary account (see L<FS::svc_acct>) by
901 the specified number of downbytes. If there is an error, returns the error,
902 otherwise returns false.
906 sub increment_downbytes {
907 _increment_column( shift, 'downbytes', @_);
910 =item increment_totalbytes SECONDS
912 Updates this customer's single or primary account (see L<FS::svc_acct>) by
913 the specified number of totalbytes. If there is an error, returns the error,
914 otherwise returns false.
918 sub increment_totalbytes {
919 _increment_column( shift, 'totalbytes', @_);
922 =item increment_seconds SECONDS
924 Updates this customer's single or primary account (see L<FS::svc_acct>) by
925 the specified number of seconds. If there is an error, returns the error,
926 otherwise returns false.
930 sub increment_seconds {
931 _increment_column( shift, 'seconds', @_);
934 =item _increment_column AMOUNT
936 Updates this customer's single or primary account (see L<FS::svc_acct>) by
937 the specified number of seconds or bytes. If there is an error, returns
938 the error, otherwise returns false.
942 sub _increment_column {
943 my( $self, $column, $amount ) = @_;
944 warn "$me increment_column called: $column, $amount\n"
947 return '' unless $amount;
949 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
950 $self->ncancelled_pkgs;
953 return 'No packages with primary or single services found'.
954 ' to apply pre-paid time';
955 } elsif ( scalar(@cust_pkg) > 1 ) {
956 #maybe have a way to specify the package/account?
957 return 'Multiple packages found to apply pre-paid time';
960 my $cust_pkg = $cust_pkg[0];
961 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
965 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
968 return 'No account found to apply pre-paid time';
969 } elsif ( scalar(@cust_svc) > 1 ) {
970 return 'Multiple accounts found to apply pre-paid time';
973 my $svc_acct = $cust_svc[0]->svc_x;
974 warn " found service svcnum ". $svc_acct->pkgnum.
975 ' ('. $svc_acct->email. ")\n"
978 $column = "increment_$column";
979 $svc_acct->$column($amount);
983 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
985 Inserts a prepayment in the specified amount for this customer. An optional
986 second argument can specify the prepayment identifier for tracking purposes.
987 If there is an error, returns the error, otherwise returns false.
991 sub insert_cust_pay_prepay {
992 shift->insert_cust_pay('PREP', @_);
995 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
997 Inserts a cash payment in the specified amount for this customer. An optional
998 second argument can specify the payment identifier for tracking purposes.
999 If there is an error, returns the error, otherwise returns false.
1003 sub insert_cust_pay_cash {
1004 shift->insert_cust_pay('CASH', @_);
1007 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1009 Inserts a Western Union payment in the specified amount for this customer. An
1010 optional second argument can specify the prepayment identifier for tracking
1011 purposes. If there is an error, returns the error, otherwise returns false.
1015 sub insert_cust_pay_west {
1016 shift->insert_cust_pay('WEST', @_);
1019 sub insert_cust_pay {
1020 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1021 my $payinfo = scalar(@_) ? shift : '';
1023 my $cust_pay = new FS::cust_pay {
1024 'custnum' => $self->custnum,
1025 'paid' => sprintf('%.2f', $amount),
1026 #'_date' => #date the prepaid card was purchased???
1028 'payinfo' => $payinfo,
1036 This method is deprecated. See the I<depend_jobnum> option to the insert and
1037 order_pkgs methods for a better way to defer provisioning.
1039 Re-schedules all exports by calling the B<reexport> method of all associated
1040 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1041 otherwise returns false.
1048 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1049 "use the depend_jobnum option to insert or order_pkgs to delay export";
1051 local $SIG{HUP} = 'IGNORE';
1052 local $SIG{INT} = 'IGNORE';
1053 local $SIG{QUIT} = 'IGNORE';
1054 local $SIG{TERM} = 'IGNORE';
1055 local $SIG{TSTP} = 'IGNORE';
1056 local $SIG{PIPE} = 'IGNORE';
1058 my $oldAutoCommit = $FS::UID::AutoCommit;
1059 local $FS::UID::AutoCommit = 0;
1062 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1063 my $error = $cust_pkg->reexport;
1065 $dbh->rollback if $oldAutoCommit;
1070 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1075 =item delete [ OPTION => VALUE ... ]
1077 This deletes the customer. If there is an error, returns the error, otherwise
1080 This will completely remove all traces of the customer record. This is not
1081 what you want when a customer cancels service; for that, cancel all of the
1082 customer's packages (see L</cancel>).
1084 If the customer has any uncancelled packages, you need to pass a new (valid)
1085 customer number for those packages to be transferred to, as the "new_customer"
1086 option. Cancelled packages will be deleted. Did I mention that this is NOT
1087 what you want when a customer cancels service and that you really should be
1088 looking at L<FS::cust_pkg/cancel>?
1090 You can't delete a customer with invoices (see L<FS::cust_bill>),
1091 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1092 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1093 set the "delete_financials" option to a true value.
1098 my( $self, %opt ) = @_;
1100 local $SIG{HUP} = 'IGNORE';
1101 local $SIG{INT} = 'IGNORE';
1102 local $SIG{QUIT} = 'IGNORE';
1103 local $SIG{TERM} = 'IGNORE';
1104 local $SIG{TSTP} = 'IGNORE';
1105 local $SIG{PIPE} = 'IGNORE';
1107 my $oldAutoCommit = $FS::UID::AutoCommit;
1108 local $FS::UID::AutoCommit = 0;
1111 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1112 $dbh->rollback if $oldAutoCommit;
1113 return "Can't delete a master agent customer";
1116 #use FS::access_user
1117 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1118 $dbh->rollback if $oldAutoCommit;
1119 return "Can't delete a master employee customer";
1122 tie my %financial_tables, 'Tie::IxHash',
1123 'cust_bill' => 'invoices',
1124 'cust_statement' => 'statements',
1125 'cust_credit' => 'credits',
1126 'cust_pay' => 'payments',
1127 'cust_refund' => 'refunds',
1130 foreach my $table ( keys %financial_tables ) {
1132 my @records = $self->$table();
1134 if ( @records && ! $opt{'delete_financials'} ) {
1135 $dbh->rollback if $oldAutoCommit;
1136 return "Can't delete a customer with ". $financial_tables{$table};
1139 foreach my $record ( @records ) {
1140 my $error = $record->delete;
1142 $dbh->rollback if $oldAutoCommit;
1143 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1149 my @cust_pkg = $self->ncancelled_pkgs;
1151 my $new_custnum = $opt{'new_custnum'};
1152 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1153 $dbh->rollback if $oldAutoCommit;
1154 return "Invalid new customer number: $new_custnum";
1156 foreach my $cust_pkg ( @cust_pkg ) {
1157 my %hash = $cust_pkg->hash;
1158 $hash{'custnum'} = $new_custnum;
1159 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1160 my $error = $new_cust_pkg->replace($cust_pkg,
1161 options => { $cust_pkg->options },
1164 $dbh->rollback if $oldAutoCommit;
1169 my @cancelled_cust_pkg = $self->all_pkgs;
1170 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1171 my $error = $cust_pkg->delete;
1173 $dbh->rollback if $oldAutoCommit;
1178 #cust_tax_adjustment in financials?
1179 #cust_pay_pending? ouch
1181 foreach my $table (qw(
1182 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1183 cust_location cust_main_note cust_tax_adjustment
1184 cust_pay_void cust_pay_batch queue cust_tax_exempt
1186 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1187 my $error = $record->delete;
1189 $dbh->rollback if $oldAutoCommit;
1195 my $sth = $dbh->prepare(
1196 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1198 my $errstr = $dbh->errstr;
1199 $dbh->rollback if $oldAutoCommit;
1202 $sth->execute($self->custnum) or do {
1203 my $errstr = $sth->errstr;
1204 $dbh->rollback if $oldAutoCommit;
1210 my $ticket_dbh = '';
1211 if ($conf->config('ticket_system') eq 'RT_Internal') {
1213 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1214 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1215 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1216 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1219 if ( $ticket_dbh ) {
1221 my $ticket_sth = $ticket_dbh->prepare(
1222 'DELETE FROM Links WHERE Target = ?'
1224 my $errstr = $ticket_dbh->errstr;
1225 $dbh->rollback if $oldAutoCommit;
1228 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1230 my $errstr = $ticket_sth->errstr;
1231 $dbh->rollback if $oldAutoCommit;
1235 #check and see if the customer is the only link on the ticket, and
1236 #if so, set the ticket to deleted status in RT?
1237 #maybe someday, for now this will at least fix tickets not displaying
1241 #delete the customer record
1243 my $error = $self->SUPER::delete;
1245 $dbh->rollback if $oldAutoCommit;
1249 # cust_main exports!
1251 #my $export_args = $options{'export_args'} || [];
1254 map qsearch( 'part_export', {exportnum=>$_} ),
1255 $conf->config('cust_main-exports'); #, $agentnum
1257 foreach my $part_export ( @part_export ) {
1258 my $error = $part_export->export_delete( $self ); #, @$export_args);
1260 $dbh->rollback if $oldAutoCommit;
1261 return "exporting to ". $part_export->exporttype.
1262 " (transaction rolled back): $error";
1266 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1271 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1273 This merges this customer into the provided new custnum, and then deletes the
1274 customer. If there is an error, returns the error, otherwise returns false.
1276 The source customer's name, company name, phone numbers, agent,
1277 referring customer, customer class, advertising source, order taker, and
1278 billing information (except balance) are discarded.
1280 All packages are moved to the target customer. Packages with package locations
1281 are preserved. Packages without package locations are moved to a new package
1282 location with the source customer's service/shipping address.
1284 All invoices, statements, payments, credits and refunds are moved to the target
1285 customer. The source customer's balance is added to the target customer.
1287 All notes, attachments, tickets and customer tags are moved to the target
1290 Change history is not currently moved.
1295 my( $self, $new_custnum, %opt ) = @_;
1297 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1299 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1300 or return "Invalid new customer number: $new_custnum";
1302 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1303 if $self->agentnum != $new_cust_main->agentnum
1304 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1306 local $SIG{HUP} = 'IGNORE';
1307 local $SIG{INT} = 'IGNORE';
1308 local $SIG{QUIT} = 'IGNORE';
1309 local $SIG{TERM} = 'IGNORE';
1310 local $SIG{TSTP} = 'IGNORE';
1311 local $SIG{PIPE} = 'IGNORE';
1313 my $oldAutoCommit = $FS::UID::AutoCommit;
1314 local $FS::UID::AutoCommit = 0;
1317 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1318 $dbh->rollback if $oldAutoCommit;
1319 return "Can't merge a master agent customer";
1322 #use FS::access_user
1323 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1324 $dbh->rollback if $oldAutoCommit;
1325 return "Can't merge a master employee customer";
1328 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1329 'status' => { op=>'!=', value=>'done' },
1333 $dbh->rollback if $oldAutoCommit;
1334 return "Can't merge a customer with pending payments";
1337 tie my %financial_tables, 'Tie::IxHash',
1338 'cust_bill' => 'invoices',
1339 'cust_bill_void' => 'voided invoices',
1340 'cust_statement' => 'statements',
1341 'cust_credit' => 'credits',
1342 'cust_credit_void' => 'voided credits',
1343 'cust_pay' => 'payments',
1344 'cust_pay_void' => 'voided payments',
1345 'cust_refund' => 'refunds',
1348 foreach my $table ( keys %financial_tables ) {
1350 my @records = $self->$table();
1352 foreach my $record ( @records ) {
1353 $record->custnum($new_custnum);
1354 my $error = $record->replace;
1356 $dbh->rollback if $oldAutoCommit;
1357 return "Error merging ". $financial_tables{$table}. ": $error\n";
1363 my $name = $self->ship_name; #?
1365 my $locationnum = '';
1366 foreach my $cust_pkg ( $self->all_pkgs ) {
1367 $cust_pkg->custnum($new_custnum);
1369 unless ( $cust_pkg->locationnum ) {
1370 unless ( $locationnum ) {
1371 my $cust_location = new FS::cust_location {
1372 $self->location_hash,
1373 'custnum' => $new_custnum,
1375 my $error = $cust_location->insert;
1377 $dbh->rollback if $oldAutoCommit;
1380 $locationnum = $cust_location->locationnum;
1382 $cust_pkg->locationnum($locationnum);
1385 my $error = $cust_pkg->replace;
1387 $dbh->rollback if $oldAutoCommit;
1391 # add customer (ship) name to svc_phone.phone_name if blank
1392 my @cust_svc = $cust_pkg->cust_svc;
1393 foreach my $cust_svc (@cust_svc) {
1394 my($label, $value, $svcdb) = $cust_svc->label;
1395 next unless $svcdb eq 'svc_phone';
1396 my $svc_phone = $cust_svc->svc_x;
1397 next if $svc_phone->phone_name;
1398 $svc_phone->phone_name($name);
1399 my $error = $svc_phone->replace;
1401 $dbh->rollback if $oldAutoCommit;
1409 # cust_tax_exempt (texas tax exemptions)
1410 # cust_recon (some sort of not-well understood thing for OnPac)
1412 #these are moved over
1413 foreach my $table (qw(
1414 cust_tag cust_location contact cust_attachment cust_main_note
1415 cust_tax_adjustment cust_pay_batch queue
1417 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1418 $record->custnum($new_custnum);
1419 my $error = $record->replace;
1421 $dbh->rollback if $oldAutoCommit;
1427 #these aren't preserved
1428 foreach my $table (qw(
1429 cust_main_exemption cust_main_invoice
1431 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1432 my $error = $record->delete;
1434 $dbh->rollback if $oldAutoCommit;
1441 my $sth = $dbh->prepare(
1442 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1444 my $errstr = $dbh->errstr;
1445 $dbh->rollback if $oldAutoCommit;
1448 $sth->execute($new_custnum, $self->custnum) or do {
1449 my $errstr = $sth->errstr;
1450 $dbh->rollback if $oldAutoCommit;
1456 my $ticket_dbh = '';
1457 if ($conf->config('ticket_system') eq 'RT_Internal') {
1459 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1460 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1461 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1462 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1465 if ( $ticket_dbh ) {
1467 my $ticket_sth = $ticket_dbh->prepare(
1468 'UPDATE Links SET Target = ? WHERE Target = ?'
1470 my $errstr = $ticket_dbh->errstr;
1471 $dbh->rollback if $oldAutoCommit;
1474 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1475 'freeside://freeside/cust_main/'.$self->custnum)
1477 my $errstr = $ticket_sth->errstr;
1478 $dbh->rollback if $oldAutoCommit;
1484 #delete the customer record
1486 my $error = $self->delete;
1488 $dbh->rollback if $oldAutoCommit;
1492 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1497 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1499 Replaces the OLD_RECORD with this one in the database. If there is an error,
1500 returns the error, otherwise returns false.
1502 To change the customer's address, set the pseudo-fields C<bill_location> and
1503 C<ship_location>. The address will still only change if at least one of the
1504 address fields differs from the existing values.
1506 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1507 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1508 expected and rollback the entire transaction; it is not necessary to call
1509 check_invoicing_list first. Here's an example:
1511 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1513 Currently available options are: I<tax_exemption>.
1515 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1516 of tax names and exemption numbers. FS::cust_main_exemption records will be
1517 deleted and inserted as appropriate.
1524 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1526 : $self->replace_old;
1530 warn "$me replace called\n"
1533 my $curuser = $FS::CurrentUser::CurrentUser;
1534 if ( $self->payby eq 'COMP'
1535 && $self->payby ne $old->payby
1536 && ! $curuser->access_right('Complimentary customer')
1539 return "You are not permitted to create complimentary accounts.";
1542 local($ignore_expired_card) = 1
1543 if $old->payby =~ /^(CARD|DCRD)$/
1544 && $self->payby =~ /^(CARD|DCRD)$/
1545 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1547 local($ignore_banned_card) = 1
1548 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1549 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1550 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1552 if ( $self->payby =~ /^(CARD|DCRD)$/
1553 && $old->payinfo ne $self->payinfo
1554 && $old->paymask ne $self->paymask )
1556 my $error = $self->check_payinfo_cardtype;
1557 return $error if $error;
1559 if ( $conf->exists('business-onlinepayment-verification') ) {
1560 #need to standardize paydate for this, false laziness with check
1562 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1563 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1564 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1565 ( $m, $y ) = ( $2, "19$1" );
1566 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1567 ( $m, $y ) = ( $3, "20$2" );
1569 return "Illegal expiration date: ". $self->paydate;
1571 $m = sprintf('%02d',$m);
1572 $self->paydate("$y-$m-01");
1574 $error = $self->realtime_verify_bop({ 'method'=>'CC' });
1575 return $error if $error;
1579 return "Invoicing locale is required"
1582 && $conf->exists('cust_main-require_locale');
1584 local $SIG{HUP} = 'IGNORE';
1585 local $SIG{INT} = 'IGNORE';
1586 local $SIG{QUIT} = 'IGNORE';
1587 local $SIG{TERM} = 'IGNORE';
1588 local $SIG{TSTP} = 'IGNORE';
1589 local $SIG{PIPE} = 'IGNORE';
1591 my $oldAutoCommit = $FS::UID::AutoCommit;
1592 local $FS::UID::AutoCommit = 0;
1595 for my $l (qw(bill_location ship_location)) {
1596 my $old_loc = $old->$l;
1597 my $new_loc = $self->$l;
1599 # find the existing location if there is one
1600 $new_loc->set('custnum' => $self->custnum);
1601 my $error = $new_loc->find_or_insert;
1603 $dbh->rollback if $oldAutoCommit;
1606 $self->set($l.'num', $new_loc->locationnum);
1609 # replace the customer record
1610 my $error = $self->SUPER::replace($old);
1613 $dbh->rollback if $oldAutoCommit;
1617 # now move packages to the new service location
1618 $self->set('ship_location', ''); #flush cache
1619 if ( $old->ship_locationnum and # should only be null during upgrade...
1620 $old->ship_locationnum != $self->ship_locationnum ) {
1621 $error = $old->ship_location->move_to($self->ship_location);
1623 $dbh->rollback if $oldAutoCommit;
1627 # don't move packages based on the billing location, but
1628 # disable it if it's no longer in use
1629 if ( $old->bill_locationnum and
1630 $old->bill_locationnum != $self->bill_locationnum ) {
1631 $error = $old->bill_location->disable_if_unused;
1633 $dbh->rollback if $oldAutoCommit;
1638 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1639 my $invoicing_list = shift @param;
1640 $error = $self->check_invoicing_list( $invoicing_list );
1642 $dbh->rollback if $oldAutoCommit;
1645 $self->invoicing_list( $invoicing_list );
1648 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1650 #this could be more efficient than deleting and re-inserting, if it matters
1651 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1652 my $error = $cust_tag->delete;
1654 $dbh->rollback if $oldAutoCommit;
1658 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1659 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1660 'custnum' => $self->custnum };
1661 my $error = $cust_tag->insert;
1663 $dbh->rollback if $oldAutoCommit;
1670 my %options = @param;
1672 my $tax_exemption = delete $options{'tax_exemption'};
1673 if ( $tax_exemption ) {
1675 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1676 if ref($tax_exemption) eq 'ARRAY';
1678 my %cust_main_exemption =
1679 map { $_->taxname => $_ }
1680 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1682 foreach my $taxname ( keys %$tax_exemption ) {
1684 if ( $cust_main_exemption{$taxname} &&
1685 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1688 delete $cust_main_exemption{$taxname};
1692 my $cust_main_exemption = new FS::cust_main_exemption {
1693 'custnum' => $self->custnum,
1694 'taxname' => $taxname,
1695 'exempt_number' => $tax_exemption->{$taxname},
1697 my $error = $cust_main_exemption->insert;
1699 $dbh->rollback if $oldAutoCommit;
1700 return "inserting cust_main_exemption (transaction rolled back): $error";
1704 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1705 my $error = $cust_main_exemption->delete;
1707 $dbh->rollback if $oldAutoCommit;
1708 return "deleting cust_main_exemption (transaction rolled back): $error";
1714 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1715 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1716 && $self->get('payinfo') !~ /^99\d{14}$/
1718 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1723 # card/check/lec info has changed, want to retry realtime_ invoice events
1724 my $error = $self->retry_realtime;
1726 $dbh->rollback if $oldAutoCommit;
1731 unless ( $import || $skip_fuzzyfiles ) {
1732 $error = $self->queue_fuzzyfiles_update;
1734 $dbh->rollback if $oldAutoCommit;
1735 return "updating fuzzy search cache: $error";
1739 # tax district update in cust_location
1741 # cust_main exports!
1743 my $export_args = $options{'export_args'} || [];
1746 map qsearch( 'part_export', {exportnum=>$_} ),
1747 $conf->config('cust_main-exports'); #, $agentnum
1749 foreach my $part_export ( @part_export ) {
1750 my $error = $part_export->export_replace( $self, $old, @$export_args);
1752 $dbh->rollback if $oldAutoCommit;
1753 return "exporting to ". $part_export->exporttype.
1754 " (transaction rolled back): $error";
1758 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1763 =item queue_fuzzyfiles_update
1765 Used by insert & replace to update the fuzzy search cache
1769 use FS::cust_main::Search;
1770 sub queue_fuzzyfiles_update {
1773 local $SIG{HUP} = 'IGNORE';
1774 local $SIG{INT} = 'IGNORE';
1775 local $SIG{QUIT} = 'IGNORE';
1776 local $SIG{TERM} = 'IGNORE';
1777 local $SIG{TSTP} = 'IGNORE';
1778 local $SIG{PIPE} = 'IGNORE';
1780 my $oldAutoCommit = $FS::UID::AutoCommit;
1781 local $FS::UID::AutoCommit = 0;
1784 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1785 my $queue = new FS::queue {
1786 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1788 my @args = "cust_main.$field", $self->get($field);
1789 my $error = $queue->insert( @args );
1791 $dbh->rollback if $oldAutoCommit;
1792 return "queueing job (transaction rolled back): $error";
1796 my @locations = $self->bill_location;
1797 push @locations, $self->ship_location if $self->has_ship_address;
1798 foreach my $location (@locations) {
1799 my $queue = new FS::queue {
1800 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1802 my @args = 'cust_location.address1', $location->address1;
1803 my $error = $queue->insert( @args );
1805 $dbh->rollback if $oldAutoCommit;
1806 return "queueing job (transaction rolled back): $error";
1810 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1817 Checks all fields to make sure this is a valid customer record. If there is
1818 an error, returns the error, otherwise returns false. Called by the insert
1819 and replace methods.
1826 warn "$me check BEFORE: \n". $self->_dump
1830 $self->ut_numbern('custnum')
1831 || $self->ut_number('agentnum')
1832 || $self->ut_textn('agent_custid')
1833 || $self->ut_number('refnum')
1834 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1835 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1836 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1837 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1838 || $self->ut_textn('custbatch')
1839 || $self->ut_name('last')
1840 || $self->ut_name('first')
1841 || $self->ut_snumbern('signupdate')
1842 || $self->ut_snumbern('birthdate')
1843 || $self->ut_namen('spouse_last')
1844 || $self->ut_namen('spouse_first')
1845 || $self->ut_snumbern('spouse_birthdate')
1846 || $self->ut_snumbern('anniversary_date')
1847 || $self->ut_textn('company')
1848 || $self->ut_textn('ship_company')
1849 || $self->ut_anything('comments')
1850 || $self->ut_numbern('referral_custnum')
1851 || $self->ut_textn('stateid')
1852 || $self->ut_textn('stateid_state')
1853 || $self->ut_textn('invoice_terms')
1854 || $self->ut_floatn('cdr_termination_percentage')
1855 || $self->ut_floatn('credit_limit')
1856 || $self->ut_numbern('billday')
1857 || $self->ut_numbern('prorate_day')
1858 || $self->ut_flag('force_prorate_day')
1859 || $self->ut_flag('edit_subject')
1860 || $self->ut_flag('calling_list_exempt')
1861 || $self->ut_flag('invoice_noemail')
1862 || $self->ut_flag('message_noemail')
1863 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1864 || $self->ut_flag('invoice_ship_address')
1867 foreach (qw(company ship_company)) {
1868 my $company = $self->get($_);
1869 $company =~ s/^\s+//;
1870 $company =~ s/\s+$//;
1871 $company =~ s/\s+/ /g;
1872 $self->set($_, $company);
1875 #barf. need message catalogs. i18n. etc.
1876 $error .= "Please select an advertising source."
1877 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1878 return $error if $error;
1880 return "Unknown agent"
1881 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1883 return "Unknown refnum"
1884 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1886 return "Unknown referring custnum: ". $self->referral_custnum
1887 unless ! $self->referral_custnum
1888 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1890 if ( $self->ss eq '' ) {
1895 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1896 or return "Illegal social security number: ". $self->ss;
1897 $self->ss("$1-$2-$3");
1900 #turn off invoice_ship_address if ship & bill are the same
1901 if ($self->bill_locationnum eq $self->ship_locationnum) {
1902 $self->invoice_ship_address('');
1905 # cust_main_county verification now handled by cust_location check
1908 $self->ut_phonen('daytime', $self->country)
1909 || $self->ut_phonen('night', $self->country)
1910 || $self->ut_phonen('fax', $self->country)
1911 || $self->ut_phonen('mobile', $self->country)
1913 return $error if $error;
1915 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1917 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1920 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1922 : FS::Msgcat::_gettext('daytime');
1923 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1925 : FS::Msgcat::_gettext('night');
1927 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1929 : FS::Msgcat::_gettext('mobile');
1931 return "$daytime_label, $night_label or $mobile_label is required"
1935 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1936 # or return "Illegal payby: ". $self->payby;
1938 FS::payby->can_payby($self->table, $self->payby)
1939 or return "Illegal payby: ". $self->payby;
1941 $error = $self->ut_numbern('paystart_month')
1942 || $self->ut_numbern('paystart_year')
1943 || $self->ut_numbern('payissue')
1944 || $self->ut_textn('paytype')
1946 return $error if $error;
1948 if ( $self->payip eq '' ) {
1951 $error = $self->ut_ip('payip');
1952 return $error if $error;
1955 # If it is encrypted and the private key is not availaible then we can't
1956 # check the credit card.
1957 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1959 # Need some kind of global flag to accept invalid cards, for testing
1961 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1963 my $payinfo = $self->payinfo;
1964 $payinfo =~ s/\D//g;
1965 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1966 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1968 $self->payinfo($payinfo);
1970 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1972 my $cardtype = $self->paycardtype;
1973 if ( $payinfo =~ /^99\d{14}$/ ) {
1974 $self->set('is_tokenized', 'Y'); #so we don't try to do it again
1975 if ( $self->paymask =~ /^\d+x/ ) {
1976 $cardtype = cardtype($self->paymask);
1978 #return "paycardtype required ".
1979 # "(can't derive from a token and no paymask w/prefix provided)"
1983 $cardtype = cardtype($self->payinfo);
1986 return gettext('unknown_card_type') if $cardtype eq 'Unknown';
1988 $self->set('paycardtype', $cardtype);
1990 unless ( $ignore_banned_card ) {
1991 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1993 if ( $ban->bantype eq 'warn' ) {
1994 #or others depending on value of $ban->reason ?
1995 return '_duplicate_card'.
1996 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1997 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1998 ' (ban# '. $ban->bannum. ')'
1999 unless $self->override_ban_warn;
2001 return 'Banned credit card: banned on '.
2002 time2str('%a %h %o at %r', $ban->_date).
2003 ' by '. $ban->otaker.
2004 ' (ban# '. $ban->bannum. ')';
2009 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
2010 if ( $cardtype eq 'American Express card' ) {
2011 $self->paycvv =~ /^(\d{4})$/
2012 or return "CVV2 (CID) for American Express cards is four digits.";
2015 $self->paycvv =~ /^(\d{3})$/
2016 or return "CVV2 (CVC2/CID) is three digits.";
2023 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
2025 return "Start date or issue number is required for $cardtype cards"
2026 unless $self->paystart_month && $self->paystart_year or $self->payissue;
2028 return "Start month must be between 1 and 12"
2029 if $self->paystart_month
2030 and $self->paystart_month < 1 || $self->paystart_month > 12;
2032 return "Start year must be 1990 or later"
2033 if $self->paystart_year
2034 and $self->paystart_year < 1990;
2036 return "Issue number must be beween 1 and 99"
2038 and $self->payissue < 1 || $self->payissue > 99;
2041 $self->paystart_month('');
2042 $self->paystart_year('');
2043 $self->payissue('');
2046 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
2048 my $payinfo = $self->payinfo;
2049 $payinfo =~ s/[^\d\@\.]//g;
2050 if ( $conf->config('echeck-country') eq 'CA' ) {
2051 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
2052 or return 'invalid echeck account@branch.bank';
2053 $payinfo = "$1\@$2.$3";
2054 } elsif ( $conf->config('echeck-country') eq 'US' ) {
2055 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
2056 $payinfo = "$1\@$2";
2058 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
2059 $payinfo = "$1\@$2";
2061 $self->payinfo($payinfo);
2064 unless ( $ignore_banned_card ) {
2065 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2067 if ( $ban->bantype eq 'warn' ) {
2068 #or others depending on value of $ban->reason ?
2069 return '_duplicate_ach' unless $self->override_ban_warn;
2071 return 'Banned ACH account: banned on '.
2072 time2str('%a %h %o at %r', $ban->_date).
2073 ' by '. $ban->otaker.
2074 ' (ban# '. $ban->bannum. ')';
2079 } elsif ( $self->payby eq 'LECB' ) {
2081 my $payinfo = $self->payinfo;
2082 $payinfo =~ s/\D//g;
2083 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2085 $self->payinfo($payinfo);
2088 } elsif ( $self->payby eq 'BILL' ) {
2090 $error = $self->ut_textn('payinfo');
2091 return "Illegal P.O. number: ". $self->payinfo if $error;
2094 } elsif ( $self->payby eq 'COMP' ) {
2096 my $curuser = $FS::CurrentUser::CurrentUser;
2097 if ( ! $self->custnum
2098 && ! $curuser->access_right('Complimentary customer')
2101 return "You are not permitted to create complimentary accounts."
2104 $error = $self->ut_textn('payinfo');
2105 return "Illegal comp account issuer: ". $self->payinfo if $error;
2108 } elsif ( $self->payby eq 'PREPAY' ) {
2110 my $payinfo = $self->payinfo;
2111 $payinfo =~ s/\W//g; #anything else would just confuse things
2112 $self->payinfo($payinfo);
2113 $error = $self->ut_alpha('payinfo');
2114 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2115 return "Unknown prepayment identifier"
2116 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2119 } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
2120 # either ignoring invalid cards, or we can't decrypt the payinfo, but
2121 # try to detect the card type anyway. this never returns failure, so
2122 # the contract of $ignore_invalid_cards is maintained.
2123 $self->set('paycardtype', cardtype($self->paymask));
2126 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2127 return "Expiration date required"
2128 # shouldn't payinfo_check do this?
2129 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2133 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2134 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2135 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2136 ( $m, $y ) = ( $2, "19$1" );
2137 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2138 ( $m, $y ) = ( $3, "20$2" );
2140 return "Illegal expiration date: ". $self->paydate;
2142 $m = sprintf('%02d',$m);
2143 $self->paydate("$y-$m-01");
2144 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2145 return gettext('expired_card')
2147 && !$ignore_expired_card
2148 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2150 if ( my $error = $self->ut_daten('paydate') ) {
2155 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2156 ( ! $conf->exists('require_cardname')
2157 || $self->payby !~ /^(CARD|DCRD)$/ )
2159 $self->payname( $self->first. " ". $self->getfield('last') );
2162 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2163 $self->payname =~ /^([\w \,\.\-\']*)$/
2164 or return gettext('illegal_name'). " payname: ". $self->payname;
2167 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2168 or return gettext('illegal_name'). " payname: ". $self->payname;
2174 return "Please select an invoicing locale"
2177 && $conf->exists('cust_main-require_locale');
2179 return "Please select a customer class"
2180 if ! $self->classnum
2181 && $conf->exists('cust_main-require_classnum');
2183 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2184 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2188 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2190 warn "$me check AFTER: \n". $self->_dump
2193 $self->SUPER::check;
2196 sub check_payinfo_cardtype {
2199 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
2201 my $payinfo = $self->payinfo;
2202 $payinfo =~ s/\D//g;
2204 if ( $payinfo =~ /^99\d{14}$/ ) {
2208 my %bop_card_types = map { $_=>1 } values %{ card_types() };
2209 my $cardtype = cardtype($payinfo);
2210 $self->set('paycardtype', $cardtype);
2212 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
2220 Additional checks for replace only.
2225 my ($new,$old) = @_;
2226 #preserve old value if global config is set
2227 if ($old && $conf->exists('invoice-ship_address')) {
2228 $new->invoice_ship_address($old->invoice_ship_address);
2235 Returns a list of fields which have ship_ duplicates.
2240 qw( last first company
2242 address1 address2 city county state zip country
2244 daytime night fax mobile
2248 =item has_ship_address
2250 Returns true if this customer record has a separate shipping address.
2254 sub has_ship_address {
2256 $self->bill_locationnum != $self->ship_locationnum;
2261 Returns a list of key/value pairs, with the following keys: address1,
2262 adddress2, city, county, state, zip, country, district, and geocode. The
2263 shipping address is used if present.
2269 $self->ship_location->location_hash;
2274 Returns all locations (see L<FS::cust_location>) for this customer.
2280 qsearch('cust_location', { 'custnum' => $self->custnum,
2281 'prospectnum' => '' } );
2286 Returns all contacts (see L<FS::contact>) for this customer.
2290 #already used :/ sub contact {
2293 qsearch('contact', { 'custnum' => $self->custnum } );
2298 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2299 and L<FS::cust_pkg>) for this customer, except those on hold.
2301 Returns a list: an empty list on success or a list of errors.
2307 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
2312 Unsuspends all suspended packages in the on-hold state (those without setup
2313 dates) for this customer.
2319 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2324 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2326 Returns a list: an empty list on success or a list of errors.
2332 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2335 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2337 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2338 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2339 of a list of pkgparts; the hashref has the following keys:
2343 =item pkgparts - listref of pkgparts
2345 =item (other options are passed to the suspend method)
2350 Returns a list: an empty list on success or a list of errors.
2354 sub suspend_if_pkgpart {
2356 my (@pkgparts, %opt);
2357 if (ref($_[0]) eq 'HASH'){
2358 @pkgparts = @{$_[0]{pkgparts}};
2363 grep { $_->suspend(%opt) }
2364 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2365 $self->unsuspended_pkgs;
2368 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2370 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2371 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2372 instead of a list of pkgparts; the hashref has the following keys:
2376 =item pkgparts - listref of pkgparts
2378 =item (other options are passed to the suspend method)
2382 Returns a list: an empty list on success or a list of errors.
2386 sub suspend_unless_pkgpart {
2388 my (@pkgparts, %opt);
2389 if (ref($_[0]) eq 'HASH'){
2390 @pkgparts = @{$_[0]{pkgparts}};
2395 grep { $_->suspend(%opt) }
2396 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2397 $self->unsuspended_pkgs;
2400 =item cancel [ OPTION => VALUE ... ]
2402 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2403 The cancellation time will be now.
2407 Always returns a list: an empty list on success or a list of errors.
2414 warn "$me cancel called on customer ". $self->custnum. " with options ".
2415 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2417 my @pkgs = $self->ncancelled_pkgs;
2419 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2422 =item cancel_pkgs OPTIONS
2424 Cancels a specified list of packages. OPTIONS can include:
2428 =item cust_pkg - an arrayref of the packages. Required.
2430 =item time - the cancellation time, used to calculate final bills and
2431 unused-time credits if any. Will be passed through to the bill() and
2432 FS::cust_pkg::cancel() methods.
2434 =item quiet - can be set true to supress email cancellation notices.
2436 =item reason - can be set to a cancellation reason (see L<FS::reason>), either a
2437 reasonnum of an existing reason, or passing a hashref will create a new reason.
2438 The hashref should have the following keys:
2439 typenum - Reason type (see L<FS::reason_type>)
2440 reason - Text of the new reason.
2442 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2443 for the individual packages, parallel to the C<cust_pkg> argument. The
2444 reason and reason_otaker arguments will be taken from those objects.
2446 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2448 =item nobill - can be set true to skip billing if it might otherwise be done.
2453 my( $self, %opt ) = @_;
2455 # we're going to cancel services, which is not reversible
2456 # but on 3.x, don't strictly enforce this
2457 warn "cancel_pkgs should not be run inside a transaction"
2458 if $FS::UID::AutoCommit == 0;
2460 local $FS::UID::AutoCommit = 0;
2462 return ( 'access denied' )
2463 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2465 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2467 #should try decryption (we might have the private key)
2468 # and if not maybe queue a job for the server that does?
2469 return ( "Can't (yet) ban encrypted credit cards" )
2470 if $self->is_encrypted($self->payinfo);
2472 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2473 my $error = $ban->insert;
2481 my @pkgs = @{ delete $opt{'cust_pkg'} };
2482 my $cancel_time = $opt{'time'} || time;
2484 # bill all packages first, so we don't lose usage, service counts for
2485 # bulk billing, etc.
2486 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2488 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2490 'time' => $cancel_time );
2492 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2494 return ( "Error billing during cancellation: $error" );
2500 # try to cancel each service, the same way we would for individual packages,
2501 # but in cancel weight order.
2502 my @cust_svc = map { $_->cust_svc } @pkgs;
2503 my @sorted_cust_svc =
2505 sort { $a->[1] <=> $b->[1] }
2506 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2508 warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2511 foreach my $cust_svc (@sorted_cust_svc) {
2512 my $part_svc = $cust_svc->part_svc;
2513 next if ( defined($part_svc) and $part_svc->preserve );
2514 # immediate cancel, no date option
2515 # transactionize individually
2516 my $error = try { $cust_svc->cancel } catch { $_ };
2519 push @errors, $error;
2528 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2529 $self->custnum. "\n"
2533 if ($opt{'cust_pkg_reason'}) {
2534 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2540 my $cpr = shift @cprs;
2542 $lopt{'reason'} = $cpr->reasonnum;
2543 $lopt{'reason_otaker'} = $cpr->otaker;
2545 warn "no reason found when canceling package ".$_->pkgnum."\n";
2546 $lopt{'reason'} = '';
2549 my $error = $_->cancel(%lopt);
2552 push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2561 sub _banned_pay_hashref {
2572 'payby' => $payby2ban{$self->payby},
2573 'payinfo' => $self->payinfo,
2574 #don't ever *search* on reason! #'reason' =>
2578 sub _new_banned_pay_hashref {
2580 my $hr = $self->_banned_pay_hashref;
2581 $hr->{payinfo} = md5_base64($hr->{payinfo});
2587 Returns all notes (see L<FS::cust_main_note>) for this customer.
2592 my($self,$orderby_classnum) = (shift,shift);
2593 my $orderby = "sticky DESC, _date DESC";
2594 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2595 qsearch( 'cust_main_note',
2596 { 'custnum' => $self->custnum },
2598 "ORDER BY $orderby",
2604 Returns the agent (see L<FS::agent>) for this customer.
2610 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2615 Returns the agent name (see L<FS::agent>) for this customer.
2621 $self->agent->agent;
2626 Returns any tags associated with this customer, as FS::cust_tag objects,
2627 or an empty list if there are no tags.
2633 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2638 Returns any tags associated with this customer, as FS::part_tag objects,
2639 or an empty list if there are no tags.
2645 map $_->part_tag, $self->cust_tag;
2651 Returns the customer class, as an FS::cust_class object, or the empty string
2652 if there is no customer class.
2658 if ( $self->classnum ) {
2659 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2667 Returns the customer category name, or the empty string if there is no customer
2674 my $cust_class = $self->cust_class;
2676 ? $cust_class->categoryname
2682 Returns the customer class name, or the empty string if there is no customer
2689 my $cust_class = $self->cust_class;
2691 ? $cust_class->classname
2695 =item BILLING METHODS
2697 Documentation on billing methods has been moved to
2698 L<FS::cust_main::Billing>.
2700 =item REALTIME BILLING METHODS
2702 Documentation on realtime billing methods has been moved to
2703 L<FS::cust_main::Billing_Realtime>.
2707 Removes the I<paycvv> field from the database directly.
2709 If there is an error, returns the error, otherwise returns false.
2715 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2716 or return dbh->errstr;
2717 $sth->execute($self->custnum)
2718 or return $sth->errstr;
2723 =item batch_card OPTION => VALUE...
2725 Adds a payment for this invoice to the pending credit card batch (see
2726 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2727 runs the payment using a realtime gateway.
2729 Options may include:
2731 B<amount>: the amount to be paid; defaults to the customer's balance minus
2732 any payments in transit.
2734 B<payby>: the payment method; defaults to cust_main.payby
2736 B<realtime>: runs this as a realtime payment instead of adding it to a
2739 B<invnum>: sets cust_pay_batch.invnum.
2741 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2742 the billing address for the payment; defaults to the customer's billing
2745 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2746 date, and name; defaults to those fields in cust_main.
2751 my ($self, %options) = @_;
2754 if (exists($options{amount})) {
2755 $amount = $options{amount};
2757 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2760 warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n",
2762 $self->in_transit_payments
2767 my $invnum = delete $options{invnum};
2768 my $payby = $options{payby} || $self->payby; #still dubious
2770 if ($options{'realtime'}) {
2771 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2777 my $oldAutoCommit = $FS::UID::AutoCommit;
2778 local $FS::UID::AutoCommit = 0;
2781 #this needs to handle mysql as well as Pg, like svc_acct.pm
2782 #(make it into a common function if folks need to do batching with mysql)
2783 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2784 or return "Cannot lock pay_batch: " . $dbh->errstr;
2788 'payby' => FS::payby->payby2payment($payby),
2790 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2792 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2794 unless ( $pay_batch ) {
2795 $pay_batch = new FS::pay_batch \%pay_batch;
2796 my $error = $pay_batch->insert;
2798 $dbh->rollback if $oldAutoCommit;
2799 die "error creating new batch: $error\n";
2803 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2804 'batchnum' => $pay_batch->batchnum,
2805 'custnum' => $self->custnum,
2808 foreach (qw( address1 address2 city state zip country latitude longitude
2809 payby payinfo paydate payname paycode paytype ))
2811 $options{$_} = '' unless exists($options{$_});
2814 my $loc = $self->bill_location;
2816 my $cust_pay_batch = new FS::cust_pay_batch ( {
2817 'batchnum' => $pay_batch->batchnum,
2818 'invnum' => $invnum || 0, # is there a better value?
2819 # this field should be
2821 # cust_bill_pay_batch now
2822 'custnum' => $self->custnum,
2823 'last' => $self->getfield('last'),
2824 'first' => $self->getfield('first'),
2825 'address1' => $options{address1} || $loc->address1,
2826 'address2' => $options{address2} || $loc->address2,
2827 'city' => $options{city} || $loc->city,
2828 'state' => $options{state} || $loc->state,
2829 'zip' => $options{zip} || $loc->zip,
2830 'country' => $options{country} || $loc->country,
2831 'payby' => $options{payby} || $self->payby,
2832 'payinfo' => $options{payinfo} || $self->payinfo,
2833 'paymask' => ( $options{payinfo}
2834 ? FS::payinfo_Mixin->mask_payinfo( $options{payby},
2838 'exp' => $options{paydate} || $self->paydate,
2839 'payname' => $options{payname} || $self->payname,
2840 'amount' => $amount, # consolidating
2841 'paycode' => $options{paycode} || '',
2844 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2845 if $old_cust_pay_batch;
2848 if ($old_cust_pay_batch) {
2849 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2851 $error = $cust_pay_batch->insert;
2855 $dbh->rollback if $oldAutoCommit;
2859 if ($options{'processing-fee'} > 0) {
2861 my $processing_fee_text = 'Payment Processing Fee';
2863 unless ( $invnum ) { # probably from a payment screen
2864 # do we have any open invoices? pick earliest
2865 # uses the fact that cust_main->cust_bill sorts by date ascending
2866 my @open = $self->open_cust_bill;
2867 $invnum = $open[0]->invnum if scalar(@open);
2870 unless ( $invnum ) { # still nothing? pick last closed invoice
2871 # again uses fact that cust_main->cust_bill sorts by date ascending
2872 my @closed = $self->cust_bill;
2873 $invnum = $closed[$#closed]->invnum if scalar(@closed);
2876 unless ( $invnum ) {
2877 # XXX: unlikely case - pre-paying before any invoices generated
2878 # what it should do is create a new invoice and pick it
2879 warn '\PROCESS FEE AND NO INVOICES PICKED TO APPLY IT!';
2883 my $pf_change_error = $self->charge({
2884 'amount' => $options{'processing-fee'},
2885 'pkg' => $processing_fee_text,
2887 'cust_pkg_ref' => \$pf_cust_pkg,
2890 if($pf_change_error) {
2891 warn 'Unable to add payment processing fee';
2895 $pf_cust_pkg->setup(time);
2896 my $pf_error = $pf_cust_pkg->replace;
2898 warn 'Unable to set setup time on cust_pkg for processing fee';
2902 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum });
2903 unless ( $cust_bill ) {
2904 warn "race condition + invoice deletion just happened";
2908 my $grand_pf_error =
2909 $cust_bill->add_cc_surcharge($pf_cust_pkg->pkgnum,$options{'processing-fee'});
2911 warn "cannot add Processing fee to invoice #$invnum: $grand_pf_error"
2915 my $unapplied = $self->total_unapplied_credits
2916 + $self->total_unapplied_payments
2917 + $self->in_transit_payments;
2918 foreach my $cust_bill ($self->open_cust_bill) {
2919 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2920 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2921 'invnum' => $cust_bill->invnum,
2922 'paybatchnum' => $cust_pay_batch->paybatchnum,
2923 'amount' => $cust_bill->owed,
2926 if ($unapplied >= $cust_bill_pay_batch->amount){
2927 $unapplied -= $cust_bill_pay_batch->amount;
2930 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2931 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2933 $error = $cust_bill_pay_batch->insert;
2935 $dbh->rollback if $oldAutoCommit;
2940 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2946 Returns the total owed for this customer on all invoices
2947 (see L<FS::cust_bill/owed>).
2953 $self->total_owed_date(2145859200); #12/31/2037
2956 =item total_owed_date TIME
2958 Returns the total owed for this customer on all invoices with date earlier than
2959 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2960 see L<Time::Local> and L<Date::Parse> for conversion functions.
2964 sub total_owed_date {
2968 my $custnum = $self->custnum;
2970 my $owed_sql = FS::cust_bill->owed_sql;
2973 SELECT SUM($owed_sql) FROM cust_bill
2974 WHERE custnum = $custnum
2978 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2982 =item total_owed_pkgnum PKGNUM
2984 Returns the total owed on all invoices for this customer's specific package
2985 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2989 sub total_owed_pkgnum {
2990 my( $self, $pkgnum ) = @_;
2991 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2994 =item total_owed_date_pkgnum TIME PKGNUM
2996 Returns the total owed for this customer's specific package when using
2997 experimental package balances on all invoices with date earlier than
2998 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2999 see L<Time::Local> and L<Date::Parse> for conversion functions.
3003 sub total_owed_date_pkgnum {
3004 my( $self, $time, $pkgnum ) = @_;
3007 foreach my $cust_bill (
3008 grep { $_->_date <= $time }
3009 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3011 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3013 sprintf( "%.2f", $total_bill );
3019 Returns the total amount of all payments.
3026 $total += $_->paid foreach $self->cust_pay;
3027 sprintf( "%.2f", $total );
3030 =item total_unapplied_credits
3032 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3033 customer. See L<FS::cust_credit/credited>.
3035 =item total_credited
3037 Old name for total_unapplied_credits. Don't use.
3041 sub total_credited {
3042 #carp "total_credited deprecated, use total_unapplied_credits";
3043 shift->total_unapplied_credits(@_);
3046 sub total_unapplied_credits {
3049 my $custnum = $self->custnum;
3051 my $unapplied_sql = FS::cust_credit->unapplied_sql;
3054 SELECT SUM($unapplied_sql) FROM cust_credit
3055 WHERE custnum = $custnum
3058 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
3062 =item total_unapplied_credits_pkgnum PKGNUM
3064 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3065 customer. See L<FS::cust_credit/credited>.
3069 sub total_unapplied_credits_pkgnum {
3070 my( $self, $pkgnum ) = @_;
3071 my $total_credit = 0;
3072 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3073 sprintf( "%.2f", $total_credit );
3077 =item total_unapplied_payments
3079 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3080 See L<FS::cust_pay/unapplied>.
3084 sub total_unapplied_payments {
3087 my $custnum = $self->custnum;
3089 my $unapplied_sql = FS::cust_pay->unapplied_sql;
3092 SELECT SUM($unapplied_sql) FROM cust_pay
3093 WHERE custnum = $custnum
3096 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
3100 =item total_unapplied_payments_pkgnum PKGNUM
3102 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3103 specific package when using experimental package balances. See
3104 L<FS::cust_pay/unapplied>.
3108 sub total_unapplied_payments_pkgnum {
3109 my( $self, $pkgnum ) = @_;
3110 my $total_unapplied = 0;
3111 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3112 sprintf( "%.2f", $total_unapplied );
3116 =item total_unapplied_refunds
3118 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3119 customer. See L<FS::cust_refund/unapplied>.
3123 sub total_unapplied_refunds {
3125 my $custnum = $self->custnum;
3127 my $unapplied_sql = FS::cust_refund->unapplied_sql;
3130 SELECT SUM($unapplied_sql) FROM cust_refund
3131 WHERE custnum = $custnum
3134 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
3140 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3141 total_unapplied_credits minus total_unapplied_payments).
3147 $self->balance_date_range;
3150 =item balance_date TIME
3152 Returns the balance for this customer, only considering invoices with date
3153 earlier than TIME (total_owed_date minus total_credited minus
3154 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3155 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3162 $self->balance_date_range(shift);
3165 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3167 Returns the balance for this customer, optionally considering invoices with
3168 date earlier than START_TIME, and not later than END_TIME
3169 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3171 Times are specified as SQL fragments or numeric
3172 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3173 L<Date::Parse> for conversion functions. The empty string can be passed
3174 to disable that time constraint completely.
3176 Accepts the same options as L</balance_date_sql>:
3180 =item unapplied_date
3182 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)
3186 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
3187 time will be ignored. Note that START_TIME and END_TIME only limit the date
3188 range for invoices and I<unapplied> payments, credits, and refunds.
3194 sub balance_date_range {
3196 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3197 ') FROM cust_main WHERE custnum='. $self->custnum;
3198 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
3201 =item balance_pkgnum PKGNUM
3203 Returns the balance for this customer's specific package when using
3204 experimental package balances (total_owed plus total_unrefunded, minus
3205 total_unapplied_credits minus total_unapplied_payments)
3209 sub balance_pkgnum {
3210 my( $self, $pkgnum ) = @_;
3213 $self->total_owed_pkgnum($pkgnum)
3214 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3215 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
3216 - $self->total_unapplied_credits_pkgnum($pkgnum)
3217 - $self->total_unapplied_payments_pkgnum($pkgnum)
3221 =item in_transit_payments
3223 Returns the total of requests for payments for this customer pending in
3224 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3228 sub in_transit_payments {
3230 my $in_transit_payments = 0;
3231 foreach my $pay_batch ( qsearch('pay_batch', {
3234 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3235 'batchnum' => $pay_batch->batchnum,
3236 'custnum' => $self->custnum,
3239 $in_transit_payments += $cust_pay_batch->amount;
3242 sprintf( "%.2f", $in_transit_payments );
3247 Returns a hash of useful information for making a payment.
3257 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3258 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3259 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3263 For credit card transactions:
3275 For electronic check transactions:
3290 $return{balance} = $self->balance;
3292 $return{payname} = $self->payname
3293 || ( $self->first. ' '. $self->get('last') );
3295 $return{$_} = $self->bill_location->$_
3296 for qw(address1 address2 city state zip);
3298 $return{payby} = $self->payby;
3299 $return{stateid_state} = $self->stateid_state;
3301 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3302 $return{card_type} = cardtype($self->payinfo);
3303 $return{payinfo} = $self->paymask;
3305 @return{'month', 'year'} = $self->paydate_monthyear;
3309 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3310 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3311 $return{payinfo1} = $payinfo1;
3312 $return{payinfo2} = $payinfo2;
3313 $return{paytype} = $self->paytype;
3314 $return{paystate} = $self->paystate;
3318 #doubleclick protection
3320 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3326 =item paydate_monthyear
3328 Returns a two-element list consisting of the month and year of this customer's
3329 paydate (credit card expiration date for CARD customers)
3333 sub paydate_monthyear {
3335 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3337 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3346 Returns the exact time in seconds corresponding to the payment method
3347 expiration date. For CARD/DCRD customers this is the end of the month;
3348 for others (COMP is the only other payby that uses paydate) it's the start.
3349 Returns 0 if the paydate is empty or set to the far future.
3355 my ($month, $year) = $self->paydate_monthyear;
3356 return 0 if !$year or $year >= 2037;
3357 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3359 if ( $month == 13 ) {
3363 return timelocal(0,0,0,1,$month-1,$year) - 1;
3366 return timelocal(0,0,0,1,$month-1,$year);
3370 =item paydate_epoch_sql
3372 Class method. Returns an SQL expression to obtain the payment expiration date
3373 as a number of seconds.
3377 # Special expiration date behavior for non-CARD/DCRD customers has been
3378 # carefully preserved. Do we really use that?
3379 sub paydate_epoch_sql {
3381 my $table = shift || 'cust_main';
3382 my ($case1, $case2);
3383 if ( driver_name eq 'Pg' ) {
3384 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3385 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3387 elsif ( lc(driver_name) eq 'mysql' ) {
3388 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3389 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3392 return "CASE WHEN $table.payby IN('CARD','DCRD')
3398 =item tax_exemption TAXNAME
3403 my( $self, $taxname ) = @_;
3405 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3406 'taxname' => $taxname,
3411 =item cust_main_exemption
3415 sub cust_main_exemption {
3417 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3420 =item invoicing_list [ ARRAYREF ]
3422 If an arguement is given, sets these email addresses as invoice recipients
3423 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3424 (except as warnings), so use check_invoicing_list first.
3426 Returns a list of email addresses (with svcnum entries expanded).
3428 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3429 check it without disturbing anything by passing nothing.
3431 This interface may change in the future.
3435 sub invoicing_list {
3436 my( $self, $arrayref ) = @_;
3439 my @cust_main_invoice;
3440 if ( $self->custnum ) {
3441 @cust_main_invoice =
3442 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3444 @cust_main_invoice = ();
3446 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3447 #warn $cust_main_invoice->destnum;
3448 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3449 #warn $cust_main_invoice->destnum;
3450 my $error = $cust_main_invoice->delete;
3451 warn $error if $error;
3454 if ( $self->custnum ) {
3455 @cust_main_invoice =
3456 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3458 @cust_main_invoice = ();
3460 my %seen = map { $_->address => 1 } @cust_main_invoice;
3461 foreach my $address ( @{$arrayref} ) {
3462 next if exists $seen{$address} && $seen{$address};
3463 $seen{$address} = 1;
3464 my $cust_main_invoice = new FS::cust_main_invoice ( {
3465 'custnum' => $self->custnum,
3468 my $error = $cust_main_invoice->insert;
3469 warn $error if $error;
3473 if ( $self->custnum ) {
3475 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3482 =item check_invoicing_list ARRAYREF
3484 Checks these arguements as valid input for the invoicing_list method. If there
3485 is an error, returns the error, otherwise returns false.
3489 sub check_invoicing_list {
3490 my( $self, $arrayref ) = @_;
3492 foreach my $address ( @$arrayref ) {
3494 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3495 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3498 my $cust_main_invoice = new FS::cust_main_invoice ( {
3499 'custnum' => $self->custnum,
3502 my $error = $self->custnum
3503 ? $cust_main_invoice->check
3504 : $cust_main_invoice->checkdest
3506 return $error if $error;
3510 return "Email address required"
3511 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3512 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3517 =item set_default_invoicing_list
3519 Sets the invoicing list to all accounts associated with this customer,
3520 overwriting any previous invoicing list.
3524 sub set_default_invoicing_list {
3526 $self->invoicing_list($self->all_emails);
3531 Returns the email addresses of all accounts provisioned for this customer.
3538 foreach my $cust_pkg ( $self->all_pkgs ) {
3539 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3541 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3542 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3544 $list{$_}=1 foreach map { $_->email } @svc_acct;
3549 =item invoicing_list_addpost
3551 Adds postal invoicing to this customer. If this customer is already configured
3552 to receive postal invoices, does nothing.
3556 sub invoicing_list_addpost {
3558 return if grep { $_ eq 'POST' } $self->invoicing_list;
3559 my @invoicing_list = $self->invoicing_list;
3560 push @invoicing_list, 'POST';
3561 $self->invoicing_list(\@invoicing_list);
3564 =item invoicing_list_emailonly
3566 Returns the list of email invoice recipients (invoicing_list without non-email
3567 destinations such as POST and FAX).
3571 sub invoicing_list_emailonly {
3573 warn "$me invoicing_list_emailonly called"
3575 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3578 =item invoicing_list_emailonly_scalar
3580 Returns the list of email invoice recipients (invoicing_list without non-email
3581 destinations such as POST and FAX) as a comma-separated scalar.
3585 sub invoicing_list_emailonly_scalar {
3587 warn "$me invoicing_list_emailonly_scalar called"
3589 join(', ', $self->invoicing_list_emailonly);
3592 =item contact_list [ CLASSNUM, ... ]
3594 Returns a list of contacts (L<FS::contact> objects) for the customer. If
3595 a list of contact classnums is given, returns only contacts in those
3596 classes. If '0' is given, also returns contacts with no class.
3598 If no arguments are given, returns all contacts for the customer.
3606 select => 'contact.*',
3607 extra_sql => ' WHERE contact.custnum = '.$self->custnum,
3614 push @orwhere, 'contact.classnum is null';
3615 } elsif ( /^\d+$/ ) {
3616 push @classnums, $_;
3618 die "bad classnum argument '$_'";
3623 push @orwhere, 'contact.classnum IN ('.join(',', @classnums).')';
3626 $search->{extra_sql} .= ' AND (' .
3627 join(' OR ', map "( $_ )", @orwhere) .
3634 =item contact_list_email [ CLASSNUM, ... ]
3636 Same as L</contact_list>, but returns email destinations instead of contact
3637 objects. Also accepts 'invoice' as an argument, in which case this will also
3638 return the invoice email address if any.
3642 sub contact_list_email {
3650 push @classnums, $_;
3654 # if the only argument passed was 'invoice' then no classnums are
3655 # intended, so skip this.
3657 my @contacts = $self->contact_list(@classnums);
3658 foreach my $contact (@contacts) {
3659 foreach my $contact_email ($contact->contact_email) {
3660 # unlike on 4.x, we have a separate list of invoice email
3662 # make sure they're not redundant with contact emails
3663 $emails{ $contact_email->emailaddress } =
3664 Email::Address->new( $contact->firstlast,
3665 $contact_email->emailaddress
3670 if ( $and_invoice ) {
3671 foreach my $email ($self->invoicing_list_emailonly) {
3672 $emails{ $email } ||=
3673 Email::Address->new( $self->name_short, $email )->format;
3679 =item referral_custnum_cust_main
3681 Returns the customer who referred this customer (or the empty string, if
3682 this customer was not referred).
3684 Note the difference with referral_cust_main method: This method,
3685 referral_custnum_cust_main returns the single customer (if any) who referred
3686 this customer, while referral_cust_main returns an array of customers referred
3691 sub referral_custnum_cust_main {
3693 return '' unless $self->referral_custnum;
3694 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3697 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3699 Returns an array of customers referred by this customer (referral_custnum set
3700 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3701 customers referred by customers referred by this customer and so on, inclusive.
3702 The default behavior is DEPTH 1 (no recursion).
3704 Note the difference with referral_custnum_cust_main method: This method,
3705 referral_cust_main, returns an array of customers referred BY this customer,
3706 while referral_custnum_cust_main returns the single customer (if any) who
3707 referred this customer.
3711 sub referral_cust_main {
3713 my $depth = @_ ? shift : 1;
3714 my $exclude = @_ ? shift : {};
3717 map { $exclude->{$_->custnum}++; $_; }
3718 grep { ! $exclude->{ $_->custnum } }
3719 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3723 map { $_->referral_cust_main($depth-1, $exclude) }
3730 =item referral_cust_main_ncancelled
3732 Same as referral_cust_main, except only returns customers with uncancelled
3737 sub referral_cust_main_ncancelled {
3739 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3742 =item referral_cust_pkg [ DEPTH ]
3744 Like referral_cust_main, except returns a flat list of all unsuspended (and
3745 uncancelled) packages for each customer. The number of items in this list may
3746 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3750 sub referral_cust_pkg {
3752 my $depth = @_ ? shift : 1;
3754 map { $_->unsuspended_pkgs }
3755 grep { $_->unsuspended_pkgs }
3756 $self->referral_cust_main($depth);
3759 =item referring_cust_main
3761 Returns the single cust_main record for the customer who referred this customer
3762 (referral_custnum), or false.
3766 sub referring_cust_main {
3768 return '' unless $self->referral_custnum;
3769 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3772 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3774 Applies a credit to this customer. If there is an error, returns the error,
3775 otherwise returns false.
3777 REASON can be a text string, an FS::reason object, or a scalar reference to
3778 a reasonnum. If a text string, it will be automatically inserted as a new
3779 reason, and a 'reason_type' option must be passed to indicate the
3780 FS::reason_type for the new reason.
3782 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3783 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3784 I<commission_pkgnum>.
3786 Any other options are passed to FS::cust_credit::insert.
3791 my( $self, $amount, $reason, %options ) = @_;
3793 my $cust_credit = new FS::cust_credit {
3794 'custnum' => $self->custnum,
3795 'amount' => $amount,
3798 if ( ref($reason) ) {
3800 if ( ref($reason) eq 'SCALAR' ) {
3801 $cust_credit->reasonnum( $$reason );
3803 $cust_credit->reasonnum( $reason->reasonnum );
3807 $cust_credit->set('reason', $reason)
3810 $cust_credit->$_( delete $options{$_} )
3811 foreach grep exists($options{$_}),
3812 qw( addlinfo eventnum ),
3813 map "commission_$_", qw( agentnum salesnum pkgnum );
3815 $cust_credit->insert(%options);
3819 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3821 Creates a one-time charge for this customer. If there is an error, returns
3822 the error, otherwise returns false.
3824 New-style, with a hashref of options:
3826 my $error = $cust_main->charge(
3830 'start_date' => str2time('7/4/2009'),
3831 'pkg' => 'Description',
3832 'comment' => 'Comment',
3833 'additional' => [], #extra invoice detail
3834 'classnum' => 1, #pkg_class
3836 'setuptax' => '', # or 'Y' for tax exempt
3838 'locationnum'=> 1234, # optional
3841 'taxclass' => 'Tax class',
3844 'taxproduct' => 2, #part_pkg_taxproduct
3845 'override' => {}, #XXX describe
3847 #will be filled in with the new object
3848 'cust_pkg_ref' => \$cust_pkg,
3850 #generate an invoice immediately
3852 'invoice_terms' => '', #with these terms
3858 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3862 #super false laziness w/quotation::charge
3865 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3866 my ( $pkg, $comment, $additional );
3867 my ( $setuptax, $taxclass ); #internal taxes
3868 my ( $taxproduct, $override ); #vendor (CCH) taxes
3870 my $separate_bill = '';
3871 my $cust_pkg_ref = '';
3872 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3874 if ( ref( $_[0] ) ) {
3875 $amount = $_[0]->{amount};
3876 $setup_cost = $_[0]->{setup_cost};
3877 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3878 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3879 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3880 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3881 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3882 : '$'. sprintf("%.2f",$amount);
3883 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3884 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3885 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3886 $additional = $_[0]->{additional} || [];
3887 $taxproduct = $_[0]->{taxproductnum};
3888 $override = { '' => $_[0]->{tax_override} };
3889 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3890 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3891 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3892 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3893 $separate_bill = $_[0]->{separate_bill} || '';
3899 $pkg = @_ ? shift : 'One-time charge';
3900 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3902 $taxclass = @_ ? shift : '';
3906 local $SIG{HUP} = 'IGNORE';
3907 local $SIG{INT} = 'IGNORE';
3908 local $SIG{QUIT} = 'IGNORE';
3909 local $SIG{TERM} = 'IGNORE';
3910 local $SIG{TSTP} = 'IGNORE';
3911 local $SIG{PIPE} = 'IGNORE';
3913 my $oldAutoCommit = $FS::UID::AutoCommit;
3914 local $FS::UID::AutoCommit = 0;
3917 my $part_pkg = new FS::part_pkg ( {
3919 'comment' => $comment,
3923 'classnum' => ( $classnum ? $classnum : '' ),
3924 'setuptax' => $setuptax,
3925 'taxclass' => $taxclass,
3926 'taxproductnum' => $taxproduct,
3927 'setup_cost' => $setup_cost,
3930 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3931 ( 0 .. @$additional - 1 )
3933 'additional_count' => scalar(@$additional),
3934 'setup_fee' => $amount,
3937 my $error = $part_pkg->insert( options => \%options,
3938 tax_overrides => $override,
3941 $dbh->rollback if $oldAutoCommit;
3945 my $pkgpart = $part_pkg->pkgpart;
3946 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3947 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3948 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3949 $error = $type_pkgs->insert;
3951 $dbh->rollback if $oldAutoCommit;
3956 my $cust_pkg = new FS::cust_pkg ( {
3957 'custnum' => $self->custnum,
3958 'pkgpart' => $pkgpart,
3959 'quantity' => $quantity,
3960 'start_date' => $start_date,
3961 'no_auto' => $no_auto,
3962 'separate_bill' => $separate_bill,
3963 'locationnum'=> $locationnum,
3966 $error = $cust_pkg->insert;
3968 $dbh->rollback if $oldAutoCommit;
3970 } elsif ( $cust_pkg_ref ) {
3971 ${$cust_pkg_ref} = $cust_pkg;
3975 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3976 'pkg_list' => [ $cust_pkg ],
3979 $dbh->rollback if $oldAutoCommit;
3984 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3989 #=item charge_postal_fee
3991 #Applies a one time charge this customer. If there is an error,
3992 #returns the error, returns the cust_pkg charge object or false
3993 #if there was no charge.
3997 # This should be a customer event. For that to work requires that bill
3998 # also be a customer event.
4000 sub charge_postal_fee {
4003 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
4004 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4006 my $cust_pkg = new FS::cust_pkg ( {
4007 'custnum' => $self->custnum,
4008 'pkgpart' => $pkgpart,
4012 my $error = $cust_pkg->insert;
4013 $error ? $error : $cust_pkg;
4016 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4018 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4020 Optionally, a list or hashref of additional arguments to the qsearch call can
4027 my $opt = ref($_[0]) ? shift : { @_ };
4029 #return $self->num_cust_bill unless wantarray || keys %$opt;
4031 $opt->{'table'} = 'cust_bill';
4032 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4033 $opt->{'hashref'}{'custnum'} = $self->custnum;
4034 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
4036 map { $_ } #behavior of sort undefined in scalar context
4037 sort { $a->_date <=> $b->_date }
4041 =item open_cust_bill
4043 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4048 sub open_cust_bill {
4052 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4058 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4060 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
4064 sub legacy_cust_bill {
4067 #return $self->num_legacy_cust_bill unless wantarray;
4069 map { $_ } #behavior of sort undefined in scalar context
4070 sort { $a->_date <=> $b->_date }
4071 qsearch({ 'table' => 'legacy_cust_bill',
4072 'hashref' => { 'custnum' => $self->custnum, },
4073 'order_by' => 'ORDER BY _date ASC',
4077 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4079 Returns all the statements (see L<FS::cust_statement>) for this customer.
4081 Optionally, a list or hashref of additional arguments to the qsearch call can
4086 =item cust_bill_void
4088 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
4092 sub cust_bill_void {
4095 map { $_ } #return $self->num_cust_bill_void unless wantarray;
4096 sort { $a->_date <=> $b->_date }
4097 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
4100 sub cust_statement {
4102 my $opt = ref($_[0]) ? shift : { @_ };
4104 #return $self->num_cust_statement unless wantarray || keys %$opt;
4106 $opt->{'table'} = 'cust_statement';
4107 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4108 $opt->{'hashref'}{'custnum'} = $self->custnum;
4109 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
4111 map { $_ } #behavior of sort undefined in scalar context
4112 sort { $a->_date <=> $b->_date }
4116 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
4118 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
4120 Optionally, a list or hashref of additional arguments to the qsearch call can
4121 be passed following the SVCDB.
4128 if ( ! $svcdb =~ /^svc_\w+$/ ) {
4129 warn "$me svc_x requires a svcdb";
4132 my $opt = ref($_[0]) ? shift : { @_ };
4134 $opt->{'table'} = $svcdb;
4135 $opt->{'addl_from'} =
4136 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
4137 ($opt->{'addl_from'} || '');
4139 my $custnum = $self->custnum;
4140 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
4141 my $where = "cust_pkg.custnum = $custnum";
4143 my $extra_sql = $opt->{'extra_sql'} || '';
4144 if ( keys %{ $opt->{'hashref'} } ) {
4145 $extra_sql = " AND $where $extra_sql";
4148 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
4149 $extra_sql = "WHERE $where AND $1";
4152 $extra_sql = "WHERE $where $extra_sql";
4155 $opt->{'extra_sql'} = $extra_sql;
4160 # required for use as an eventtable;
4163 $self->svc_x('svc_acct', @_);
4168 Returns all the credits (see L<FS::cust_credit>) for this customer.
4174 map { $_ } #return $self->num_cust_credit unless wantarray;
4175 sort { $a->_date <=> $b->_date }
4176 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4179 =item cust_credit_pkgnum
4181 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4182 package when using experimental package balances.
4186 sub cust_credit_pkgnum {
4187 my( $self, $pkgnum ) = @_;
4188 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4189 sort { $a->_date <=> $b->_date }
4190 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4191 'pkgnum' => $pkgnum,
4196 =item cust_credit_void
4198 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
4202 sub cust_credit_void {
4205 sort { $a->_date <=> $b->_date }
4206 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
4211 Returns all the payments (see L<FS::cust_pay>) for this customer.
4217 my $opt = ref($_[0]) ? shift : { @_ };
4219 return $self->num_cust_pay unless wantarray || keys %$opt;
4221 $opt->{'table'} = 'cust_pay';
4222 $opt->{'hashref'}{'custnum'} = $self->custnum;
4224 map { $_ } #behavior of sort undefined in scalar context
4225 sort { $a->_date <=> $b->_date }
4232 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
4233 called automatically when the cust_pay method is used in a scalar context.
4239 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4240 my $sth = dbh->prepare($sql) or die dbh->errstr;
4241 $sth->execute($self->custnum) or die $sth->errstr;
4242 $sth->fetchrow_arrayref->[0];
4245 =item unapplied_cust_pay
4247 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
4251 sub unapplied_cust_pay {
4255 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
4261 =item cust_pay_pkgnum
4263 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4264 package when using experimental package balances.
4268 sub cust_pay_pkgnum {
4269 my( $self, $pkgnum ) = @_;
4270 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4271 sort { $a->_date <=> $b->_date }
4272 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4273 'pkgnum' => $pkgnum,
4280 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4286 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4287 sort { $a->_date <=> $b->_date }
4288 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4291 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4293 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
4295 Optionally, a list or hashref of additional arguments to the qsearch call can
4300 sub cust_pay_batch {
4302 my $opt = ref($_[0]) ? shift : { @_ };
4304 #return $self->num_cust_statement unless wantarray || keys %$opt;
4306 $opt->{'table'} = 'cust_pay_batch';
4307 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4308 $opt->{'hashref'}{'custnum'} = $self->custnum;
4309 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
4311 map { $_ } #behavior of sort undefined in scalar context
4312 sort { $a->paybatchnum <=> $b->paybatchnum }
4316 =item cust_pay_pending
4318 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4319 (without status "done").
4323 sub cust_pay_pending {
4325 return $self->num_cust_pay_pending unless wantarray;
4326 sort { $a->_date <=> $b->_date }
4327 qsearch( 'cust_pay_pending', {
4328 'custnum' => $self->custnum,
4329 'status' => { op=>'!=', value=>'done' },
4334 =item cust_pay_pending_attempt
4336 Returns all payment attempts / declined payments for this customer, as pending
4337 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4338 a corresponding payment (see L<FS::cust_pay>).
4342 sub cust_pay_pending_attempt {
4344 return $self->num_cust_pay_pending_attempt unless wantarray;
4345 sort { $a->_date <=> $b->_date }
4346 qsearch( 'cust_pay_pending', {
4347 'custnum' => $self->custnum,
4354 =item num_cust_pay_pending
4356 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4357 customer (without status "done"). Also called automatically when the
4358 cust_pay_pending method is used in a scalar context.
4362 sub num_cust_pay_pending {
4365 " SELECT COUNT(*) FROM cust_pay_pending ".
4366 " WHERE custnum = ? AND status != 'done' ",
4371 =item num_cust_pay_pending_attempt
4373 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4374 customer, with status "done" but without a corresp. Also called automatically when the
4375 cust_pay_pending method is used in a scalar context.
4379 sub num_cust_pay_pending_attempt {
4382 " SELECT COUNT(*) FROM cust_pay_pending ".
4383 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4390 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4396 map { $_ } #return $self->num_cust_refund unless wantarray;
4397 sort { $a->_date <=> $b->_date }
4398 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4401 =item display_custnum
4403 Returns the displayed customer number for this customer: agent_custid if
4404 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4408 sub display_custnum {
4411 return $self->agent_custid
4412 if $default_agent_custid && $self->agent_custid;
4414 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4418 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
4419 } elsif ( $custnum_display_length ) {
4420 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
4422 return $self->custnum;
4428 Returns a name string for this customer, either "Company (Last, First)" or
4435 my $name = $self->contact;
4436 $name = $self->company. " ($name)" if $self->company;
4440 =item service_contact
4442 Returns the L<FS::contact> object for this customer that has the 'Service'
4443 contact class, or undef if there is no such contact. Deprecated; don't use
4448 sub service_contact {
4450 if ( !exists($self->{service_contact}) ) {
4451 my $classnum = $self->scalar_sql(
4452 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4453 ) || 0; #if it's zero, qsearchs will return nothing
4454 $self->{service_contact} = qsearchs('contact', {
4455 'classnum' => $classnum, 'custnum' => $self->custnum
4458 $self->{service_contact};
4463 Returns a name string for this (service/shipping) contact, either
4464 "Company (Last, First)" or "Last, First".
4471 my $name = $self->ship_contact;
4472 $name = $self->company. " ($name)" if $self->company;
4478 Returns a name string for this customer, either "Company" or "First Last".
4484 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4487 =item ship_name_short
4489 Returns a name string for this (service/shipping) contact, either "Company"
4494 sub ship_name_short {
4496 $self->service_contact
4497 ? $self->ship_contact_firstlast
4503 Returns this customer's full (billing) contact name only, "Last, First"
4509 $self->get('last'). ', '. $self->first;
4514 Returns this customer's full (shipping) contact name only, "Last, First"
4520 my $contact = $self->service_contact || $self;
4521 $contact->get('last') . ', ' . $contact->get('first');
4524 =item contact_firstlast
4526 Returns this customers full (billing) contact name only, "First Last".
4530 sub contact_firstlast {
4532 $self->first. ' '. $self->get('last');
4535 =item ship_contact_firstlast
4537 Returns this customer's full (shipping) contact name only, "First Last".
4541 sub ship_contact_firstlast {
4543 my $contact = $self->service_contact || $self;
4544 $contact->get('first') . ' '. $contact->get('last');
4547 sub bill_country_full {
4549 $self->bill_location->country_full;
4552 sub ship_country_full {
4554 $self->ship_location->country_full;
4557 =item county_state_county [ PREFIX ]
4559 Returns a string consisting of just the county, state and country.
4563 sub county_state_country {
4566 if ( @_ && $_[0] && $self->has_ship_address ) {
4567 $locationnum = $self->ship_locationnum;
4569 $locationnum = $self->bill_locationnum;
4571 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4572 $cust_location->county_state_country;
4575 =item geocode DATA_VENDOR
4577 Returns a value for the customer location as encoded by DATA_VENDOR.
4578 Currently this only makes sense for "CCH" as DATA_VENDOR.
4586 Returns a status string for this customer, currently:
4590 =item prospect - No packages have ever been ordered
4592 =item ordered - Recurring packages all are new (not yet billed).
4594 =item active - One or more recurring packages is active
4596 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4598 =item suspended - All non-cancelled recurring packages are suspended
4600 =item cancelled - All recurring packages are cancelled
4604 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4605 cust_main-status_module configuration option.
4609 sub status { shift->cust_status(@_); }
4613 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4614 for my $status ( FS::cust_main->statuses() ) {
4615 my $method = $status.'_sql';
4616 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4617 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4618 $sth->execute( ($self->custnum) x $numnum )
4619 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4620 if ( $sth->fetchrow_arrayref->[0] ) {
4621 $self->hashref->{cust_status} = $status;
4627 =item is_status_delay_cancel
4629 Returns true if customer status is 'suspended'
4630 and all suspended cust_pkg return true for
4631 cust_pkg->is_status_delay_cancel.
4633 This is not a real status, this only meant for hacking display
4634 values, because otherwise treating the customer as suspended is
4635 really the whole point of the delay_cancel option.
4639 sub is_status_delay_cancel {
4641 return 0 unless $self->status eq 'suspended';
4642 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4643 return 0 unless $cust_pkg->is_status_delay_cancel;
4648 =item ucfirst_cust_status
4650 =item ucfirst_status
4652 Returns the status with the first character capitalized.
4656 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4658 sub ucfirst_cust_status {
4660 ucfirst($self->cust_status);
4665 Returns a hex triplet color string for this customer's status.
4669 sub statuscolor { shift->cust_statuscolor(@_); }
4671 sub cust_statuscolor {
4673 __PACKAGE__->statuscolors->{$self->cust_status};
4676 =item tickets [ STATUS ]
4678 Returns an array of hashes representing the customer's RT tickets.
4680 An optional status (or arrayref or hashref of statuses) may be specified.
4686 my $status = ( @_ && $_[0] ) ? shift : '';
4688 my $num = $conf->config('cust_main-max_tickets') || 10;
4691 if ( $conf->config('ticket_system') ) {
4692 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4694 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4703 foreach my $priority (
4704 $conf->config('ticket_system-custom_priority_field-values'), ''
4706 last if scalar(@tickets) >= $num;
4708 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4709 $num - scalar(@tickets),
4720 =item appointments [ STATUS ]
4722 Returns an array of hashes representing the customer's RT tickets which
4729 my $status = ( @_ && $_[0] ) ? shift : '';
4731 return () unless $conf->config('ticket_system');
4733 my $queueid = $conf->config('ticket_system-appointment-queueid');
4735 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4744 # Return services representing svc_accts in customer support packages
4745 sub support_services {
4747 my %packages = map { $_ => 1 } $conf->config('support_packages');
4749 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4750 grep { $_->part_svc->svcdb eq 'svc_acct' }
4751 map { $_->cust_svc }
4752 grep { exists $packages{ $_->pkgpart } }
4753 $self->ncancelled_pkgs;
4757 # Return a list of latitude/longitude for one of the services (if any)
4758 sub service_coordinates {
4762 grep { $_->latitude && $_->longitude }
4764 map { $_->cust_svc }
4765 $self->ncancelled_pkgs;
4767 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4772 Returns a masked version of the named field
4777 my ($self,$field) = @_;
4781 'x'x(length($self->getfield($field))-4).
4782 substr($self->getfield($field), (length($self->getfield($field))-4));
4786 =item payment_history
4788 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4789 cust_credit and cust_refund objects. Each hashref has the following fields:
4791 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4793 I<date> - value of _date field, unix timestamp
4795 I<date_pretty> - user-friendly date
4797 I<description> - user-friendly description of item
4799 I<amount> - impact of item on user's balance
4800 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4801 Not to be confused with the native 'amount' field in cust_credit, see below.
4803 I<amount_pretty> - includes money char
4805 I<balance> - customer balance, chronologically as of this item
4807 I<balance_pretty> - includes money char
4809 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4811 I<paid> - amount paid for cust_pay records, undef for other types
4813 I<credit> - amount credited for cust_credit records, undef for other types.
4814 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4816 I<refund> - amount refunded for cust_refund records, undef for other types
4818 The four table-specific keys always have positive values, whether they reflect charges or payments.
4820 The following options may be passed to this method:
4822 I<line_items> - if true, returns charges ('Line item') rather than invoices
4824 I<start_date> - unix timestamp, only include records on or after.
4825 If specified, an item of type 'Previous' will also be included.
4826 It does not have table-specific fields.
4828 I<end_date> - unix timestamp, only include records before
4830 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4832 I<conf> - optional already-loaded FS::Conf object.
4836 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4837 # and also for sending customer statements, which should both be kept customer-friendly.
4838 # If you add anything that shouldn't be passed on through the API or exposed
4839 # to customers, add a new option to include it, don't include it by default
4840 sub payment_history {
4842 my $opt = ref($_[0]) ? $_[0] : { @_ };
4844 my $conf = $$opt{'conf'} || new FS::Conf;
4845 my $money_char = $conf->config("money_char") || '$',
4847 #first load entire history,
4848 #need previous to calculate previous balance
4849 #loading after end_date shouldn't hurt too much?
4851 if ( $$opt{'line_items'} ) {
4853 foreach my $cust_bill ( $self->cust_bill ) {
4856 'type' => 'Line item',
4857 'description' => $_->desc( $self->locale ).
4858 ( $_->sdate && $_->edate
4859 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4860 ' To '. time2str('%d-%b-%Y', $_->edate)
4863 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4864 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4865 'date' => $cust_bill->_date,
4866 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4868 foreach $cust_bill->cust_bill_pkg;
4875 'type' => 'Invoice',
4876 'description' => 'Invoice #'. $_->display_invnum,
4877 'amount' => sprintf('%.2f', $_->charged ),
4878 'charged' => sprintf('%.2f', $_->charged ),
4879 'date' => $_->_date,
4880 'date_pretty' => $self->time2str_local('short', $_->_date ),
4882 foreach $self->cust_bill;
4887 'type' => 'Payment',
4888 'description' => 'Payment', #XXX type
4889 'amount' => sprintf('%.2f', 0 - $_->paid ),
4890 'paid' => sprintf('%.2f', $_->paid ),
4891 'date' => $_->_date,
4892 'date_pretty' => $self->time2str_local('short', $_->_date ),
4894 foreach $self->cust_pay;
4898 'description' => 'Credit', #more info?
4899 'amount' => sprintf('%.2f', 0 -$_->amount ),
4900 'credit' => sprintf('%.2f', $_->amount ),
4901 'date' => $_->_date,
4902 'date_pretty' => $self->time2str_local('short', $_->_date ),
4904 foreach $self->cust_credit;
4908 'description' => 'Refund', #more info? type, like payment?
4909 'amount' => $_->refund,
4910 'refund' => $_->refund,
4911 'date' => $_->_date,
4912 'date_pretty' => $self->time2str_local('short', $_->_date ),
4914 foreach $self->cust_refund;
4916 #put it all in chronological order
4917 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4919 #calculate balance, filter items outside date range
4923 foreach my $item (@history) {
4924 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4925 $balance += $$item{'amount'};
4926 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4927 $previous += $$item{'amount'};
4930 $$item{'balance'} = sprintf("%.2f",$balance);
4931 foreach my $key ( qw(amount balance) ) {
4932 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4937 # start with previous balance, if there was one
4940 'type' => 'Previous',
4941 'description' => 'Previous balance',
4942 'amount' => sprintf("%.2f",$previous),
4943 'balance' => sprintf("%.2f",$previous),
4944 'date' => $$opt{'start_date'},
4945 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4947 #false laziness with above
4948 foreach my $key ( qw(amount balance) ) {
4949 $$item{$key.'_pretty'} = $$item{$key};
4950 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4952 unshift(@out,$item);
4955 @out = reverse @history if $$opt{'reverse_sort'};
4962 =head1 CLASS METHODS
4968 Class method that returns the list of possible status strings for customers
4969 (see L<the status method|/status>). For example:
4971 @statuses = FS::cust_main->statuses();
4977 keys %{ $self->statuscolors };
4980 =item cust_status_sql
4982 Returns an SQL fragment to determine the status of a cust_main record, as a
4987 sub cust_status_sql {
4989 for my $status ( FS::cust_main->statuses() ) {
4990 my $method = $status.'_sql';
4991 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
5000 Returns an SQL expression identifying prospective cust_main records (customers
5001 with no packages ever ordered)
5005 use vars qw($select_count_pkgs);
5006 $select_count_pkgs =
5007 "SELECT COUNT(*) FROM cust_pkg
5008 WHERE cust_pkg.custnum = cust_main.custnum";
5010 sub select_count_pkgs_sql {
5015 " 0 = ( $select_count_pkgs ) ";
5020 Returns an SQL expression identifying ordered cust_main records (customers with
5021 no active packages, but recurring packages not yet setup or one time charges
5027 FS::cust_main->none_active_sql.
5028 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
5033 Returns an SQL expression identifying active cust_main records (customers with
5034 active recurring packages).
5039 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5042 =item none_active_sql
5044 Returns an SQL expression identifying cust_main records with no active
5045 recurring packages. This includes customers of status prospect, ordered,
5046 inactive, and suspended.
5050 sub none_active_sql {
5051 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5056 Returns an SQL expression identifying inactive cust_main records (customers with
5057 no active recurring packages, but otherwise unsuspended/uncancelled).
5062 FS::cust_main->none_active_sql.
5063 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
5069 Returns an SQL expression identifying suspended cust_main records.
5074 sub suspended_sql { susp_sql(@_); }
5076 FS::cust_main->none_active_sql.
5077 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
5083 Returns an SQL expression identifying cancelled cust_main records.
5087 sub cancel_sql { shift->cancelled_sql(@_); }
5090 =item uncancelled_sql
5092 Returns an SQL expression identifying un-cancelled cust_main records.
5096 sub uncancelled_sql { uncancel_sql(@_); }
5099 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
5104 Returns an SQL fragment to retreive the balance.
5109 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5110 WHERE cust_bill.custnum = cust_main.custnum )
5111 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5112 WHERE cust_pay.custnum = cust_main.custnum )
5113 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5114 WHERE cust_credit.custnum = cust_main.custnum )
5115 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5116 WHERE cust_refund.custnum = cust_main.custnum )
5119 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
5121 Returns an SQL fragment to retreive the balance for this customer, optionally
5122 considering invoices with date earlier than START_TIME, and not
5123 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5124 total_unapplied_payments).
5126 Times are specified as SQL fragments or numeric
5127 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5128 L<Date::Parse> for conversion functions. The empty string can be passed
5129 to disable that time constraint completely.
5131 Available options are:
5135 =item unapplied_date
5137 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)
5142 set to true to remove all customer comparison clauses, for totals
5147 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5152 JOIN clause (typically used with the total option)
5156 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5157 time will be ignored. Note that START_TIME and END_TIME only limit the date
5158 range for invoices and I<unapplied> payments, credits, and refunds.
5164 sub balance_date_sql {
5165 my( $class, $start, $end, %opt ) = @_;
5167 my $cutoff = $opt{'cutoff'};
5169 my $owed = FS::cust_bill->owed_sql($cutoff);
5170 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5171 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5172 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5174 my $j = $opt{'join'} || '';
5176 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5177 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5178 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5179 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5181 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5182 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5183 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5184 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5189 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5191 Returns an SQL fragment to retreive the total unapplied payments for this
5192 customer, only considering payments with date earlier than START_TIME, and
5193 optionally not later than END_TIME.
5195 Times are specified as SQL fragments or numeric
5196 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5197 L<Date::Parse> for conversion functions. The empty string can be passed
5198 to disable that time constraint completely.
5200 Available options are:
5204 sub unapplied_payments_date_sql {
5205 my( $class, $start, $end, %opt ) = @_;
5207 my $cutoff = $opt{'cutoff'};
5209 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5211 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5212 'unapplied_date'=>1 );
5214 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5217 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5219 Helper method for balance_date_sql; name (and usage) subject to change
5220 (suggestions welcome).
5222 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5223 cust_refund, cust_credit or cust_pay).
5225 If TABLE is "cust_bill" or the unapplied_date option is true, only
5226 considers records with date earlier than START_TIME, and optionally not
5227 later than END_TIME .
5231 sub _money_table_where {
5232 my( $class, $table, $start, $end, %opt ) = @_;
5235 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5236 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5237 push @where, "$table._date <= $start" if defined($start) && length($start);
5238 push @where, "$table._date > $end" if defined($end) && length($end);
5240 push @where, @{$opt{'where'}} if $opt{'where'};
5241 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5247 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5248 use FS::cust_main::Search;
5251 FS::cust_main::Search->search(@_);
5260 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5262 Deprecated. Use event notification and message templates
5263 (L<FS::msg_template>) instead.
5265 Sends a templated email notification to the customer (see L<Text::Template>).
5267 OPTIONS is a hash and may include
5269 I<from> - the email sender (default is invoice_from)
5271 I<to> - comma-separated scalar or arrayref of recipients
5272 (default is invoicing_list)
5274 I<subject> - The subject line of the sent email notification
5275 (default is "Notice from company_name")
5277 I<extra_fields> - a hashref of name/value pairs which will be substituted
5280 The following variables are vavailable in the template.
5282 I<$first> - the customer first name
5283 I<$last> - the customer last name
5284 I<$company> - the customer company
5285 I<$payby> - a description of the method of payment for the customer
5286 # would be nice to use FS::payby::shortname
5287 I<$payinfo> - the account information used to collect for this customer
5288 I<$expdate> - the expiration of the customer payment in seconds from epoch
5293 my ($self, $template, %options) = @_;
5295 return unless $conf->exists($template);
5297 my $from = $conf->invoice_from_full($self->agentnum)
5298 if $conf->exists('invoice_from', $self->agentnum);
5299 $from = $options{from} if exists($options{from});
5301 my $to = join(',', $self->invoicing_list_emailonly);
5302 $to = $options{to} if exists($options{to});
5304 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5305 if $conf->exists('company_name', $self->agentnum);
5306 $subject = $options{subject} if exists($options{subject});
5308 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5309 SOURCE => [ map "$_\n",
5310 $conf->config($template)]
5312 or die "can't create new Text::Template object: Text::Template::ERROR";
5313 $notify_template->compile()
5314 or die "can't compile template: Text::Template::ERROR";
5316 $FS::notify_template::_template::company_name =
5317 $conf->config('company_name', $self->agentnum);
5318 $FS::notify_template::_template::company_address =
5319 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5321 my $paydate = $self->paydate || '2037-12-31';
5322 $FS::notify_template::_template::first = $self->first;
5323 $FS::notify_template::_template::last = $self->last;
5324 $FS::notify_template::_template::company = $self->company;
5325 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5326 my $payby = $self->payby;
5327 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5328 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5330 #credit cards expire at the end of the month/year of their exp date
5331 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5332 $FS::notify_template::_template::payby = 'credit card';
5333 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5334 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5336 }elsif ($payby eq 'COMP') {
5337 $FS::notify_template::_template::payby = 'complimentary account';
5339 $FS::notify_template::_template::payby = 'current method';
5341 $FS::notify_template::_template::expdate = $expire_time;
5343 for (keys %{$options{extra_fields}}){
5345 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5348 send_email(from => $from,
5350 subject => $subject,
5351 body => $notify_template->fill_in( PACKAGE =>
5352 'FS::notify_template::_template' ),
5357 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5359 Generates a templated notification to the customer (see L<Text::Template>).
5361 OPTIONS is a hash and may include
5363 I<extra_fields> - a hashref of name/value pairs which will be substituted
5364 into the template. These values may override values mentioned below
5365 and those from the customer record.
5367 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5369 The following variables are available in the template instead of or in addition
5370 to the fields of the customer record.
5372 I<$payby> - a description of the method of payment for the customer
5373 # would be nice to use FS::payby::shortname
5374 I<$payinfo> - the masked account information used to collect for this customer
5375 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5376 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5380 # a lot like cust_bill::print_latex
5381 sub generate_letter {
5382 my ($self, $template, %options) = @_;
5384 warn "Template $template does not exist" && return
5385 unless $conf->exists($template) || $options{'template_text'};
5387 my $template_source = $options{'template_text'}
5388 ? [ $options{'template_text'} ]
5389 : [ map "$_\n", $conf->config($template) ];
5391 my $letter_template = new Text::Template
5393 SOURCE => $template_source,
5394 DELIMITERS => [ '[@--', '--@]' ],
5396 or die "can't create new Text::Template object: Text::Template::ERROR";
5398 $letter_template->compile()
5399 or die "can't compile template: Text::Template::ERROR";
5401 my %letter_data = map { $_ => $self->$_ } $self->fields;
5402 $letter_data{payinfo} = $self->mask_payinfo;
5404 #my $paydate = $self->paydate || '2037-12-31';
5405 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5407 my $payby = $self->payby;
5408 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5409 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5411 #credit cards expire at the end of the month/year of their exp date
5412 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5413 $letter_data{payby} = 'credit card';
5414 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5415 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5417 }elsif ($payby eq 'COMP') {
5418 $letter_data{payby} = 'complimentary account';
5420 $letter_data{payby} = 'current method';
5422 $letter_data{expdate} = $expire_time;
5424 for (keys %{$options{extra_fields}}){
5425 $letter_data{$_} = $options{extra_fields}->{$_};
5428 unless(exists($letter_data{returnaddress})){
5429 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5430 $self->agent_template)
5432 if ( length($retadd) ) {
5433 $letter_data{returnaddress} = $retadd;
5434 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5435 $letter_data{returnaddress} =
5436 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5440 ( $conf->config('company_name', $self->agentnum),
5441 $conf->config('company_address', $self->agentnum),
5445 $letter_data{returnaddress} = '~';
5449 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5451 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5453 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5455 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5459 ) or die "can't open temp file: $!\n";
5460 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5461 or die "can't write temp file: $!\n";
5463 $letter_data{'logo_file'} = $lh->filename;
5465 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5469 ) or die "can't open temp file: $!\n";
5471 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5473 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5474 return ($1, $letter_data{'logo_file'});
5478 =item print_ps TEMPLATE
5480 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5486 my($file, $lfile) = $self->generate_letter(@_);
5487 my $ps = FS::Misc::generate_ps($file);
5488 unlink($file.'.tex');
5494 =item print TEMPLATE
5496 Prints the filled in template.
5498 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5502 sub queueable_print {
5505 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5506 or die "invalid customer number: " . $opt{custnum};
5508 my $error = $self->print( { 'template' => $opt{template} } );
5509 die $error if $error;
5513 my ($self, $template) = (shift, shift);
5515 [ $self->print_ps($template) ],
5516 'agentnum' => $self->agentnum,
5520 #these three subs should just go away once agent stuff is all config overrides
5522 sub agent_template {
5524 $self->_agent_plandata('agent_templatename');
5527 sub agent_invoice_from {
5529 $self->_agent_plandata('agent_invoice_from');
5532 sub _agent_plandata {
5533 my( $self, $option ) = @_;
5535 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5536 #agent-specific Conf
5538 use FS::part_event::Condition;
5540 my $agentnum = $self->agentnum;
5542 my $regexp = regexp_sql();
5544 my $part_event_option =
5546 'select' => 'part_event_option.*',
5547 'table' => 'part_event_option',
5549 LEFT JOIN part_event USING ( eventpart )
5550 LEFT JOIN part_event_option AS peo_agentnum
5551 ON ( part_event.eventpart = peo_agentnum.eventpart
5552 AND peo_agentnum.optionname = 'agentnum'
5553 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5555 LEFT JOIN part_event_condition
5556 ON ( part_event.eventpart = part_event_condition.eventpart
5557 AND part_event_condition.conditionname = 'cust_bill_age'
5559 LEFT JOIN part_event_condition_option
5560 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5561 AND part_event_condition_option.optionname = 'age'
5564 #'hashref' => { 'optionname' => $option },
5565 #'hashref' => { 'part_event_option.optionname' => $option },
5567 " WHERE part_event_option.optionname = ". dbh->quote($option).
5568 " AND action = 'cust_bill_send_agent' ".
5569 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5570 " AND peo_agentnum.optionname = 'agentnum' ".
5571 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5573 CASE WHEN part_event_condition_option.optionname IS NULL
5575 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5577 , part_event.weight".
5581 unless ( $part_event_option ) {
5582 return $self->agent->invoice_template || ''
5583 if $option eq 'agent_templatename';
5587 $part_event_option->optionvalue;
5591 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5593 Subroutine (not a method), designed to be called from the queue.
5595 Takes a list of options and values.
5597 Pulls up the customer record via the custnum option and calls bill_and_collect.
5602 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5604 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5605 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5607 #without this errors don't get rolled back
5608 $args{'fatal'} = 1; # runs from job queue, will be caught
5610 $cust_main->bill_and_collect( %args );
5613 sub process_bill_and_collect {
5615 my $param = thaw(decode_base64(shift));
5616 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5617 or die "custnum '$param->{custnum}' not found!\n";
5618 $param->{'job'} = $job;
5619 $param->{'fatal'} = 1; # runs from job queue, will be caught
5620 $param->{'retry'} = 1;
5622 $cust_main->bill_and_collect( %$param );
5625 #starting to take quite a while for big dbs
5626 # (JRNL: journaled so it only happens once per database)
5627 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5628 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5629 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5630 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5631 # JRNL leading/trailing spaces in first, last, company
5632 # - otaker upgrade? journal and call it good? (double check to make sure
5633 # we're not still setting otaker here)
5635 #only going to get worse with new location stuff...
5637 sub _upgrade_data { #class method
5638 my ($class, %opts) = @_;
5641 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5644 #this seems to be the only expensive one.. why does it take so long?
5645 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5647 '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';
5648 FS::upgrade_journal->set_done('cust_main__signupdate');
5651 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5653 # fix yyyy-m-dd formatted paydates
5654 if ( driver_name =~ /^mysql/i ) {
5656 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5657 } else { # the SQL standard
5659 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5661 FS::upgrade_journal->set_done('cust_main__paydate');
5664 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5666 push @statements, #fix the weird BILL with a cc# in payinfo problem
5668 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5670 FS::upgrade_journal->set_done('cust_main__payinfo');
5675 foreach my $sql ( @statements ) {
5676 my $sth = dbh->prepare($sql) or die dbh->errstr;
5677 $sth->execute or die $sth->errstr;
5678 #warn ( (time - $t). " seconds\n" );
5682 local($ignore_expired_card) = 1;
5683 local($ignore_banned_card) = 1;
5684 local($skip_fuzzyfiles) = 1;
5685 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5687 FS::cust_main::Location->_upgrade_data(%opts);
5689 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5691 foreach my $cust_main ( qsearch({
5692 'table' => 'cust_main',
5694 'extra_sql' => 'WHERE '.
5696 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5697 qw( first last company )
5700 my $error = $cust_main->replace;
5701 die $error if $error;
5704 FS::upgrade_journal->set_done('cust_main__trimspaces');
5708 $class->_upgrade_otaker(%opts);
5710 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5711 # existing records will be encrypted in queueable_upgrade (below)
5712 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5713 eval "use FS::Setup";
5715 FS::Setup::enable_encryption();
5718 $class->_upgrade_data_paydate_edgebug;
5721 =item _upgrade_data_paydate_edgebug
5723 Correct bad data injected into payment expire date column by Edge browser bug
5725 The month and year values may have an extra character injected into form POST
5726 data by Edge browser. It was possible for some bad month values to slip
5727 past data validation.
5729 If the stored value was out of range, it was causing payments screen to crash.
5730 We can detect and fix this by dropping the second digit.
5732 If the stored value is is 11 or 12, it's possible the user inputted a 1. In
5733 this case, the payment method will fail to authorize, but the record will
5734 not cause crashdumps for being out of range.
5736 In short, check for any expiration month > 12, and drop the extra digit
5740 sub _upgrade_data_paydate_edgebug {
5741 my $journal_label = 'cust_main_paydate_edgebug';
5742 return if FS::upgrade_journal->is_done( $journal_label );
5744 my $oldAutoCommit = $FS::UID::AutoCommit;
5745 local $FS::UID::AutoCommit = 0;
5748 FS::Record::qsearch(
5749 cust_main => { paydate => { op => '!=', value => '' }}
5752 next unless $row->ut_daten('paydate');
5754 # paydate column stored in database has failed date validation
5755 my $bad_paydate = $row->paydate;
5757 my @date = split /[\-\/]/, $bad_paydate;
5758 @date = @date[2,0,1] if $date[2] > 1900;
5760 # Only autocorrecting when month > 12 - notify operator
5761 unless ( $date[1] > 12 ) {
5763 'Unable to correct bad paydate stored in cust_main row '.
5764 'custnum(%s) paydate(%s)',
5770 $date[1] = substr( $date[1], 0, 1 );
5771 $row->paydate( join('-', @date ));
5773 if ( my $error = $row->replace ) {
5775 'Failed to autocorrect bad paydate stored in cust_main row '.
5776 'custnum(%s) paydate(%s) - error: %s',
5784 'Autocorrected bad paydate stored in cust_main row '.
5785 "custnum(%s) old-paydate(%s) new-paydate(%s)\n",
5793 FS::upgrade_journal->set_done( $journal_label );
5794 dbh->commit unless $oldAutoCommit;
5798 sub queueable_upgrade {
5801 ### encryption gets turned on in _upgrade_data, above
5803 eval "use FS::upgrade_journal";
5806 # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
5807 # clear that out before encrypting/tokenizing anything else
5808 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5809 foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5810 my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5811 my $sth = dbh->prepare($sql) or die dbh->errstr;
5812 $sth->execute or die $sth->errstr;
5814 FS::upgrade_journal->set_done('clear_payinfo_history');
5817 # fix Tokenized paycardtype and encrypt old records
5818 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5819 || ! FS::upgrade_journal->is_done('encryption_check')
5823 # allow replacement of closed cust_pay/cust_refund records
5824 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5826 # because it looks like nothing's changing
5827 local $FS::Record::no_update_diff = 1;
5829 # commit everything immediately
5830 local $FS::UID::AutoCommit = 1;
5832 # encrypt what's there
5833 foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5834 my $tclass = 'FS::'.$table;
5837 while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
5838 my $record = $tclass->by_key($recnum);
5839 next unless $record; # small chance it's been deleted, that's ok
5840 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5841 # window for possible conflict is practically nonexistant,
5842 # but just in case...
5843 $record = $record->select_for_update;
5844 if (!$record->custnum && $table eq 'cust_pay_pending') {
5845 $record->set('custnum_pending',1);
5847 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5849 local($ignore_expired_card) = 1;
5850 local($ignore_banned_card) = 1;
5851 local($skip_fuzzyfiles) = 1;
5852 local($import) = 1;#prevent automatic geocoding (need its own variable?)
5854 my $error = $record->replace;
5855 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5859 FS::upgrade_journal->set_done('paycardtype_Tokenized');
5860 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5865 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5866 # cust_payby might get deleted while this runs
5868 sub _upgrade_next_recnum {
5869 my ($dbh,$table,$lastrecnum,$recnums) = @_;
5870 my $recnum = shift @$recnums;
5871 return $recnum if $recnum;
5872 my $tclass = 'FS::'.$table;
5873 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
5874 my $sql = 'SELECT '.$tclass->primary_key.
5876 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5877 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5878 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
5879 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5880 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5881 $sth->execute() or die $sth->errstr;
5883 while (my $rec = $sth->fetchrow_hashref) {
5884 push @$recnums, $rec->{$tclass->primary_key};
5887 $$lastrecnum = $$recnums[-1];
5888 return shift @$recnums;
5897 The delete method should possibly take an FS::cust_main object reference
5898 instead of a scalar customer number.
5900 Bill and collect options should probably be passed as references instead of a
5903 There should probably be a configuration file with a list of allowed credit
5906 No multiple currency support (probably a larger project than just this module).
5908 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5910 Birthdates rely on negative epoch values.
5912 The payby for card/check batches is broken. With mixed batching, bad
5915 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5919 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5920 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5921 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.