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;
37 use FS::UID qw( getotaker dbh driver_name );
38 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
39 use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty card_types );
40 use FS::Msgcat qw(gettext);
47 use FS::cust_bill_void;
48 use FS::legacy_cust_bill;
50 use FS::cust_pay_pending;
51 use FS::cust_pay_void;
52 use FS::cust_pay_batch;
55 use FS::part_referral;
56 use FS::cust_main_county;
57 use FS::cust_location;
59 use FS::cust_main_exemption;
60 use FS::cust_tax_adjustment;
61 use FS::cust_tax_location;
63 use FS::cust_main_invoice;
65 use FS::prepay_credit;
71 use FS::payment_gateway;
72 use FS::agent_payment_gateway;
74 use FS::cust_main_note;
75 use FS::cust_attachment;
78 use FS::upgrade_journal;
81 # 1 is mostly method/subroutine entry and options
82 # 2 traces progress of some operations
83 # 3 is even more information including possibly sensitive data
85 $me = '[FS::cust_main]';
88 $ignore_expired_card = 0;
89 $ignore_banned_card = 0;
93 @encrypted_fields = ('payinfo', 'paycvv');
94 sub nohistory_fields { ('payinfo', 'paycvv'); }
96 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
98 #ask FS::UID to run this stuff for us later
99 #$FS::UID::callback{'FS::cust_main'} = sub {
100 install_callback FS::UID sub {
101 $conf = new FS::Conf;
102 $default_agent_custid = $conf->exists('cust_main-default_agent_custid');
103 $custnum_display_length = $conf->config('cust_main-custnum-display_length');
108 my ( $hashref, $cache ) = @_;
109 if ( exists $hashref->{'pkgnum'} ) {
110 #@{ $self->{'_pkgnum'} } = ();
111 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
112 $self->{'_pkgnum'} = $subcache;
113 #push @{ $self->{'_pkgnum'} },
114 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
120 FS::cust_main - Object methods for cust_main records
126 $record = new FS::cust_main \%hash;
127 $record = new FS::cust_main { 'column' => 'value' };
129 $error = $record->insert;
131 $error = $new_record->replace($old_record);
133 $error = $record->delete;
135 $error = $record->check;
137 @cust_pkg = $record->all_pkgs;
139 @cust_pkg = $record->ncancelled_pkgs;
141 @cust_pkg = $record->suspended_pkgs;
143 $error = $record->bill;
144 $error = $record->bill %options;
145 $error = $record->bill 'time' => $time;
147 $error = $record->collect;
148 $error = $record->collect %options;
149 $error = $record->collect 'invoice_time' => $time,
154 An FS::cust_main object represents a customer. FS::cust_main inherits from
155 FS::Record. The following fields are currently supported:
161 Primary key (assigned automatically for new customers)
165 Agent (see L<FS::agent>)
169 Advertising source (see L<FS::part_referral>)
181 Cocial security number (optional)
205 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
209 Payment Information (See L<FS::payinfo_Mixin> for data format)
213 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
217 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
221 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
225 Start date month (maestro/solo cards only)
229 Start date year (maestro/solo cards only)
233 Issue number (maestro/solo cards only)
237 Name on card or billing name
241 IP address from which payment information was received
245 The credit card type (deduced from the card number).
249 Tax exempt, empty or `Y'
253 Order taker (see L<FS::access_user>)
259 =item referral_custnum
261 Referring customer number
265 Enable individual CDR spooling, empty or `Y'
269 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
273 Discourage individual CDR printing, empty or `Y'
277 Allow self-service editing of ticket subjects, empty or 'Y'
279 =item calling_list_exempt
281 Do not call, empty or 'Y'
283 =item invoice_ship_address
285 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
295 Creates a new customer. To add the customer to the database, see L<"insert">.
297 Note that this stores the hash reference, not a distinct copy of the hash it
298 points to. You can ask the object for a copy with the I<hash> method.
302 sub table { 'cust_main'; }
304 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
306 Adds this customer to the database. If there is an error, returns the error,
307 otherwise returns false.
309 Usually the customer's location will not yet exist in the database, and
310 the C<bill_location> and C<ship_location> pseudo-fields must be set to
311 uninserted L<FS::cust_location> objects. These will be inserted and linked
312 (in both directions) to the new customer record. If they're references
313 to the same object, they will become the same location.
315 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
316 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
317 are inserted atomicly, or the transaction is rolled back. Passing an empty
318 hash reference is equivalent to not supplying this parameter. There should be
319 a better explanation of this, but until then, here's an example:
322 tie %hash, 'Tie::RefHash'; #this part is important
324 $cust_pkg => [ $svc_acct ],
327 $cust_main->insert( \%hash );
329 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
330 be set as the invoicing list (see L<"invoicing_list">). Errors return as
331 expected and rollback the entire transaction; it is not necessary to call
332 check_invoicing_list first. The invoicing_list is set after the records in the
333 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
334 invoicing_list destination to the newly-created svc_acct. Here's an example:
336 $cust_main->insert( {}, [ $email, 'POST' ] );
338 Currently available options are: I<depend_jobnum>, I<noexport>,
339 I<tax_exemption> and I<prospectnum>.
341 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
342 on the supplied jobnum (they will not run until the specific job completes).
343 This can be used to defer provisioning until some action completes (such
344 as running the customer's credit card successfully).
346 The I<noexport> option is deprecated. If I<noexport> is set true, no
347 provisioning jobs (exports) are scheduled. (You can schedule them later with
348 the B<reexport> method.)
350 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
351 of tax names and exemption numbers. FS::cust_main_exemption records will be
352 created and inserted.
354 If I<prospectnum> is set, moves contacts and locations from that prospect.
360 my $cust_pkgs = @_ ? shift : {};
361 my $invoicing_list = @_ ? shift : '';
363 warn "$me insert called with options ".
364 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
367 local $SIG{HUP} = 'IGNORE';
368 local $SIG{INT} = 'IGNORE';
369 local $SIG{QUIT} = 'IGNORE';
370 local $SIG{TERM} = 'IGNORE';
371 local $SIG{TSTP} = 'IGNORE';
372 local $SIG{PIPE} = 'IGNORE';
374 my $oldAutoCommit = $FS::UID::AutoCommit;
375 local $FS::UID::AutoCommit = 0;
378 my $prepay_identifier = '';
379 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
381 if ( $self->payby eq 'PREPAY' ) {
383 $self->payby('BILL');
384 $prepay_identifier = $self->payinfo;
387 warn " looking up prepaid card $prepay_identifier\n"
390 my $error = $self->get_prepay( $prepay_identifier,
391 'amount_ref' => \$amount,
392 'seconds_ref' => \$seconds,
393 'upbytes_ref' => \$upbytes,
394 'downbytes_ref' => \$downbytes,
395 'totalbytes_ref' => \$totalbytes,
398 $dbh->rollback if $oldAutoCommit;
399 #return "error applying prepaid card (transaction rolled back): $error";
403 $payby = 'PREP' if $amount;
405 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
408 $self->payby('BILL');
409 $amount = $self->paid;
414 foreach my $l (qw(bill_location ship_location)) {
416 my $loc = delete $self->hashref->{$l} or return "$l not set";
418 if ( !$loc->locationnum ) {
419 # warn the location that we're going to insert it with no custnum
420 $loc->set(custnum_pending => 1);
421 warn " inserting $l\n"
423 my $error = $loc->insert;
425 $dbh->rollback if $oldAutoCommit;
426 my $label = $l eq 'ship_location' ? 'service' : 'billing';
427 return "$error (in $label location)";
430 } elsif ( $loc->prospectnum ) {
432 $loc->prospectnum('');
433 $loc->set(custnum_pending => 1);
434 my $error = $loc->replace;
436 $dbh->rollback if $oldAutoCommit;
437 my $label = $l eq 'ship_location' ? 'service' : 'billing';
438 return "$error (moving $label location)";
441 } elsif ( ($loc->custnum || 0) > 0 ) {
442 # then it somehow belongs to another customer--shouldn't happen
443 $dbh->rollback if $oldAutoCommit;
444 return "$l belongs to customer ".$loc->custnum;
446 # else it already belongs to this customer
447 # (happens when ship_location is identical to bill_location)
449 $self->set($l.'num', $loc->locationnum);
451 if ( $self->get($l.'num') eq '' ) {
452 $dbh->rollback if $oldAutoCommit;
457 warn " inserting $self\n"
460 $self->signupdate(time) unless $self->signupdate;
462 $self->auto_agent_custid()
463 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
465 my $error = $self->check_payinfo_cardtype
466 || $self->SUPER::insert;
468 $dbh->rollback if $oldAutoCommit;
469 #return "inserting cust_main record (transaction rolled back): $error";
473 # now set cust_location.custnum
474 foreach my $l (qw(bill_location ship_location)) {
475 warn " setting $l.custnum\n"
478 unless ( $loc->custnum ) {
479 $loc->set(custnum => $self->custnum);
480 $error ||= $loc->replace;
484 $dbh->rollback if $oldAutoCommit;
485 return "error setting $l custnum: $error";
489 warn " setting invoicing list\n"
492 if ( $invoicing_list ) {
493 $error = $self->check_invoicing_list( $invoicing_list );
495 $dbh->rollback if $oldAutoCommit;
496 #return "checking invoicing_list (transaction rolled back): $error";
499 $self->invoicing_list( $invoicing_list );
502 warn " setting customer tags\n"
505 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
506 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
507 'custnum' => $self->custnum };
508 my $error = $cust_tag->insert;
510 $dbh->rollback if $oldAutoCommit;
515 my $prospectnum = delete $options{'prospectnum'};
516 if ( $prospectnum ) {
518 warn " moving contacts and locations from prospect $prospectnum\n"
522 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
523 unless ( $prospect_main ) {
524 $dbh->rollback if $oldAutoCommit;
525 return "Unknown prospectnum $prospectnum";
527 $prospect_main->custnum($self->custnum);
528 $prospect_main->disabled('Y');
529 my $error = $prospect_main->replace;
531 $dbh->rollback if $oldAutoCommit;
535 my @contact = $prospect_main->contact;
536 my @cust_location = $prospect_main->cust_location;
537 my @qual = $prospect_main->qual;
539 foreach my $r ( @contact, @cust_location, @qual ) {
541 $r->custnum($self->custnum);
542 my $error = $r->replace;
544 $dbh->rollback if $oldAutoCommit;
551 # validate card (needs custnum already set)
552 if ( $self->payby =~ /^(CARD|DCRD)$/
553 && $conf->exists('business-onlinepayment-verification') ) {
554 $error = $self->realtime_verify_bop({ 'method'=>'CC' });
556 $dbh->rollback if $oldAutoCommit;
561 warn " setting contacts\n"
564 if ( my $contact = delete $options{'contact'} ) {
566 foreach my $c ( @$contact ) {
567 $c->custnum($self->custnum);
568 my $error = $c->insert;
570 $dbh->rollback if $oldAutoCommit;
576 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
578 my $error = $self->process_o2m( 'table' => 'contact',
579 'fields' => FS::contact->cgi_contact_fields,
580 'params' => $contact_params,
583 $dbh->rollback if $oldAutoCommit;
588 warn " setting cust_main_exemption\n"
591 my $tax_exemption = delete $options{'tax_exemption'};
592 if ( $tax_exemption ) {
594 $tax_exemption = { map { $_ => '' } @$tax_exemption }
595 if ref($tax_exemption) eq 'ARRAY';
597 foreach my $taxname ( keys %$tax_exemption ) {
598 my $cust_main_exemption = new FS::cust_main_exemption {
599 'custnum' => $self->custnum,
600 'taxname' => $taxname,
601 'exempt_number' => $tax_exemption->{$taxname},
603 my $error = $cust_main_exemption->insert;
605 $dbh->rollback if $oldAutoCommit;
606 return "inserting cust_main_exemption (transaction rolled back): $error";
611 warn " ordering packages\n"
614 $error = $self->order_pkgs( $cust_pkgs,
616 'seconds_ref' => \$seconds,
617 'upbytes_ref' => \$upbytes,
618 'downbytes_ref' => \$downbytes,
619 'totalbytes_ref' => \$totalbytes,
622 $dbh->rollback if $oldAutoCommit;
627 $dbh->rollback if $oldAutoCommit;
628 return "No svc_acct record to apply pre-paid time";
630 if ( $upbytes || $downbytes || $totalbytes ) {
631 $dbh->rollback if $oldAutoCommit;
632 return "No svc_acct record to apply pre-paid data";
636 warn " inserting initial $payby payment of $amount\n"
638 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
640 $dbh->rollback if $oldAutoCommit;
641 return "inserting payment (transaction rolled back): $error";
645 unless ( $import || $skip_fuzzyfiles ) {
646 warn " queueing fuzzyfiles update\n"
648 $error = $self->queue_fuzzyfiles_update;
650 $dbh->rollback if $oldAutoCommit;
651 return "updating fuzzy search cache: $error";
655 # FS::geocode_Mixin::after_insert or something?
656 if ( $conf->config('tax_district_method') and !$import ) {
657 # if anything non-empty, try to look it up
658 my $queue = new FS::queue {
659 'job' => 'FS::geocode_Mixin::process_district_update',
660 'custnum' => $self->custnum,
662 my $error = $queue->insert( ref($self), $self->custnum );
664 $dbh->rollback if $oldAutoCommit;
665 return "queueing tax district update: $error";
670 warn " exporting\n" if $DEBUG > 1;
672 my $export_args = $options{'export_args'} || [];
675 map qsearch( 'part_export', {exportnum=>$_} ),
676 $conf->config('cust_main-exports'); #, $agentnum
678 foreach my $part_export ( @part_export ) {
679 my $error = $part_export->export_insert($self, @$export_args);
681 $dbh->rollback if $oldAutoCommit;
682 return "exporting to ". $part_export->exporttype.
683 " (transaction rolled back): $error";
687 #foreach my $depend_jobnum ( @$depend_jobnums ) {
688 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
690 # foreach my $jobnum ( @jobnums ) {
691 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
692 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
694 # my $error = $queue->depend_insert($depend_jobnum);
696 # $dbh->rollback if $oldAutoCommit;
697 # return "error queuing job dependancy: $error";
704 #if ( exists $options{'jobnums'} ) {
705 # push @{ $options{'jobnums'} }, @jobnums;
708 warn " insert complete; committing transaction\n"
711 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
716 use File::CounterFile;
717 sub auto_agent_custid {
720 my $format = $conf->config('cust_main-auto_agent_custid');
722 if ( $format eq '1YMMXXXXXXXX' ) {
724 my $counter = new File::CounterFile 'cust_main.agent_custid';
727 my $ym = 100000000000 + time2str('%y%m00000000', time);
728 if ( $ym > $counter->value ) {
729 $counter->{'value'} = $agent_custid = $ym;
730 $counter->{'updated'} = 1;
732 $agent_custid = $counter->inc;
738 die "Unknown cust_main-auto_agent_custid format: $format";
741 $self->agent_custid($agent_custid);
745 =item PACKAGE METHODS
747 Documentation on customer package methods has been moved to
748 L<FS::cust_main::Packages>.
750 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
752 Recharges this (existing) customer with the specified prepaid card (see
753 L<FS::prepay_credit>), specified either by I<identifier> or as an
754 FS::prepay_credit object. If there is an error, returns the error, otherwise
757 Optionally, five scalar references can be passed as well. They will have their
758 values filled in with the amount, number of seconds, and number of upload,
759 download, and total bytes applied by this prepaid card.
763 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
764 #the only place that uses these args
765 sub recharge_prepay {
766 my( $self, $prepay_credit, $amountref, $secondsref,
767 $upbytesref, $downbytesref, $totalbytesref ) = @_;
769 local $SIG{HUP} = 'IGNORE';
770 local $SIG{INT} = 'IGNORE';
771 local $SIG{QUIT} = 'IGNORE';
772 local $SIG{TERM} = 'IGNORE';
773 local $SIG{TSTP} = 'IGNORE';
774 local $SIG{PIPE} = 'IGNORE';
776 my $oldAutoCommit = $FS::UID::AutoCommit;
777 local $FS::UID::AutoCommit = 0;
780 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
782 my $error = $self->get_prepay( $prepay_credit,
783 'amount_ref' => \$amount,
784 'seconds_ref' => \$seconds,
785 'upbytes_ref' => \$upbytes,
786 'downbytes_ref' => \$downbytes,
787 'totalbytes_ref' => \$totalbytes,
789 || $self->increment_seconds($seconds)
790 || $self->increment_upbytes($upbytes)
791 || $self->increment_downbytes($downbytes)
792 || $self->increment_totalbytes($totalbytes)
793 || $self->insert_cust_pay_prepay( $amount,
795 ? $prepay_credit->identifier
800 $dbh->rollback if $oldAutoCommit;
804 if ( defined($amountref) ) { $$amountref = $amount; }
805 if ( defined($secondsref) ) { $$secondsref = $seconds; }
806 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
807 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
808 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
810 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
815 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
817 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
818 specified either by I<identifier> or as an FS::prepay_credit object.
820 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
821 incremented by the values of the prepaid card.
823 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
824 check or set this customer's I<agentnum>.
826 If there is an error, returns the error, otherwise returns false.
832 my( $self, $prepay_credit, %opt ) = @_;
834 local $SIG{HUP} = 'IGNORE';
835 local $SIG{INT} = 'IGNORE';
836 local $SIG{QUIT} = 'IGNORE';
837 local $SIG{TERM} = 'IGNORE';
838 local $SIG{TSTP} = 'IGNORE';
839 local $SIG{PIPE} = 'IGNORE';
841 my $oldAutoCommit = $FS::UID::AutoCommit;
842 local $FS::UID::AutoCommit = 0;
845 unless ( ref($prepay_credit) ) {
847 my $identifier = $prepay_credit;
849 $prepay_credit = qsearchs(
851 { 'identifier' => $identifier },
856 unless ( $prepay_credit ) {
857 $dbh->rollback if $oldAutoCommit;
858 return "Invalid prepaid card: ". $identifier;
863 if ( $prepay_credit->agentnum ) {
864 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
865 $dbh->rollback if $oldAutoCommit;
866 return "prepaid card not valid for agent ". $self->agentnum;
868 $self->agentnum($prepay_credit->agentnum);
871 my $error = $prepay_credit->delete;
873 $dbh->rollback if $oldAutoCommit;
874 return "removing prepay_credit (transaction rolled back): $error";
877 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
878 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
885 =item increment_upbytes SECONDS
887 Updates this customer's single or primary account (see L<FS::svc_acct>) by
888 the specified number of upbytes. If there is an error, returns the error,
889 otherwise returns false.
893 sub increment_upbytes {
894 _increment_column( shift, 'upbytes', @_);
897 =item increment_downbytes SECONDS
899 Updates this customer's single or primary account (see L<FS::svc_acct>) by
900 the specified number of downbytes. If there is an error, returns the error,
901 otherwise returns false.
905 sub increment_downbytes {
906 _increment_column( shift, 'downbytes', @_);
909 =item increment_totalbytes SECONDS
911 Updates this customer's single or primary account (see L<FS::svc_acct>) by
912 the specified number of totalbytes. If there is an error, returns the error,
913 otherwise returns false.
917 sub increment_totalbytes {
918 _increment_column( shift, 'totalbytes', @_);
921 =item increment_seconds SECONDS
923 Updates this customer's single or primary account (see L<FS::svc_acct>) by
924 the specified number of seconds. If there is an error, returns the error,
925 otherwise returns false.
929 sub increment_seconds {
930 _increment_column( shift, 'seconds', @_);
933 =item _increment_column AMOUNT
935 Updates this customer's single or primary account (see L<FS::svc_acct>) by
936 the specified number of seconds or bytes. If there is an error, returns
937 the error, otherwise returns false.
941 sub _increment_column {
942 my( $self, $column, $amount ) = @_;
943 warn "$me increment_column called: $column, $amount\n"
946 return '' unless $amount;
948 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
949 $self->ncancelled_pkgs;
952 return 'No packages with primary or single services found'.
953 ' to apply pre-paid time';
954 } elsif ( scalar(@cust_pkg) > 1 ) {
955 #maybe have a way to specify the package/account?
956 return 'Multiple packages found to apply pre-paid time';
959 my $cust_pkg = $cust_pkg[0];
960 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
964 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
967 return 'No account found to apply pre-paid time';
968 } elsif ( scalar(@cust_svc) > 1 ) {
969 return 'Multiple accounts found to apply pre-paid time';
972 my $svc_acct = $cust_svc[0]->svc_x;
973 warn " found service svcnum ". $svc_acct->pkgnum.
974 ' ('. $svc_acct->email. ")\n"
977 $column = "increment_$column";
978 $svc_acct->$column($amount);
982 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
984 Inserts a prepayment in the specified amount for this customer. An optional
985 second argument can specify the prepayment identifier for tracking purposes.
986 If there is an error, returns the error, otherwise returns false.
990 sub insert_cust_pay_prepay {
991 shift->insert_cust_pay('PREP', @_);
994 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
996 Inserts a cash payment in the specified amount for this customer. An optional
997 second argument can specify the payment identifier for tracking purposes.
998 If there is an error, returns the error, otherwise returns false.
1002 sub insert_cust_pay_cash {
1003 shift->insert_cust_pay('CASH', @_);
1006 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1008 Inserts a Western Union payment in the specified amount for this customer. An
1009 optional second argument can specify the prepayment identifier for tracking
1010 purposes. If there is an error, returns the error, otherwise returns false.
1014 sub insert_cust_pay_west {
1015 shift->insert_cust_pay('WEST', @_);
1018 sub insert_cust_pay {
1019 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1020 my $payinfo = scalar(@_) ? shift : '';
1022 my $cust_pay = new FS::cust_pay {
1023 'custnum' => $self->custnum,
1024 'paid' => sprintf('%.2f', $amount),
1025 #'_date' => #date the prepaid card was purchased???
1027 'payinfo' => $payinfo,
1035 This method is deprecated. See the I<depend_jobnum> option to the insert and
1036 order_pkgs methods for a better way to defer provisioning.
1038 Re-schedules all exports by calling the B<reexport> method of all associated
1039 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1040 otherwise returns false.
1047 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1048 "use the depend_jobnum option to insert or order_pkgs to delay export";
1050 local $SIG{HUP} = 'IGNORE';
1051 local $SIG{INT} = 'IGNORE';
1052 local $SIG{QUIT} = 'IGNORE';
1053 local $SIG{TERM} = 'IGNORE';
1054 local $SIG{TSTP} = 'IGNORE';
1055 local $SIG{PIPE} = 'IGNORE';
1057 my $oldAutoCommit = $FS::UID::AutoCommit;
1058 local $FS::UID::AutoCommit = 0;
1061 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1062 my $error = $cust_pkg->reexport;
1064 $dbh->rollback if $oldAutoCommit;
1069 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1074 =item delete [ OPTION => VALUE ... ]
1076 This deletes the customer. If there is an error, returns the error, otherwise
1079 This will completely remove all traces of the customer record. This is not
1080 what you want when a customer cancels service; for that, cancel all of the
1081 customer's packages (see L</cancel>).
1083 If the customer has any uncancelled packages, you need to pass a new (valid)
1084 customer number for those packages to be transferred to, as the "new_customer"
1085 option. Cancelled packages will be deleted. Did I mention that this is NOT
1086 what you want when a customer cancels service and that you really should be
1087 looking at L<FS::cust_pkg/cancel>?
1089 You can't delete a customer with invoices (see L<FS::cust_bill>),
1090 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1091 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1092 set the "delete_financials" option to a true value.
1097 my( $self, %opt ) = @_;
1099 local $SIG{HUP} = 'IGNORE';
1100 local $SIG{INT} = 'IGNORE';
1101 local $SIG{QUIT} = 'IGNORE';
1102 local $SIG{TERM} = 'IGNORE';
1103 local $SIG{TSTP} = 'IGNORE';
1104 local $SIG{PIPE} = 'IGNORE';
1106 my $oldAutoCommit = $FS::UID::AutoCommit;
1107 local $FS::UID::AutoCommit = 0;
1110 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1111 $dbh->rollback if $oldAutoCommit;
1112 return "Can't delete a master agent customer";
1115 #use FS::access_user
1116 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1117 $dbh->rollback if $oldAutoCommit;
1118 return "Can't delete a master employee customer";
1121 tie my %financial_tables, 'Tie::IxHash',
1122 'cust_bill' => 'invoices',
1123 'cust_statement' => 'statements',
1124 'cust_credit' => 'credits',
1125 'cust_pay' => 'payments',
1126 'cust_refund' => 'refunds',
1129 foreach my $table ( keys %financial_tables ) {
1131 my @records = $self->$table();
1133 if ( @records && ! $opt{'delete_financials'} ) {
1134 $dbh->rollback if $oldAutoCommit;
1135 return "Can't delete a customer with ". $financial_tables{$table};
1138 foreach my $record ( @records ) {
1139 my $error = $record->delete;
1141 $dbh->rollback if $oldAutoCommit;
1142 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1148 my @cust_pkg = $self->ncancelled_pkgs;
1150 my $new_custnum = $opt{'new_custnum'};
1151 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1152 $dbh->rollback if $oldAutoCommit;
1153 return "Invalid new customer number: $new_custnum";
1155 foreach my $cust_pkg ( @cust_pkg ) {
1156 my %hash = $cust_pkg->hash;
1157 $hash{'custnum'} = $new_custnum;
1158 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1159 my $error = $new_cust_pkg->replace($cust_pkg,
1160 options => { $cust_pkg->options },
1163 $dbh->rollback if $oldAutoCommit;
1168 my @cancelled_cust_pkg = $self->all_pkgs;
1169 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1170 my $error = $cust_pkg->delete;
1172 $dbh->rollback if $oldAutoCommit;
1177 #cust_tax_adjustment in financials?
1178 #cust_pay_pending? ouch
1180 foreach my $table (qw(
1181 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1182 cust_location cust_main_note cust_tax_adjustment
1183 cust_pay_void cust_pay_batch queue cust_tax_exempt
1185 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1186 my $error = $record->delete;
1188 $dbh->rollback if $oldAutoCommit;
1194 my $sth = $dbh->prepare(
1195 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1197 my $errstr = $dbh->errstr;
1198 $dbh->rollback if $oldAutoCommit;
1201 $sth->execute($self->custnum) or do {
1202 my $errstr = $sth->errstr;
1203 $dbh->rollback if $oldAutoCommit;
1209 my $ticket_dbh = '';
1210 if ($conf->config('ticket_system') eq 'RT_Internal') {
1212 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1213 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1214 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1215 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1218 if ( $ticket_dbh ) {
1220 my $ticket_sth = $ticket_dbh->prepare(
1221 'DELETE FROM Links WHERE Target = ?'
1223 my $errstr = $ticket_dbh->errstr;
1224 $dbh->rollback if $oldAutoCommit;
1227 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1229 my $errstr = $ticket_sth->errstr;
1230 $dbh->rollback if $oldAutoCommit;
1234 #check and see if the customer is the only link on the ticket, and
1235 #if so, set the ticket to deleted status in RT?
1236 #maybe someday, for now this will at least fix tickets not displaying
1240 #delete the customer record
1242 my $error = $self->SUPER::delete;
1244 $dbh->rollback if $oldAutoCommit;
1248 # cust_main exports!
1250 #my $export_args = $options{'export_args'} || [];
1253 map qsearch( 'part_export', {exportnum=>$_} ),
1254 $conf->config('cust_main-exports'); #, $agentnum
1256 foreach my $part_export ( @part_export ) {
1257 my $error = $part_export->export_delete( $self ); #, @$export_args);
1259 $dbh->rollback if $oldAutoCommit;
1260 return "exporting to ". $part_export->exporttype.
1261 " (transaction rolled back): $error";
1265 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1270 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1272 This merges this customer into the provided new custnum, and then deletes the
1273 customer. If there is an error, returns the error, otherwise returns false.
1275 The source customer's name, company name, phone numbers, agent,
1276 referring customer, customer class, advertising source, order taker, and
1277 billing information (except balance) are discarded.
1279 All packages are moved to the target customer. Packages with package locations
1280 are preserved. Packages without package locations are moved to a new package
1281 location with the source customer's service/shipping address.
1283 All invoices, statements, payments, credits and refunds are moved to the target
1284 customer. The source customer's balance is added to the target customer.
1286 All notes, attachments, tickets and customer tags are moved to the target
1289 Change history is not currently moved.
1294 my( $self, $new_custnum, %opt ) = @_;
1296 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1298 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1299 or return "Invalid new customer number: $new_custnum";
1301 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1302 if $self->agentnum != $new_cust_main->agentnum
1303 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1305 local $SIG{HUP} = 'IGNORE';
1306 local $SIG{INT} = 'IGNORE';
1307 local $SIG{QUIT} = 'IGNORE';
1308 local $SIG{TERM} = 'IGNORE';
1309 local $SIG{TSTP} = 'IGNORE';
1310 local $SIG{PIPE} = 'IGNORE';
1312 my $oldAutoCommit = $FS::UID::AutoCommit;
1313 local $FS::UID::AutoCommit = 0;
1316 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1317 $dbh->rollback if $oldAutoCommit;
1318 return "Can't merge a master agent customer";
1321 #use FS::access_user
1322 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1323 $dbh->rollback if $oldAutoCommit;
1324 return "Can't merge a master employee customer";
1327 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1328 'status' => { op=>'!=', value=>'done' },
1332 $dbh->rollback if $oldAutoCommit;
1333 return "Can't merge a customer with pending payments";
1336 tie my %financial_tables, 'Tie::IxHash',
1337 'cust_bill' => 'invoices',
1338 'cust_bill_void' => 'voided invoices',
1339 'cust_statement' => 'statements',
1340 'cust_credit' => 'credits',
1341 'cust_credit_void' => 'voided credits',
1342 'cust_pay' => 'payments',
1343 'cust_pay_void' => 'voided payments',
1344 'cust_refund' => 'refunds',
1347 foreach my $table ( keys %financial_tables ) {
1349 my @records = $self->$table();
1351 foreach my $record ( @records ) {
1352 $record->custnum($new_custnum);
1353 my $error = $record->replace;
1355 $dbh->rollback if $oldAutoCommit;
1356 return "Error merging ". $financial_tables{$table}. ": $error\n";
1362 my $name = $self->ship_name; #?
1364 my $locationnum = '';
1365 foreach my $cust_pkg ( $self->all_pkgs ) {
1366 $cust_pkg->custnum($new_custnum);
1368 unless ( $cust_pkg->locationnum ) {
1369 unless ( $locationnum ) {
1370 my $cust_location = new FS::cust_location {
1371 $self->location_hash,
1372 'custnum' => $new_custnum,
1374 my $error = $cust_location->insert;
1376 $dbh->rollback if $oldAutoCommit;
1379 $locationnum = $cust_location->locationnum;
1381 $cust_pkg->locationnum($locationnum);
1384 my $error = $cust_pkg->replace;
1386 $dbh->rollback if $oldAutoCommit;
1390 # add customer (ship) name to svc_phone.phone_name if blank
1391 my @cust_svc = $cust_pkg->cust_svc;
1392 foreach my $cust_svc (@cust_svc) {
1393 my($label, $value, $svcdb) = $cust_svc->label;
1394 next unless $svcdb eq 'svc_phone';
1395 my $svc_phone = $cust_svc->svc_x;
1396 next if $svc_phone->phone_name;
1397 $svc_phone->phone_name($name);
1398 my $error = $svc_phone->replace;
1400 $dbh->rollback if $oldAutoCommit;
1408 # cust_tax_exempt (texas tax exemptions)
1409 # cust_recon (some sort of not-well understood thing for OnPac)
1411 #these are moved over
1412 foreach my $table (qw(
1413 cust_tag cust_location contact cust_attachment cust_main_note
1414 cust_tax_adjustment cust_pay_batch queue
1416 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1417 $record->custnum($new_custnum);
1418 my $error = $record->replace;
1420 $dbh->rollback if $oldAutoCommit;
1426 #these aren't preserved
1427 foreach my $table (qw(
1428 cust_main_exemption cust_main_invoice
1430 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1431 my $error = $record->delete;
1433 $dbh->rollback if $oldAutoCommit;
1440 my $sth = $dbh->prepare(
1441 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1443 my $errstr = $dbh->errstr;
1444 $dbh->rollback if $oldAutoCommit;
1447 $sth->execute($new_custnum, $self->custnum) or do {
1448 my $errstr = $sth->errstr;
1449 $dbh->rollback if $oldAutoCommit;
1455 my $ticket_dbh = '';
1456 if ($conf->config('ticket_system') eq 'RT_Internal') {
1458 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1459 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1460 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1461 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1464 if ( $ticket_dbh ) {
1466 my $ticket_sth = $ticket_dbh->prepare(
1467 'UPDATE Links SET Target = ? WHERE Target = ?'
1469 my $errstr = $ticket_dbh->errstr;
1470 $dbh->rollback if $oldAutoCommit;
1473 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1474 'freeside://freeside/cust_main/'.$self->custnum)
1476 my $errstr = $ticket_sth->errstr;
1477 $dbh->rollback if $oldAutoCommit;
1483 #delete the customer record
1485 my $error = $self->delete;
1487 $dbh->rollback if $oldAutoCommit;
1491 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1496 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1498 Replaces the OLD_RECORD with this one in the database. If there is an error,
1499 returns the error, otherwise returns false.
1501 To change the customer's address, set the pseudo-fields C<bill_location> and
1502 C<ship_location>. The address will still only change if at least one of the
1503 address fields differs from the existing values.
1505 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1506 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1507 expected and rollback the entire transaction; it is not necessary to call
1508 check_invoicing_list first. Here's an example:
1510 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1512 Currently available options are: I<tax_exemption>.
1514 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1515 of tax names and exemption numbers. FS::cust_main_exemption records will be
1516 deleted and inserted as appropriate.
1523 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1525 : $self->replace_old;
1529 warn "$me replace called\n"
1532 my $curuser = $FS::CurrentUser::CurrentUser;
1533 if ( $self->payby eq 'COMP'
1534 && $self->payby ne $old->payby
1535 && ! $curuser->access_right('Complimentary customer')
1538 return "You are not permitted to create complimentary accounts.";
1541 local($ignore_expired_card) = 1
1542 if $old->payby =~ /^(CARD|DCRD)$/
1543 && $self->payby =~ /^(CARD|DCRD)$/
1544 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1546 local($ignore_banned_card) = 1
1547 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1548 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1549 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1551 if ( $self->payby =~ /^(CARD|DCRD)$/
1552 && $old->payinfo ne $self->payinfo
1553 && $old->paymask ne $self->paymask )
1555 my $error = $self->check_payinfo_cardtype;
1556 return $error if $error;
1558 if ( $conf->exists('business-onlinepayment-verification') ) {
1559 #need to standardize paydate for this, false laziness with check
1561 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1562 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1563 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1564 ( $m, $y ) = ( $2, "19$1" );
1565 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1566 ( $m, $y ) = ( $3, "20$2" );
1568 return "Illegal expiration date: ". $self->paydate;
1570 $m = sprintf('%02d',$m);
1571 $self->paydate("$y-$m-01");
1573 $error = $self->realtime_verify_bop({ 'method'=>'CC' });
1574 return $error if $error;
1578 return "Invoicing locale is required"
1581 && $conf->exists('cust_main-require_locale');
1583 local $SIG{HUP} = 'IGNORE';
1584 local $SIG{INT} = 'IGNORE';
1585 local $SIG{QUIT} = 'IGNORE';
1586 local $SIG{TERM} = 'IGNORE';
1587 local $SIG{TSTP} = 'IGNORE';
1588 local $SIG{PIPE} = 'IGNORE';
1590 my $oldAutoCommit = $FS::UID::AutoCommit;
1591 local $FS::UID::AutoCommit = 0;
1594 for my $l (qw(bill_location ship_location)) {
1595 my $old_loc = $old->$l;
1596 my $new_loc = $self->$l;
1598 # find the existing location if there is one
1599 $new_loc->set('custnum' => $self->custnum);
1600 my $error = $new_loc->find_or_insert;
1602 $dbh->rollback if $oldAutoCommit;
1605 $self->set($l.'num', $new_loc->locationnum);
1608 # replace the customer record
1609 my $error = $self->SUPER::replace($old);
1612 $dbh->rollback if $oldAutoCommit;
1616 # now move packages to the new service location
1617 $self->set('ship_location', ''); #flush cache
1618 if ( $old->ship_locationnum and # should only be null during upgrade...
1619 $old->ship_locationnum != $self->ship_locationnum ) {
1620 $error = $old->ship_location->move_to($self->ship_location);
1622 $dbh->rollback if $oldAutoCommit;
1626 # don't move packages based on the billing location, but
1627 # disable it if it's no longer in use
1628 if ( $old->bill_locationnum and
1629 $old->bill_locationnum != $self->bill_locationnum ) {
1630 $error = $old->bill_location->disable_if_unused;
1632 $dbh->rollback if $oldAutoCommit;
1637 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1638 my $invoicing_list = shift @param;
1639 $error = $self->check_invoicing_list( $invoicing_list );
1641 $dbh->rollback if $oldAutoCommit;
1644 $self->invoicing_list( $invoicing_list );
1647 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1649 #this could be more efficient than deleting and re-inserting, if it matters
1650 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1651 my $error = $cust_tag->delete;
1653 $dbh->rollback if $oldAutoCommit;
1657 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1658 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1659 'custnum' => $self->custnum };
1660 my $error = $cust_tag->insert;
1662 $dbh->rollback if $oldAutoCommit;
1669 my %options = @param;
1671 my $tax_exemption = delete $options{'tax_exemption'};
1672 if ( $tax_exemption ) {
1674 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1675 if ref($tax_exemption) eq 'ARRAY';
1677 my %cust_main_exemption =
1678 map { $_->taxname => $_ }
1679 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1681 foreach my $taxname ( keys %$tax_exemption ) {
1683 if ( $cust_main_exemption{$taxname} &&
1684 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1687 delete $cust_main_exemption{$taxname};
1691 my $cust_main_exemption = new FS::cust_main_exemption {
1692 'custnum' => $self->custnum,
1693 'taxname' => $taxname,
1694 'exempt_number' => $tax_exemption->{$taxname},
1696 my $error = $cust_main_exemption->insert;
1698 $dbh->rollback if $oldAutoCommit;
1699 return "inserting cust_main_exemption (transaction rolled back): $error";
1703 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1704 my $error = $cust_main_exemption->delete;
1706 $dbh->rollback if $oldAutoCommit;
1707 return "deleting cust_main_exemption (transaction rolled back): $error";
1713 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1714 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1715 && $self->get('payinfo') !~ /^99\d{14}$/
1717 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1722 # card/check/lec info has changed, want to retry realtime_ invoice events
1723 my $error = $self->retry_realtime;
1725 $dbh->rollback if $oldAutoCommit;
1730 unless ( $import || $skip_fuzzyfiles ) {
1731 $error = $self->queue_fuzzyfiles_update;
1733 $dbh->rollback if $oldAutoCommit;
1734 return "updating fuzzy search cache: $error";
1738 # tax district update in cust_location
1740 # cust_main exports!
1742 my $export_args = $options{'export_args'} || [];
1745 map qsearch( 'part_export', {exportnum=>$_} ),
1746 $conf->config('cust_main-exports'); #, $agentnum
1748 foreach my $part_export ( @part_export ) {
1749 my $error = $part_export->export_replace( $self, $old, @$export_args);
1751 $dbh->rollback if $oldAutoCommit;
1752 return "exporting to ". $part_export->exporttype.
1753 " (transaction rolled back): $error";
1757 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1762 =item queue_fuzzyfiles_update
1764 Used by insert & replace to update the fuzzy search cache
1768 use FS::cust_main::Search;
1769 sub queue_fuzzyfiles_update {
1772 local $SIG{HUP} = 'IGNORE';
1773 local $SIG{INT} = 'IGNORE';
1774 local $SIG{QUIT} = 'IGNORE';
1775 local $SIG{TERM} = 'IGNORE';
1776 local $SIG{TSTP} = 'IGNORE';
1777 local $SIG{PIPE} = 'IGNORE';
1779 my $oldAutoCommit = $FS::UID::AutoCommit;
1780 local $FS::UID::AutoCommit = 0;
1783 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1784 my $queue = new FS::queue {
1785 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1787 my @args = "cust_main.$field", $self->get($field);
1788 my $error = $queue->insert( @args );
1790 $dbh->rollback if $oldAutoCommit;
1791 return "queueing job (transaction rolled back): $error";
1795 my @locations = $self->bill_location;
1796 push @locations, $self->ship_location if $self->has_ship_address;
1797 foreach my $location (@locations) {
1798 my $queue = new FS::queue {
1799 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1801 my @args = 'cust_location.address1', $location->address1;
1802 my $error = $queue->insert( @args );
1804 $dbh->rollback if $oldAutoCommit;
1805 return "queueing job (transaction rolled back): $error";
1809 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1816 Checks all fields to make sure this is a valid customer record. If there is
1817 an error, returns the error, otherwise returns false. Called by the insert
1818 and replace methods.
1825 warn "$me check BEFORE: \n". $self->_dump
1829 $self->ut_numbern('custnum')
1830 || $self->ut_number('agentnum')
1831 || $self->ut_textn('agent_custid')
1832 || $self->ut_number('refnum')
1833 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1834 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1835 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1836 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1837 || $self->ut_textn('custbatch')
1838 || $self->ut_name('last')
1839 || $self->ut_name('first')
1840 || $self->ut_snumbern('signupdate')
1841 || $self->ut_snumbern('birthdate')
1842 || $self->ut_namen('spouse_last')
1843 || $self->ut_namen('spouse_first')
1844 || $self->ut_snumbern('spouse_birthdate')
1845 || $self->ut_snumbern('anniversary_date')
1846 || $self->ut_textn('company')
1847 || $self->ut_textn('ship_company')
1848 || $self->ut_anything('comments')
1849 || $self->ut_numbern('referral_custnum')
1850 || $self->ut_textn('stateid')
1851 || $self->ut_textn('stateid_state')
1852 || $self->ut_textn('invoice_terms')
1853 || $self->ut_floatn('cdr_termination_percentage')
1854 || $self->ut_floatn('credit_limit')
1855 || $self->ut_numbern('billday')
1856 || $self->ut_numbern('prorate_day')
1857 || $self->ut_flag('force_prorate_day')
1858 || $self->ut_flag('edit_subject')
1859 || $self->ut_flag('calling_list_exempt')
1860 || $self->ut_flag('invoice_noemail')
1861 || $self->ut_flag('message_noemail')
1862 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1863 || $self->ut_flag('invoice_ship_address')
1866 foreach (qw(company ship_company)) {
1867 my $company = $self->get($_);
1868 $company =~ s/^\s+//;
1869 $company =~ s/\s+$//;
1870 $company =~ s/\s+/ /g;
1871 $self->set($_, $company);
1874 #barf. need message catalogs. i18n. etc.
1875 $error .= "Please select an advertising source."
1876 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1877 return $error if $error;
1879 return "Unknown agent"
1880 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1882 return "Unknown refnum"
1883 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1885 return "Unknown referring custnum: ". $self->referral_custnum
1886 unless ! $self->referral_custnum
1887 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1889 if ( $self->ss eq '' ) {
1894 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1895 or return "Illegal social security number: ". $self->ss;
1896 $self->ss("$1-$2-$3");
1899 #turn off invoice_ship_address if ship & bill are the same
1900 if ($self->bill_locationnum eq $self->ship_locationnum) {
1901 $self->invoice_ship_address('');
1904 # cust_main_county verification now handled by cust_location check
1907 $self->ut_phonen('daytime', $self->country)
1908 || $self->ut_phonen('night', $self->country)
1909 || $self->ut_phonen('fax', $self->country)
1910 || $self->ut_phonen('mobile', $self->country)
1912 return $error if $error;
1914 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1916 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1919 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1921 : FS::Msgcat::_gettext('daytime');
1922 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1924 : FS::Msgcat::_gettext('night');
1926 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1928 : FS::Msgcat::_gettext('mobile');
1930 return "$daytime_label, $night_label or $mobile_label is required"
1934 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1935 # or return "Illegal payby: ". $self->payby;
1937 FS::payby->can_payby($self->table, $self->payby)
1938 or return "Illegal payby: ". $self->payby;
1940 $error = $self->ut_numbern('paystart_month')
1941 || $self->ut_numbern('paystart_year')
1942 || $self->ut_numbern('payissue')
1943 || $self->ut_textn('paytype')
1945 return $error if $error;
1947 if ( $self->payip eq '' ) {
1950 $error = $self->ut_ip('payip');
1951 return $error if $error;
1954 # If it is encrypted and the private key is not availaible then we can't
1955 # check the credit card.
1956 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1958 # Need some kind of global flag to accept invalid cards, for testing
1960 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1962 my $payinfo = $self->payinfo;
1963 $payinfo =~ s/\D//g;
1964 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1965 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1967 $self->payinfo($payinfo);
1969 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1971 my $cardtype = $self->paycardtype;
1972 if ( $payinfo =~ /^99\d{14}$/ ) {
1973 $self->set('is_tokenized', 'Y'); #so we don't try to do it again
1974 if ( $self->paymask =~ /^\d+x/ ) {
1975 $cardtype = cardtype($self->paymask);
1977 #return "paycardtype required ".
1978 # "(can't derive from a token and no paymask w/prefix provided)"
1982 $cardtype = cardtype($self->payinfo);
1985 return gettext('unknown_card_type') if $cardtype eq 'Unknown';
1987 $self->set('paycardtype', $cardtype);
1989 unless ( $ignore_banned_card ) {
1990 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1992 if ( $ban->bantype eq 'warn' ) {
1993 #or others depending on value of $ban->reason ?
1994 return '_duplicate_card'.
1995 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1996 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1997 ' (ban# '. $ban->bannum. ')'
1998 unless $self->override_ban_warn;
2000 return 'Banned credit card: banned on '.
2001 time2str('%a %h %o at %r', $ban->_date).
2002 ' by '. $ban->otaker.
2003 ' (ban# '. $ban->bannum. ')';
2008 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
2009 if ( $cardtype eq 'American Express card' ) {
2010 $self->paycvv =~ /^(\d{4})$/
2011 or return "CVV2 (CID) for American Express cards is four digits.";
2014 $self->paycvv =~ /^(\d{3})$/
2015 or return "CVV2 (CVC2/CID) is three digits.";
2022 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
2024 return "Start date or issue number is required for $cardtype cards"
2025 unless $self->paystart_month && $self->paystart_year or $self->payissue;
2027 return "Start month must be between 1 and 12"
2028 if $self->paystart_month
2029 and $self->paystart_month < 1 || $self->paystart_month > 12;
2031 return "Start year must be 1990 or later"
2032 if $self->paystart_year
2033 and $self->paystart_year < 1990;
2035 return "Issue number must be beween 1 and 99"
2037 and $self->payissue < 1 || $self->payissue > 99;
2040 $self->paystart_month('');
2041 $self->paystart_year('');
2042 $self->payissue('');
2045 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
2047 my $payinfo = $self->payinfo;
2048 $payinfo =~ s/[^\d\@\.]//g;
2049 if ( $conf->config('echeck-country') eq 'CA' ) {
2050 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
2051 or return 'invalid echeck account@branch.bank';
2052 $payinfo = "$1\@$2.$3";
2053 } elsif ( $conf->config('echeck-country') eq 'US' ) {
2054 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
2055 $payinfo = "$1\@$2";
2057 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
2058 $payinfo = "$1\@$2";
2060 $self->payinfo($payinfo);
2063 unless ( $ignore_banned_card ) {
2064 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2066 if ( $ban->bantype eq 'warn' ) {
2067 #or others depending on value of $ban->reason ?
2068 return '_duplicate_ach' unless $self->override_ban_warn;
2070 return 'Banned ACH account: banned on '.
2071 time2str('%a %h %o at %r', $ban->_date).
2072 ' by '. $ban->otaker.
2073 ' (ban# '. $ban->bannum. ')';
2078 } elsif ( $self->payby eq 'LECB' ) {
2080 my $payinfo = $self->payinfo;
2081 $payinfo =~ s/\D//g;
2082 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2084 $self->payinfo($payinfo);
2087 } elsif ( $self->payby eq 'BILL' ) {
2089 $error = $self->ut_textn('payinfo');
2090 return "Illegal P.O. number: ". $self->payinfo if $error;
2093 } elsif ( $self->payby eq 'COMP' ) {
2095 my $curuser = $FS::CurrentUser::CurrentUser;
2096 if ( ! $self->custnum
2097 && ! $curuser->access_right('Complimentary customer')
2100 return "You are not permitted to create complimentary accounts."
2103 $error = $self->ut_textn('payinfo');
2104 return "Illegal comp account issuer: ". $self->payinfo if $error;
2107 } elsif ( $self->payby eq 'PREPAY' ) {
2109 my $payinfo = $self->payinfo;
2110 $payinfo =~ s/\W//g; #anything else would just confuse things
2111 $self->payinfo($payinfo);
2112 $error = $self->ut_alpha('payinfo');
2113 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2114 return "Unknown prepayment identifier"
2115 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2118 } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
2119 # either ignoring invalid cards, or we can't decrypt the payinfo, but
2120 # try to detect the card type anyway. this never returns failure, so
2121 # the contract of $ignore_invalid_cards is maintained.
2122 $self->set('paycardtype', cardtype($self->paymask));
2125 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2126 return "Expiration date required"
2127 # shouldn't payinfo_check do this?
2128 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2132 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2133 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2134 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2135 ( $m, $y ) = ( $2, "19$1" );
2136 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2137 ( $m, $y ) = ( $3, "20$2" );
2139 return "Illegal expiration date: ". $self->paydate;
2141 $m = sprintf('%02d',$m);
2142 $self->paydate("$y-$m-01");
2143 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2144 return gettext('expired_card')
2146 && !$ignore_expired_card
2147 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2149 if ( my $error = $self->ut_daten('paydate') ) {
2154 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2155 ( ! $conf->exists('require_cardname')
2156 || $self->payby !~ /^(CARD|DCRD)$/ )
2158 $self->payname( $self->first. " ". $self->getfield('last') );
2161 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2162 $self->payname =~ /^([\w \,\.\-\']*)$/
2163 or return gettext('illegal_name'). " payname: ". $self->payname;
2166 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2167 or return gettext('illegal_name'). " payname: ". $self->payname;
2173 return "Please select an invoicing locale"
2176 && $conf->exists('cust_main-require_locale');
2178 return "Please select a customer class"
2179 if ! $self->classnum
2180 && $conf->exists('cust_main-require_classnum');
2182 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2183 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2187 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2189 warn "$me check AFTER: \n". $self->_dump
2192 $self->SUPER::check;
2195 sub check_payinfo_cardtype {
2198 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
2200 my $payinfo = $self->payinfo;
2201 $payinfo =~ s/\D//g;
2203 if ( $payinfo =~ /^99\d{14}$/ ) {
2207 my %bop_card_types = map { $_=>1 } values %{ card_types() };
2208 my $cardtype = cardtype($payinfo);
2209 $self->set('paycardtype', $cardtype);
2211 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
2219 Additional checks for replace only.
2224 my ($new,$old) = @_;
2225 #preserve old value if global config is set
2226 if ($old && $conf->exists('invoice-ship_address')) {
2227 $new->invoice_ship_address($old->invoice_ship_address);
2234 Returns a list of fields which have ship_ duplicates.
2239 qw( last first company
2241 address1 address2 city county state zip country
2243 daytime night fax mobile
2247 =item has_ship_address
2249 Returns true if this customer record has a separate shipping address.
2253 sub has_ship_address {
2255 $self->bill_locationnum != $self->ship_locationnum;
2260 Returns a list of key/value pairs, with the following keys: address1,
2261 adddress2, city, county, state, zip, country, district, and geocode. The
2262 shipping address is used if present.
2268 $self->ship_location->location_hash;
2273 Returns all locations (see L<FS::cust_location>) for this customer.
2279 qsearch('cust_location', { 'custnum' => $self->custnum,
2280 'prospectnum' => '' } );
2285 Returns all contacts (see L<FS::contact>) for this customer.
2289 #already used :/ sub contact {
2292 qsearch('contact', { 'custnum' => $self->custnum } );
2297 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2298 and L<FS::cust_pkg>) for this customer, except those on hold.
2300 Returns a list: an empty list on success or a list of errors.
2306 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
2311 Unsuspends all suspended packages in the on-hold state (those without setup
2312 dates) for this customer.
2318 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2323 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2325 Returns a list: an empty list on success or a list of errors.
2331 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2334 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2336 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2337 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2338 of a list of pkgparts; the hashref has the following keys:
2342 =item pkgparts - listref of pkgparts
2344 =item (other options are passed to the suspend method)
2349 Returns a list: an empty list on success or a list of errors.
2353 sub suspend_if_pkgpart {
2355 my (@pkgparts, %opt);
2356 if (ref($_[0]) eq 'HASH'){
2357 @pkgparts = @{$_[0]{pkgparts}};
2362 grep { $_->suspend(%opt) }
2363 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2364 $self->unsuspended_pkgs;
2367 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2369 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2370 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2371 instead of a list of pkgparts; the hashref has the following keys:
2375 =item pkgparts - listref of pkgparts
2377 =item (other options are passed to the suspend method)
2381 Returns a list: an empty list on success or a list of errors.
2385 sub suspend_unless_pkgpart {
2387 my (@pkgparts, %opt);
2388 if (ref($_[0]) eq 'HASH'){
2389 @pkgparts = @{$_[0]{pkgparts}};
2394 grep { $_->suspend(%opt) }
2395 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2396 $self->unsuspended_pkgs;
2399 =item cancel [ OPTION => VALUE ... ]
2401 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2402 The cancellation time will be now.
2406 Always returns a list: an empty list on success or a list of errors.
2413 warn "$me cancel called on customer ". $self->custnum. " with options ".
2414 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2416 my @pkgs = $self->ncancelled_pkgs;
2418 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2421 =item cancel_pkgs OPTIONS
2423 Cancels a specified list of packages. OPTIONS can include:
2427 =item cust_pkg - an arrayref of the packages. Required.
2429 =item time - the cancellation time, used to calculate final bills and
2430 unused-time credits if any. Will be passed through to the bill() and
2431 FS::cust_pkg::cancel() methods.
2433 =item quiet - can be set true to supress email cancellation notices.
2435 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2436 reasonnum of an existing reason, or passing a hashref will create a new reason.
2437 The hashref should have the following keys:
2438 typenum - Reason type (see L<FS::reason_type>)
2439 reason - Text of the new reason.
2441 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2442 for the individual packages, parallel to the C<cust_pkg> argument. The
2443 reason and reason_otaker arguments will be taken from those objects.
2445 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2447 =item nobill - can be set true to skip billing if it might otherwise be done.
2452 my( $self, %opt ) = @_;
2454 # we're going to cancel services, which is not reversible
2455 # but on 3.x, don't strictly enforce this
2456 warn "cancel_pkgs should not be run inside a transaction"
2457 if $FS::UID::AutoCommit == 0;
2459 local $FS::UID::AutoCommit = 0;
2461 return ( 'access denied' )
2462 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2464 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2466 #should try decryption (we might have the private key)
2467 # and if not maybe queue a job for the server that does?
2468 return ( "Can't (yet) ban encrypted credit cards" )
2469 if $self->is_encrypted($self->payinfo);
2471 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2472 my $error = $ban->insert;
2480 my @pkgs = @{ delete $opt{'cust_pkg'} };
2481 my $cancel_time = $opt{'time'} || time;
2483 # bill all packages first, so we don't lose usage, service counts for
2484 # bulk billing, etc.
2485 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2487 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2489 'time' => $cancel_time );
2491 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2493 return ( "Error billing during cancellation: $error" );
2498 $FS::UID::AutoCommit = 1;
2500 # now cancel all services, the same way we would for individual packages.
2501 # if any of them fail, cancel the rest anyway.
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 my $error = $cust_svc->cancel; # immediate cancel, no date option
2515 push @errors, $error if $error;
2521 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2522 $self->custnum. "\n"
2526 if ($opt{'cust_pkg_reason'}) {
2527 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2533 my $cpr = shift @cprs;
2535 $lopt{'reason'} = $cpr->reasonnum;
2536 $lopt{'reason_otaker'} = $cpr->otaker;
2538 warn "no reason found when canceling package ".$_->pkgnum."\n";
2539 $lopt{'reason'} = '';
2542 my $error = $_->cancel(%lopt);
2543 push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error;
2549 sub _banned_pay_hashref {
2560 'payby' => $payby2ban{$self->payby},
2561 'payinfo' => $self->payinfo,
2562 #don't ever *search* on reason! #'reason' =>
2566 sub _new_banned_pay_hashref {
2568 my $hr = $self->_banned_pay_hashref;
2569 $hr->{payinfo} = md5_base64($hr->{payinfo});
2575 Returns all notes (see L<FS::cust_main_note>) for this customer.
2580 my($self,$orderby_classnum) = (shift,shift);
2581 my $orderby = "sticky DESC, _date DESC";
2582 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2583 qsearch( 'cust_main_note',
2584 { 'custnum' => $self->custnum },
2586 "ORDER BY $orderby",
2592 Returns the agent (see L<FS::agent>) for this customer.
2598 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2603 Returns the agent name (see L<FS::agent>) for this customer.
2609 $self->agent->agent;
2614 Returns any tags associated with this customer, as FS::cust_tag objects,
2615 or an empty list if there are no tags.
2621 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2626 Returns any tags associated with this customer, as FS::part_tag objects,
2627 or an empty list if there are no tags.
2633 map $_->part_tag, $self->cust_tag;
2639 Returns the customer class, as an FS::cust_class object, or the empty string
2640 if there is no customer class.
2646 if ( $self->classnum ) {
2647 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2655 Returns the customer category name, or the empty string if there is no customer
2662 my $cust_class = $self->cust_class;
2664 ? $cust_class->categoryname
2670 Returns the customer class name, or the empty string if there is no customer
2677 my $cust_class = $self->cust_class;
2679 ? $cust_class->classname
2683 =item BILLING METHODS
2685 Documentation on billing methods has been moved to
2686 L<FS::cust_main::Billing>.
2688 =item REALTIME BILLING METHODS
2690 Documentation on realtime billing methods has been moved to
2691 L<FS::cust_main::Billing_Realtime>.
2695 Removes the I<paycvv> field from the database directly.
2697 If there is an error, returns the error, otherwise returns false.
2703 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2704 or return dbh->errstr;
2705 $sth->execute($self->custnum)
2706 or return $sth->errstr;
2711 =item batch_card OPTION => VALUE...
2713 Adds a payment for this invoice to the pending credit card batch (see
2714 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2715 runs the payment using a realtime gateway.
2717 Options may include:
2719 B<amount>: the amount to be paid; defaults to the customer's balance minus
2720 any payments in transit.
2722 B<payby>: the payment method; defaults to cust_main.payby
2724 B<realtime>: runs this as a realtime payment instead of adding it to a
2727 B<invnum>: sets cust_pay_batch.invnum.
2729 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2730 the billing address for the payment; defaults to the customer's billing
2733 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2734 date, and name; defaults to those fields in cust_main.
2739 my ($self, %options) = @_;
2742 if (exists($options{amount})) {
2743 $amount = $options{amount};
2745 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2748 warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n",
2750 $self->in_transit_payments
2755 my $invnum = delete $options{invnum};
2756 my $payby = $options{payby} || $self->payby; #still dubious
2758 if ($options{'realtime'}) {
2759 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2765 my $oldAutoCommit = $FS::UID::AutoCommit;
2766 local $FS::UID::AutoCommit = 0;
2769 #this needs to handle mysql as well as Pg, like svc_acct.pm
2770 #(make it into a common function if folks need to do batching with mysql)
2771 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2772 or return "Cannot lock pay_batch: " . $dbh->errstr;
2776 'payby' => FS::payby->payby2payment($payby),
2778 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2780 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2782 unless ( $pay_batch ) {
2783 $pay_batch = new FS::pay_batch \%pay_batch;
2784 my $error = $pay_batch->insert;
2786 $dbh->rollback if $oldAutoCommit;
2787 die "error creating new batch: $error\n";
2791 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2792 'batchnum' => $pay_batch->batchnum,
2793 'custnum' => $self->custnum,
2796 foreach (qw( address1 address2 city state zip country latitude longitude
2797 payby payinfo paydate payname paycode paytype ))
2799 $options{$_} = '' unless exists($options{$_});
2802 my $loc = $self->bill_location;
2804 my $cust_pay_batch = new FS::cust_pay_batch ( {
2805 'batchnum' => $pay_batch->batchnum,
2806 'invnum' => $invnum || 0, # is there a better value?
2807 # this field should be
2809 # cust_bill_pay_batch now
2810 'custnum' => $self->custnum,
2811 'last' => $self->getfield('last'),
2812 'first' => $self->getfield('first'),
2813 'address1' => $options{address1} || $loc->address1,
2814 'address2' => $options{address2} || $loc->address2,
2815 'city' => $options{city} || $loc->city,
2816 'state' => $options{state} || $loc->state,
2817 'zip' => $options{zip} || $loc->zip,
2818 'country' => $options{country} || $loc->country,
2819 'payby' => $options{payby} || $self->payby,
2820 'payinfo' => $options{payinfo} || $self->payinfo,
2821 'paymask' => ( $options{payinfo}
2822 ? FS::payinfo_Mixin->mask_payinfo( $options{payby},
2826 'exp' => $options{paydate} || $self->paydate,
2827 'payname' => $options{payname} || $self->payname,
2828 'amount' => $amount, # consolidating
2829 'paycode' => $options{paycode} || '',
2832 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2833 if $old_cust_pay_batch;
2836 if ($old_cust_pay_batch) {
2837 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2839 $error = $cust_pay_batch->insert;
2843 $dbh->rollback if $oldAutoCommit;
2847 if ($options{'processing-fee'} > 0) {
2849 my $processing_fee_text = 'Payment Processing Fee';
2851 unless ( $invnum ) { # probably from a payment screen
2852 # do we have any open invoices? pick earliest
2853 # uses the fact that cust_main->cust_bill sorts by date ascending
2854 my @open = $self->open_cust_bill;
2855 $invnum = $open[0]->invnum if scalar(@open);
2858 unless ( $invnum ) { # still nothing? pick last closed invoice
2859 # again uses fact that cust_main->cust_bill sorts by date ascending
2860 my @closed = $self->cust_bill;
2861 $invnum = $closed[$#closed]->invnum if scalar(@closed);
2864 unless ( $invnum ) {
2865 # XXX: unlikely case - pre-paying before any invoices generated
2866 # what it should do is create a new invoice and pick it
2867 warn '\PROCESS FEE AND NO INVOICES PICKED TO APPLY IT!';
2871 my $pf_change_error = $self->charge({
2872 'amount' => $options{'processing-fee'},
2873 'pkg' => $processing_fee_text,
2875 'cust_pkg_ref' => \$pf_cust_pkg,
2878 if($pf_change_error) {
2879 warn 'Unable to add payment processing fee';
2883 $pf_cust_pkg->setup(time);
2884 my $pf_error = $pf_cust_pkg->replace;
2886 warn 'Unable to set setup time on cust_pkg for processing fee';
2890 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum });
2891 unless ( $cust_bill ) {
2892 warn "race condition + invoice deletion just happened";
2896 my $grand_pf_error =
2897 $cust_bill->add_cc_surcharge($pf_cust_pkg->pkgnum,$options{'processing-fee'});
2899 warn "cannot add Processing fee to invoice #$invnum: $grand_pf_error"
2903 my $unapplied = $self->total_unapplied_credits
2904 + $self->total_unapplied_payments
2905 + $self->in_transit_payments;
2906 foreach my $cust_bill ($self->open_cust_bill) {
2907 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2908 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2909 'invnum' => $cust_bill->invnum,
2910 'paybatchnum' => $cust_pay_batch->paybatchnum,
2911 'amount' => $cust_bill->owed,
2914 if ($unapplied >= $cust_bill_pay_batch->amount){
2915 $unapplied -= $cust_bill_pay_batch->amount;
2918 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2919 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2921 $error = $cust_bill_pay_batch->insert;
2923 $dbh->rollback if $oldAutoCommit;
2928 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2934 Returns the total owed for this customer on all invoices
2935 (see L<FS::cust_bill/owed>).
2941 $self->total_owed_date(2145859200); #12/31/2037
2944 =item total_owed_date TIME
2946 Returns the total owed for this customer on all invoices with date earlier than
2947 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2948 see L<Time::Local> and L<Date::Parse> for conversion functions.
2952 sub total_owed_date {
2956 my $custnum = $self->custnum;
2958 my $owed_sql = FS::cust_bill->owed_sql;
2961 SELECT SUM($owed_sql) FROM cust_bill
2962 WHERE custnum = $custnum
2966 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2970 =item total_owed_pkgnum PKGNUM
2972 Returns the total owed on all invoices for this customer's specific package
2973 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2977 sub total_owed_pkgnum {
2978 my( $self, $pkgnum ) = @_;
2979 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2982 =item total_owed_date_pkgnum TIME PKGNUM
2984 Returns the total owed for this customer's specific package when using
2985 experimental package balances on all invoices with date earlier than
2986 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2987 see L<Time::Local> and L<Date::Parse> for conversion functions.
2991 sub total_owed_date_pkgnum {
2992 my( $self, $time, $pkgnum ) = @_;
2995 foreach my $cust_bill (
2996 grep { $_->_date <= $time }
2997 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2999 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3001 sprintf( "%.2f", $total_bill );
3007 Returns the total amount of all payments.
3014 $total += $_->paid foreach $self->cust_pay;
3015 sprintf( "%.2f", $total );
3018 =item total_unapplied_credits
3020 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3021 customer. See L<FS::cust_credit/credited>.
3023 =item total_credited
3025 Old name for total_unapplied_credits. Don't use.
3029 sub total_credited {
3030 #carp "total_credited deprecated, use total_unapplied_credits";
3031 shift->total_unapplied_credits(@_);
3034 sub total_unapplied_credits {
3037 my $custnum = $self->custnum;
3039 my $unapplied_sql = FS::cust_credit->unapplied_sql;
3042 SELECT SUM($unapplied_sql) FROM cust_credit
3043 WHERE custnum = $custnum
3046 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
3050 =item total_unapplied_credits_pkgnum PKGNUM
3052 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3053 customer. See L<FS::cust_credit/credited>.
3057 sub total_unapplied_credits_pkgnum {
3058 my( $self, $pkgnum ) = @_;
3059 my $total_credit = 0;
3060 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3061 sprintf( "%.2f", $total_credit );
3065 =item total_unapplied_payments
3067 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3068 See L<FS::cust_pay/unapplied>.
3072 sub total_unapplied_payments {
3075 my $custnum = $self->custnum;
3077 my $unapplied_sql = FS::cust_pay->unapplied_sql;
3080 SELECT SUM($unapplied_sql) FROM cust_pay
3081 WHERE custnum = $custnum
3084 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
3088 =item total_unapplied_payments_pkgnum PKGNUM
3090 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3091 specific package when using experimental package balances. See
3092 L<FS::cust_pay/unapplied>.
3096 sub total_unapplied_payments_pkgnum {
3097 my( $self, $pkgnum ) = @_;
3098 my $total_unapplied = 0;
3099 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3100 sprintf( "%.2f", $total_unapplied );
3104 =item total_unapplied_refunds
3106 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3107 customer. See L<FS::cust_refund/unapplied>.
3111 sub total_unapplied_refunds {
3113 my $custnum = $self->custnum;
3115 my $unapplied_sql = FS::cust_refund->unapplied_sql;
3118 SELECT SUM($unapplied_sql) FROM cust_refund
3119 WHERE custnum = $custnum
3122 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
3128 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3129 total_unapplied_credits minus total_unapplied_payments).
3135 $self->balance_date_range;
3138 =item balance_date TIME
3140 Returns the balance for this customer, only considering invoices with date
3141 earlier than TIME (total_owed_date minus total_credited minus
3142 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3143 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3150 $self->balance_date_range(shift);
3153 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3155 Returns the balance for this customer, optionally considering invoices with
3156 date earlier than START_TIME, and not later than END_TIME
3157 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3159 Times are specified as SQL fragments or numeric
3160 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3161 L<Date::Parse> for conversion functions. The empty string can be passed
3162 to disable that time constraint completely.
3164 Accepts the same options as L<balance_date_sql>:
3168 =item unapplied_date
3170 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)
3174 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
3175 time will be ignored. Note that START_TIME and END_TIME only limit the date
3176 range for invoices and I<unapplied> payments, credits, and refunds.
3182 sub balance_date_range {
3184 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3185 ') FROM cust_main WHERE custnum='. $self->custnum;
3186 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
3189 =item balance_pkgnum PKGNUM
3191 Returns the balance for this customer's specific package when using
3192 experimental package balances (total_owed plus total_unrefunded, minus
3193 total_unapplied_credits minus total_unapplied_payments)
3197 sub balance_pkgnum {
3198 my( $self, $pkgnum ) = @_;
3201 $self->total_owed_pkgnum($pkgnum)
3202 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3203 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
3204 - $self->total_unapplied_credits_pkgnum($pkgnum)
3205 - $self->total_unapplied_payments_pkgnum($pkgnum)
3209 =item in_transit_payments
3211 Returns the total of requests for payments for this customer pending in
3212 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3216 sub in_transit_payments {
3218 my $in_transit_payments = 0;
3219 foreach my $pay_batch ( qsearch('pay_batch', {
3222 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3223 'batchnum' => $pay_batch->batchnum,
3224 'custnum' => $self->custnum,
3227 $in_transit_payments += $cust_pay_batch->amount;
3230 sprintf( "%.2f", $in_transit_payments );
3235 Returns a hash of useful information for making a payment.
3245 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3246 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3247 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3251 For credit card transactions:
3263 For electronic check transactions:
3278 $return{balance} = $self->balance;
3280 $return{payname} = $self->payname
3281 || ( $self->first. ' '. $self->get('last') );
3283 $return{$_} = $self->bill_location->$_
3284 for qw(address1 address2 city state zip);
3286 $return{payby} = $self->payby;
3287 $return{stateid_state} = $self->stateid_state;
3289 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3290 $return{card_type} = cardtype($self->payinfo);
3291 $return{payinfo} = $self->paymask;
3293 @return{'month', 'year'} = $self->paydate_monthyear;
3297 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3298 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3299 $return{payinfo1} = $payinfo1;
3300 $return{payinfo2} = $payinfo2;
3301 $return{paytype} = $self->paytype;
3302 $return{paystate} = $self->paystate;
3306 #doubleclick protection
3308 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3314 =item paydate_monthyear
3316 Returns a two-element list consisting of the month and year of this customer's
3317 paydate (credit card expiration date for CARD customers)
3321 sub paydate_monthyear {
3323 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3325 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3334 Returns the exact time in seconds corresponding to the payment method
3335 expiration date. For CARD/DCRD customers this is the end of the month;
3336 for others (COMP is the only other payby that uses paydate) it's the start.
3337 Returns 0 if the paydate is empty or set to the far future.
3343 my ($month, $year) = $self->paydate_monthyear;
3344 return 0 if !$year or $year >= 2037;
3345 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3347 if ( $month == 13 ) {
3351 return timelocal(0,0,0,1,$month-1,$year) - 1;
3354 return timelocal(0,0,0,1,$month-1,$year);
3358 =item paydate_epoch_sql
3360 Class method. Returns an SQL expression to obtain the payment expiration date
3361 as a number of seconds.
3365 # Special expiration date behavior for non-CARD/DCRD customers has been
3366 # carefully preserved. Do we really use that?
3367 sub paydate_epoch_sql {
3369 my $table = shift || 'cust_main';
3370 my ($case1, $case2);
3371 if ( driver_name eq 'Pg' ) {
3372 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3373 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3375 elsif ( lc(driver_name) eq 'mysql' ) {
3376 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3377 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3380 return "CASE WHEN $table.payby IN('CARD','DCRD')
3386 =item tax_exemption TAXNAME
3391 my( $self, $taxname ) = @_;
3393 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3394 'taxname' => $taxname,
3399 =item cust_main_exemption
3403 sub cust_main_exemption {
3405 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3408 =item invoicing_list [ ARRAYREF ]
3410 If an arguement is given, sets these email addresses as invoice recipients
3411 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3412 (except as warnings), so use check_invoicing_list first.
3414 Returns a list of email addresses (with svcnum entries expanded).
3416 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3417 check it without disturbing anything by passing nothing.
3419 This interface may change in the future.
3423 sub invoicing_list {
3424 my( $self, $arrayref ) = @_;
3427 my @cust_main_invoice;
3428 if ( $self->custnum ) {
3429 @cust_main_invoice =
3430 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3432 @cust_main_invoice = ();
3434 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3435 #warn $cust_main_invoice->destnum;
3436 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3437 #warn $cust_main_invoice->destnum;
3438 my $error = $cust_main_invoice->delete;
3439 warn $error if $error;
3442 if ( $self->custnum ) {
3443 @cust_main_invoice =
3444 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3446 @cust_main_invoice = ();
3448 my %seen = map { $_->address => 1 } @cust_main_invoice;
3449 foreach my $address ( @{$arrayref} ) {
3450 next if exists $seen{$address} && $seen{$address};
3451 $seen{$address} = 1;
3452 my $cust_main_invoice = new FS::cust_main_invoice ( {
3453 'custnum' => $self->custnum,
3456 my $error = $cust_main_invoice->insert;
3457 warn $error if $error;
3461 if ( $self->custnum ) {
3463 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3470 =item check_invoicing_list ARRAYREF
3472 Checks these arguements as valid input for the invoicing_list method. If there
3473 is an error, returns the error, otherwise returns false.
3477 sub check_invoicing_list {
3478 my( $self, $arrayref ) = @_;
3480 foreach my $address ( @$arrayref ) {
3482 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3483 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3486 my $cust_main_invoice = new FS::cust_main_invoice ( {
3487 'custnum' => $self->custnum,
3490 my $error = $self->custnum
3491 ? $cust_main_invoice->check
3492 : $cust_main_invoice->checkdest
3494 return $error if $error;
3498 return "Email address required"
3499 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3500 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3505 =item set_default_invoicing_list
3507 Sets the invoicing list to all accounts associated with this customer,
3508 overwriting any previous invoicing list.
3512 sub set_default_invoicing_list {
3514 $self->invoicing_list($self->all_emails);
3519 Returns the email addresses of all accounts provisioned for this customer.
3526 foreach my $cust_pkg ( $self->all_pkgs ) {
3527 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3529 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3530 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3532 $list{$_}=1 foreach map { $_->email } @svc_acct;
3537 =item invoicing_list_addpost
3539 Adds postal invoicing to this customer. If this customer is already configured
3540 to receive postal invoices, does nothing.
3544 sub invoicing_list_addpost {
3546 return if grep { $_ eq 'POST' } $self->invoicing_list;
3547 my @invoicing_list = $self->invoicing_list;
3548 push @invoicing_list, 'POST';
3549 $self->invoicing_list(\@invoicing_list);
3552 =item invoicing_list_emailonly
3554 Returns the list of email invoice recipients (invoicing_list without non-email
3555 destinations such as POST and FAX).
3559 sub invoicing_list_emailonly {
3561 warn "$me invoicing_list_emailonly called"
3563 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3566 =item invoicing_list_emailonly_scalar
3568 Returns the list of email invoice recipients (invoicing_list without non-email
3569 destinations such as POST and FAX) as a comma-separated scalar.
3573 sub invoicing_list_emailonly_scalar {
3575 warn "$me invoicing_list_emailonly_scalar called"
3577 join(', ', $self->invoicing_list_emailonly);
3580 =item contact_list [ CLASSNUM, ... ]
3582 Returns a list of contacts (L<FS::contact> objects) for the customer. If
3583 a list of contact classnums is given, returns only contacts in those
3584 classes. If '0' is given, also returns contacts with no class.
3586 If no arguments are given, returns all contacts for the customer.
3594 select => 'contact.*',
3595 extra_sql => ' WHERE contact.custnum = '.$self->custnum,
3602 push @orwhere, 'contact.classnum is null';
3603 } elsif ( /^\d+$/ ) {
3604 push @classnums, $_;
3606 die "bad classnum argument '$_'";
3611 push @orwhere, 'contact.classnum IN ('.join(',', @classnums).')';
3614 $search->{extra_sql} .= ' AND (' .
3615 join(' OR ', map "( $_ )", @orwhere) .
3622 =item contact_list_email [ CLASSNUM, ... ]
3624 Same as L</contact_list>, but returns email destinations instead of contact
3625 objects. Also accepts 'invoice' as an argument, in which case this will also
3626 return the invoice email address if any.
3630 sub contact_list_email {
3638 push @classnums, $_;
3642 # if the only argument passed was 'invoice' then no classnums are
3643 # intended, so skip this.
3645 my @contacts = $self->contact_list(@classnums);
3646 foreach my $contact (@contacts) {
3647 foreach my $contact_email ($contact->contact_email) {
3648 # unlike on 4.x, we have a separate list of invoice email
3650 # make sure they're not redundant with contact emails
3651 $emails{ $contact_email->emailaddress } =
3652 Email::Address->new( $contact->firstlast,
3653 $contact_email->emailaddress
3658 if ( $and_invoice ) {
3659 foreach my $email ($self->invoicing_list_emailonly) {
3660 $emails{ $email } ||=
3661 Email::Address->new( $self->name_short, $email )->format;
3667 =item referral_custnum_cust_main
3669 Returns the customer who referred this customer (or the empty string, if
3670 this customer was not referred).
3672 Note the difference with referral_cust_main method: This method,
3673 referral_custnum_cust_main returns the single customer (if any) who referred
3674 this customer, while referral_cust_main returns an array of customers referred
3679 sub referral_custnum_cust_main {
3681 return '' unless $self->referral_custnum;
3682 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3685 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3687 Returns an array of customers referred by this customer (referral_custnum set
3688 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3689 customers referred by customers referred by this customer and so on, inclusive.
3690 The default behavior is DEPTH 1 (no recursion).
3692 Note the difference with referral_custnum_cust_main method: This method,
3693 referral_cust_main, returns an array of customers referred BY this customer,
3694 while referral_custnum_cust_main returns the single customer (if any) who
3695 referred this customer.
3699 sub referral_cust_main {
3701 my $depth = @_ ? shift : 1;
3702 my $exclude = @_ ? shift : {};
3705 map { $exclude->{$_->custnum}++; $_; }
3706 grep { ! $exclude->{ $_->custnum } }
3707 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3711 map { $_->referral_cust_main($depth-1, $exclude) }
3718 =item referral_cust_main_ncancelled
3720 Same as referral_cust_main, except only returns customers with uncancelled
3725 sub referral_cust_main_ncancelled {
3727 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3730 =item referral_cust_pkg [ DEPTH ]
3732 Like referral_cust_main, except returns a flat list of all unsuspended (and
3733 uncancelled) packages for each customer. The number of items in this list may
3734 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3738 sub referral_cust_pkg {
3740 my $depth = @_ ? shift : 1;
3742 map { $_->unsuspended_pkgs }
3743 grep { $_->unsuspended_pkgs }
3744 $self->referral_cust_main($depth);
3747 =item referring_cust_main
3749 Returns the single cust_main record for the customer who referred this customer
3750 (referral_custnum), or false.
3754 sub referring_cust_main {
3756 return '' unless $self->referral_custnum;
3757 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3760 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3762 Applies a credit to this customer. If there is an error, returns the error,
3763 otherwise returns false.
3765 REASON can be a text string, an FS::reason object, or a scalar reference to
3766 a reasonnum. If a text string, it will be automatically inserted as a new
3767 reason, and a 'reason_type' option must be passed to indicate the
3768 FS::reason_type for the new reason.
3770 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3771 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3772 I<commission_pkgnum>.
3774 Any other options are passed to FS::cust_credit::insert.
3779 my( $self, $amount, $reason, %options ) = @_;
3781 my $cust_credit = new FS::cust_credit {
3782 'custnum' => $self->custnum,
3783 'amount' => $amount,
3786 if ( ref($reason) ) {
3788 if ( ref($reason) eq 'SCALAR' ) {
3789 $cust_credit->reasonnum( $$reason );
3791 $cust_credit->reasonnum( $reason->reasonnum );
3795 $cust_credit->set('reason', $reason)
3798 $cust_credit->$_( delete $options{$_} )
3799 foreach grep exists($options{$_}),
3800 qw( addlinfo eventnum ),
3801 map "commission_$_", qw( agentnum salesnum pkgnum );
3803 $cust_credit->insert(%options);
3807 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3809 Creates a one-time charge for this customer. If there is an error, returns
3810 the error, otherwise returns false.
3812 New-style, with a hashref of options:
3814 my $error = $cust_main->charge(
3818 'start_date' => str2time('7/4/2009'),
3819 'pkg' => 'Description',
3820 'comment' => 'Comment',
3821 'additional' => [], #extra invoice detail
3822 'classnum' => 1, #pkg_class
3824 'setuptax' => '', # or 'Y' for tax exempt
3826 'locationnum'=> 1234, # optional
3829 'taxclass' => 'Tax class',
3832 'taxproduct' => 2, #part_pkg_taxproduct
3833 'override' => {}, #XXX describe
3835 #will be filled in with the new object
3836 'cust_pkg_ref' => \$cust_pkg,
3838 #generate an invoice immediately
3840 'invoice_terms' => '', #with these terms
3846 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3850 #super false laziness w/quotation::charge
3853 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3854 my ( $pkg, $comment, $additional );
3855 my ( $setuptax, $taxclass ); #internal taxes
3856 my ( $taxproduct, $override ); #vendor (CCH) taxes
3858 my $separate_bill = '';
3859 my $cust_pkg_ref = '';
3860 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3862 if ( ref( $_[0] ) ) {
3863 $amount = $_[0]->{amount};
3864 $setup_cost = $_[0]->{setup_cost};
3865 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3866 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3867 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3868 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3869 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3870 : '$'. sprintf("%.2f",$amount);
3871 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3872 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3873 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3874 $additional = $_[0]->{additional} || [];
3875 $taxproduct = $_[0]->{taxproductnum};
3876 $override = { '' => $_[0]->{tax_override} };
3877 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3878 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3879 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3880 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3881 $separate_bill = $_[0]->{separate_bill} || '';
3887 $pkg = @_ ? shift : 'One-time charge';
3888 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3890 $taxclass = @_ ? shift : '';
3894 local $SIG{HUP} = 'IGNORE';
3895 local $SIG{INT} = 'IGNORE';
3896 local $SIG{QUIT} = 'IGNORE';
3897 local $SIG{TERM} = 'IGNORE';
3898 local $SIG{TSTP} = 'IGNORE';
3899 local $SIG{PIPE} = 'IGNORE';
3901 my $oldAutoCommit = $FS::UID::AutoCommit;
3902 local $FS::UID::AutoCommit = 0;
3905 my $part_pkg = new FS::part_pkg ( {
3907 'comment' => $comment,
3911 'classnum' => ( $classnum ? $classnum : '' ),
3912 'setuptax' => $setuptax,
3913 'taxclass' => $taxclass,
3914 'taxproductnum' => $taxproduct,
3915 'setup_cost' => $setup_cost,
3918 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3919 ( 0 .. @$additional - 1 )
3921 'additional_count' => scalar(@$additional),
3922 'setup_fee' => $amount,
3925 my $error = $part_pkg->insert( options => \%options,
3926 tax_overrides => $override,
3929 $dbh->rollback if $oldAutoCommit;
3933 my $pkgpart = $part_pkg->pkgpart;
3934 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3935 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3936 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3937 $error = $type_pkgs->insert;
3939 $dbh->rollback if $oldAutoCommit;
3944 my $cust_pkg = new FS::cust_pkg ( {
3945 'custnum' => $self->custnum,
3946 'pkgpart' => $pkgpart,
3947 'quantity' => $quantity,
3948 'start_date' => $start_date,
3949 'no_auto' => $no_auto,
3950 'separate_bill' => $separate_bill,
3951 'locationnum'=> $locationnum,
3954 $error = $cust_pkg->insert;
3956 $dbh->rollback if $oldAutoCommit;
3958 } elsif ( $cust_pkg_ref ) {
3959 ${$cust_pkg_ref} = $cust_pkg;
3963 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3964 'pkg_list' => [ $cust_pkg ],
3967 $dbh->rollback if $oldAutoCommit;
3972 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3977 #=item charge_postal_fee
3979 #Applies a one time charge this customer. If there is an error,
3980 #returns the error, returns the cust_pkg charge object or false
3981 #if there was no charge.
3985 # This should be a customer event. For that to work requires that bill
3986 # also be a customer event.
3988 sub charge_postal_fee {
3991 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3992 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3994 my $cust_pkg = new FS::cust_pkg ( {
3995 'custnum' => $self->custnum,
3996 'pkgpart' => $pkgpart,
4000 my $error = $cust_pkg->insert;
4001 $error ? $error : $cust_pkg;
4004 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4006 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4008 Optionally, a list or hashref of additional arguments to the qsearch call can
4015 my $opt = ref($_[0]) ? shift : { @_ };
4017 #return $self->num_cust_bill unless wantarray || keys %$opt;
4019 $opt->{'table'} = 'cust_bill';
4020 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4021 $opt->{'hashref'}{'custnum'} = $self->custnum;
4022 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
4024 map { $_ } #behavior of sort undefined in scalar context
4025 sort { $a->_date <=> $b->_date }
4029 =item open_cust_bill
4031 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4036 sub open_cust_bill {
4040 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4046 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4048 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
4052 sub legacy_cust_bill {
4055 #return $self->num_legacy_cust_bill unless wantarray;
4057 map { $_ } #behavior of sort undefined in scalar context
4058 sort { $a->_date <=> $b->_date }
4059 qsearch({ 'table' => 'legacy_cust_bill',
4060 'hashref' => { 'custnum' => $self->custnum, },
4061 'order_by' => 'ORDER BY _date ASC',
4065 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4067 Returns all the statements (see L<FS::cust_statement>) for this customer.
4069 Optionally, a list or hashref of additional arguments to the qsearch call can
4074 =item cust_bill_void
4076 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
4080 sub cust_bill_void {
4083 map { $_ } #return $self->num_cust_bill_void unless wantarray;
4084 sort { $a->_date <=> $b->_date }
4085 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
4088 sub cust_statement {
4090 my $opt = ref($_[0]) ? shift : { @_ };
4092 #return $self->num_cust_statement unless wantarray || keys %$opt;
4094 $opt->{'table'} = 'cust_statement';
4095 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4096 $opt->{'hashref'}{'custnum'} = $self->custnum;
4097 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
4099 map { $_ } #behavior of sort undefined in scalar context
4100 sort { $a->_date <=> $b->_date }
4104 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
4106 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
4108 Optionally, a list or hashref of additional arguments to the qsearch call can
4109 be passed following the SVCDB.
4116 if ( ! $svcdb =~ /^svc_\w+$/ ) {
4117 warn "$me svc_x requires a svcdb";
4120 my $opt = ref($_[0]) ? shift : { @_ };
4122 $opt->{'table'} = $svcdb;
4123 $opt->{'addl_from'} =
4124 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
4125 ($opt->{'addl_from'} || '');
4127 my $custnum = $self->custnum;
4128 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
4129 my $where = "cust_pkg.custnum = $custnum";
4131 my $extra_sql = $opt->{'extra_sql'} || '';
4132 if ( keys %{ $opt->{'hashref'} } ) {
4133 $extra_sql = " AND $where $extra_sql";
4136 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
4137 $extra_sql = "WHERE $where AND $1";
4140 $extra_sql = "WHERE $where $extra_sql";
4143 $opt->{'extra_sql'} = $extra_sql;
4148 # required for use as an eventtable;
4151 $self->svc_x('svc_acct', @_);
4156 Returns all the credits (see L<FS::cust_credit>) for this customer.
4162 map { $_ } #return $self->num_cust_credit unless wantarray;
4163 sort { $a->_date <=> $b->_date }
4164 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4167 =item cust_credit_pkgnum
4169 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4170 package when using experimental package balances.
4174 sub cust_credit_pkgnum {
4175 my( $self, $pkgnum ) = @_;
4176 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4177 sort { $a->_date <=> $b->_date }
4178 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4179 'pkgnum' => $pkgnum,
4184 =item cust_credit_void
4186 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
4190 sub cust_credit_void {
4193 sort { $a->_date <=> $b->_date }
4194 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
4199 Returns all the payments (see L<FS::cust_pay>) for this customer.
4205 my $opt = ref($_[0]) ? shift : { @_ };
4207 return $self->num_cust_pay unless wantarray || keys %$opt;
4209 $opt->{'table'} = 'cust_pay';
4210 $opt->{'hashref'}{'custnum'} = $self->custnum;
4212 map { $_ } #behavior of sort undefined in scalar context
4213 sort { $a->_date <=> $b->_date }
4220 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
4221 called automatically when the cust_pay method is used in a scalar context.
4227 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4228 my $sth = dbh->prepare($sql) or die dbh->errstr;
4229 $sth->execute($self->custnum) or die $sth->errstr;
4230 $sth->fetchrow_arrayref->[0];
4233 =item unapplied_cust_pay
4235 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
4239 sub unapplied_cust_pay {
4243 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
4249 =item cust_pay_pkgnum
4251 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4252 package when using experimental package balances.
4256 sub cust_pay_pkgnum {
4257 my( $self, $pkgnum ) = @_;
4258 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4259 sort { $a->_date <=> $b->_date }
4260 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4261 'pkgnum' => $pkgnum,
4268 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4274 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4275 sort { $a->_date <=> $b->_date }
4276 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4279 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4281 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
4283 Optionally, a list or hashref of additional arguments to the qsearch call can
4288 sub cust_pay_batch {
4290 my $opt = ref($_[0]) ? shift : { @_ };
4292 #return $self->num_cust_statement unless wantarray || keys %$opt;
4294 $opt->{'table'} = 'cust_pay_batch';
4295 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4296 $opt->{'hashref'}{'custnum'} = $self->custnum;
4297 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
4299 map { $_ } #behavior of sort undefined in scalar context
4300 sort { $a->paybatchnum <=> $b->paybatchnum }
4304 =item cust_pay_pending
4306 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4307 (without status "done").
4311 sub cust_pay_pending {
4313 return $self->num_cust_pay_pending unless wantarray;
4314 sort { $a->_date <=> $b->_date }
4315 qsearch( 'cust_pay_pending', {
4316 'custnum' => $self->custnum,
4317 'status' => { op=>'!=', value=>'done' },
4322 =item cust_pay_pending_attempt
4324 Returns all payment attempts / declined payments for this customer, as pending
4325 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4326 a corresponding payment (see L<FS::cust_pay>).
4330 sub cust_pay_pending_attempt {
4332 return $self->num_cust_pay_pending_attempt unless wantarray;
4333 sort { $a->_date <=> $b->_date }
4334 qsearch( 'cust_pay_pending', {
4335 'custnum' => $self->custnum,
4342 =item num_cust_pay_pending
4344 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4345 customer (without status "done"). Also called automatically when the
4346 cust_pay_pending method is used in a scalar context.
4350 sub num_cust_pay_pending {
4353 " SELECT COUNT(*) FROM cust_pay_pending ".
4354 " WHERE custnum = ? AND status != 'done' ",
4359 =item num_cust_pay_pending_attempt
4361 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4362 customer, with status "done" but without a corresp. Also called automatically when the
4363 cust_pay_pending method is used in a scalar context.
4367 sub num_cust_pay_pending_attempt {
4370 " SELECT COUNT(*) FROM cust_pay_pending ".
4371 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4378 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4384 map { $_ } #return $self->num_cust_refund unless wantarray;
4385 sort { $a->_date <=> $b->_date }
4386 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4389 =item display_custnum
4391 Returns the displayed customer number for this customer: agent_custid if
4392 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4396 sub display_custnum {
4399 return $self->agent_custid
4400 if $default_agent_custid && $self->agent_custid;
4402 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4406 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
4407 } elsif ( $custnum_display_length ) {
4408 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
4410 return $self->custnum;
4416 Returns a name string for this customer, either "Company (Last, First)" or
4423 my $name = $self->contact;
4424 $name = $self->company. " ($name)" if $self->company;
4428 =item service_contact
4430 Returns the L<FS::contact> object for this customer that has the 'Service'
4431 contact class, or undef if there is no such contact. Deprecated; don't use
4436 sub service_contact {
4438 if ( !exists($self->{service_contact}) ) {
4439 my $classnum = $self->scalar_sql(
4440 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4441 ) || 0; #if it's zero, qsearchs will return nothing
4442 $self->{service_contact} = qsearchs('contact', {
4443 'classnum' => $classnum, 'custnum' => $self->custnum
4446 $self->{service_contact};
4451 Returns a name string for this (service/shipping) contact, either
4452 "Company (Last, First)" or "Last, First".
4459 my $name = $self->ship_contact;
4460 $name = $self->company. " ($name)" if $self->company;
4466 Returns a name string for this customer, either "Company" or "First Last".
4472 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4475 =item ship_name_short
4477 Returns a name string for this (service/shipping) contact, either "Company"
4482 sub ship_name_short {
4484 $self->service_contact
4485 ? $self->ship_contact_firstlast
4491 Returns this customer's full (billing) contact name only, "Last, First"
4497 $self->get('last'). ', '. $self->first;
4502 Returns this customer's full (shipping) contact name only, "Last, First"
4508 my $contact = $self->service_contact || $self;
4509 $contact->get('last') . ', ' . $contact->get('first');
4512 =item contact_firstlast
4514 Returns this customers full (billing) contact name only, "First Last".
4518 sub contact_firstlast {
4520 $self->first. ' '. $self->get('last');
4523 =item ship_contact_firstlast
4525 Returns this customer's full (shipping) contact name only, "First Last".
4529 sub ship_contact_firstlast {
4531 my $contact = $self->service_contact || $self;
4532 $contact->get('first') . ' '. $contact->get('last');
4535 sub bill_country_full {
4537 $self->bill_location->country_full;
4540 sub ship_country_full {
4542 $self->ship_location->country_full;
4545 =item county_state_county [ PREFIX ]
4547 Returns a string consisting of just the county, state and country.
4551 sub county_state_country {
4554 if ( @_ && $_[0] && $self->has_ship_address ) {
4555 $locationnum = $self->ship_locationnum;
4557 $locationnum = $self->bill_locationnum;
4559 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4560 $cust_location->county_state_country;
4563 =item geocode DATA_VENDOR
4565 Returns a value for the customer location as encoded by DATA_VENDOR.
4566 Currently this only makes sense for "CCH" as DATA_VENDOR.
4574 Returns a status string for this customer, currently:
4578 =item prospect - No packages have ever been ordered
4580 =item ordered - Recurring packages all are new (not yet billed).
4582 =item active - One or more recurring packages is active
4584 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4586 =item suspended - All non-cancelled recurring packages are suspended
4588 =item cancelled - All recurring packages are cancelled
4592 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4593 cust_main-status_module configuration option.
4597 sub status { shift->cust_status(@_); }
4601 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4602 for my $status ( FS::cust_main->statuses() ) {
4603 my $method = $status.'_sql';
4604 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4605 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4606 $sth->execute( ($self->custnum) x $numnum )
4607 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4608 if ( $sth->fetchrow_arrayref->[0] ) {
4609 $self->hashref->{cust_status} = $status;
4615 =item is_status_delay_cancel
4617 Returns true if customer status is 'suspended'
4618 and all suspended cust_pkg return true for
4619 cust_pkg->is_status_delay_cancel.
4621 This is not a real status, this only meant for hacking display
4622 values, because otherwise treating the customer as suspended is
4623 really the whole point of the delay_cancel option.
4627 sub is_status_delay_cancel {
4629 return 0 unless $self->status eq 'suspended';
4630 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4631 return 0 unless $cust_pkg->is_status_delay_cancel;
4636 =item ucfirst_cust_status
4638 =item ucfirst_status
4640 Returns the status with the first character capitalized.
4644 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4646 sub ucfirst_cust_status {
4648 ucfirst($self->cust_status);
4653 Returns a hex triplet color string for this customer's status.
4657 sub statuscolor { shift->cust_statuscolor(@_); }
4659 sub cust_statuscolor {
4661 __PACKAGE__->statuscolors->{$self->cust_status};
4664 =item tickets [ STATUS ]
4666 Returns an array of hashes representing the customer's RT tickets.
4668 An optional status (or arrayref or hashref of statuses) may be specified.
4674 my $status = ( @_ && $_[0] ) ? shift : '';
4676 my $num = $conf->config('cust_main-max_tickets') || 10;
4679 if ( $conf->config('ticket_system') ) {
4680 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4682 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4691 foreach my $priority (
4692 $conf->config('ticket_system-custom_priority_field-values'), ''
4694 last if scalar(@tickets) >= $num;
4696 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4697 $num - scalar(@tickets),
4708 =item appointments [ STATUS ]
4710 Returns an array of hashes representing the customer's RT tickets which
4717 my $status = ( @_ && $_[0] ) ? shift : '';
4719 return () unless $conf->config('ticket_system');
4721 my $queueid = $conf->config('ticket_system-appointment-queueid');
4723 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4732 # Return services representing svc_accts in customer support packages
4733 sub support_services {
4735 my %packages = map { $_ => 1 } $conf->config('support_packages');
4737 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4738 grep { $_->part_svc->svcdb eq 'svc_acct' }
4739 map { $_->cust_svc }
4740 grep { exists $packages{ $_->pkgpart } }
4741 $self->ncancelled_pkgs;
4745 # Return a list of latitude/longitude for one of the services (if any)
4746 sub service_coordinates {
4750 grep { $_->latitude && $_->longitude }
4752 map { $_->cust_svc }
4753 $self->ncancelled_pkgs;
4755 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4760 Returns a masked version of the named field
4765 my ($self,$field) = @_;
4769 'x'x(length($self->getfield($field))-4).
4770 substr($self->getfield($field), (length($self->getfield($field))-4));
4774 =item payment_history
4776 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4777 cust_credit and cust_refund objects. Each hashref has the following fields:
4779 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4781 I<date> - value of _date field, unix timestamp
4783 I<date_pretty> - user-friendly date
4785 I<description> - user-friendly description of item
4787 I<amount> - impact of item on user's balance
4788 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4789 Not to be confused with the native 'amount' field in cust_credit, see below.
4791 I<amount_pretty> - includes money char
4793 I<balance> - customer balance, chronologically as of this item
4795 I<balance_pretty> - includes money char
4797 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4799 I<paid> - amount paid for cust_pay records, undef for other types
4801 I<credit> - amount credited for cust_credit records, undef for other types.
4802 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4804 I<refund> - amount refunded for cust_refund records, undef for other types
4806 The four table-specific keys always have positive values, whether they reflect charges or payments.
4808 The following options may be passed to this method:
4810 I<line_items> - if true, returns charges ('Line item') rather than invoices
4812 I<start_date> - unix timestamp, only include records on or after.
4813 If specified, an item of type 'Previous' will also be included.
4814 It does not have table-specific fields.
4816 I<end_date> - unix timestamp, only include records before
4818 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4820 I<conf> - optional already-loaded FS::Conf object.
4824 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4825 # and also for sending customer statements, which should both be kept customer-friendly.
4826 # If you add anything that shouldn't be passed on through the API or exposed
4827 # to customers, add a new option to include it, don't include it by default
4828 sub payment_history {
4830 my $opt = ref($_[0]) ? $_[0] : { @_ };
4832 my $conf = $$opt{'conf'} || new FS::Conf;
4833 my $money_char = $conf->config("money_char") || '$',
4835 #first load entire history,
4836 #need previous to calculate previous balance
4837 #loading after end_date shouldn't hurt too much?
4839 if ( $$opt{'line_items'} ) {
4841 foreach my $cust_bill ( $self->cust_bill ) {
4844 'type' => 'Line item',
4845 'description' => $_->desc( $self->locale ).
4846 ( $_->sdate && $_->edate
4847 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4848 ' To '. time2str('%d-%b-%Y', $_->edate)
4851 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4852 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4853 'date' => $cust_bill->_date,
4854 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4856 foreach $cust_bill->cust_bill_pkg;
4863 'type' => 'Invoice',
4864 'description' => 'Invoice #'. $_->display_invnum,
4865 'amount' => sprintf('%.2f', $_->charged ),
4866 'charged' => sprintf('%.2f', $_->charged ),
4867 'date' => $_->_date,
4868 'date_pretty' => $self->time2str_local('short', $_->_date ),
4870 foreach $self->cust_bill;
4875 'type' => 'Payment',
4876 'description' => 'Payment', #XXX type
4877 'amount' => sprintf('%.2f', 0 - $_->paid ),
4878 'paid' => sprintf('%.2f', $_->paid ),
4879 'date' => $_->_date,
4880 'date_pretty' => $self->time2str_local('short', $_->_date ),
4882 foreach $self->cust_pay;
4886 'description' => 'Credit', #more info?
4887 'amount' => sprintf('%.2f', 0 -$_->amount ),
4888 'credit' => sprintf('%.2f', $_->amount ),
4889 'date' => $_->_date,
4890 'date_pretty' => $self->time2str_local('short', $_->_date ),
4892 foreach $self->cust_credit;
4896 'description' => 'Refund', #more info? type, like payment?
4897 'amount' => $_->refund,
4898 'refund' => $_->refund,
4899 'date' => $_->_date,
4900 'date_pretty' => $self->time2str_local('short', $_->_date ),
4902 foreach $self->cust_refund;
4904 #put it all in chronological order
4905 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4907 #calculate balance, filter items outside date range
4911 foreach my $item (@history) {
4912 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4913 $balance += $$item{'amount'};
4914 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4915 $previous += $$item{'amount'};
4918 $$item{'balance'} = sprintf("%.2f",$balance);
4919 foreach my $key ( qw(amount balance) ) {
4920 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4925 # start with previous balance, if there was one
4928 'type' => 'Previous',
4929 'description' => 'Previous balance',
4930 'amount' => sprintf("%.2f",$previous),
4931 'balance' => sprintf("%.2f",$previous),
4932 'date' => $$opt{'start_date'},
4933 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4935 #false laziness with above
4936 foreach my $key ( qw(amount balance) ) {
4937 $$item{$key.'_pretty'} = $$item{$key};
4938 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4940 unshift(@out,$item);
4943 @out = reverse @history if $$opt{'reverse_sort'};
4950 =head1 CLASS METHODS
4956 Class method that returns the list of possible status strings for customers
4957 (see L<the status method|/status>). For example:
4959 @statuses = FS::cust_main->statuses();
4965 keys %{ $self->statuscolors };
4968 =item cust_status_sql
4970 Returns an SQL fragment to determine the status of a cust_main record, as a
4975 sub cust_status_sql {
4977 for my $status ( FS::cust_main->statuses() ) {
4978 my $method = $status.'_sql';
4979 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4988 Returns an SQL expression identifying prospective cust_main records (customers
4989 with no packages ever ordered)
4993 use vars qw($select_count_pkgs);
4994 $select_count_pkgs =
4995 "SELECT COUNT(*) FROM cust_pkg
4996 WHERE cust_pkg.custnum = cust_main.custnum";
4998 sub select_count_pkgs_sql {
5003 " 0 = ( $select_count_pkgs ) ";
5008 Returns an SQL expression identifying ordered cust_main records (customers with
5009 no active packages, but recurring packages not yet setup or one time charges
5015 FS::cust_main->none_active_sql.
5016 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
5021 Returns an SQL expression identifying active cust_main records (customers with
5022 active recurring packages).
5027 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5030 =item none_active_sql
5032 Returns an SQL expression identifying cust_main records with no active
5033 recurring packages. This includes customers of status prospect, ordered,
5034 inactive, and suspended.
5038 sub none_active_sql {
5039 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5044 Returns an SQL expression identifying inactive cust_main records (customers with
5045 no active recurring packages, but otherwise unsuspended/uncancelled).
5050 FS::cust_main->none_active_sql.
5051 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
5057 Returns an SQL expression identifying suspended cust_main records.
5062 sub suspended_sql { susp_sql(@_); }
5064 FS::cust_main->none_active_sql.
5065 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
5071 Returns an SQL expression identifying cancelled cust_main records.
5075 sub cancel_sql { shift->cancelled_sql(@_); }
5078 =item uncancelled_sql
5080 Returns an SQL expression identifying un-cancelled cust_main records.
5084 sub uncancelled_sql { uncancel_sql(@_); }
5087 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
5092 Returns an SQL fragment to retreive the balance.
5097 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5098 WHERE cust_bill.custnum = cust_main.custnum )
5099 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5100 WHERE cust_pay.custnum = cust_main.custnum )
5101 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5102 WHERE cust_credit.custnum = cust_main.custnum )
5103 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5104 WHERE cust_refund.custnum = cust_main.custnum )
5107 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
5109 Returns an SQL fragment to retreive the balance for this customer, optionally
5110 considering invoices with date earlier than START_TIME, and not
5111 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5112 total_unapplied_payments).
5114 Times are specified as SQL fragments or numeric
5115 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5116 L<Date::Parse> for conversion functions. The empty string can be passed
5117 to disable that time constraint completely.
5119 Available options are:
5123 =item unapplied_date
5125 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)
5130 set to true to remove all customer comparison clauses, for totals
5135 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5140 JOIN clause (typically used with the total option)
5144 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5145 time will be ignored. Note that START_TIME and END_TIME only limit the date
5146 range for invoices and I<unapplied> payments, credits, and refunds.
5152 sub balance_date_sql {
5153 my( $class, $start, $end, %opt ) = @_;
5155 my $cutoff = $opt{'cutoff'};
5157 my $owed = FS::cust_bill->owed_sql($cutoff);
5158 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5159 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5160 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5162 my $j = $opt{'join'} || '';
5164 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5165 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5166 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5167 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5169 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5170 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5171 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5172 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5177 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5179 Returns an SQL fragment to retreive the total unapplied payments for this
5180 customer, only considering payments with date earlier than START_TIME, and
5181 optionally not later than END_TIME.
5183 Times are specified as SQL fragments or numeric
5184 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5185 L<Date::Parse> for conversion functions. The empty string can be passed
5186 to disable that time constraint completely.
5188 Available options are:
5192 sub unapplied_payments_date_sql {
5193 my( $class, $start, $end, %opt ) = @_;
5195 my $cutoff = $opt{'cutoff'};
5197 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5199 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5200 'unapplied_date'=>1 );
5202 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5205 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5207 Helper method for balance_date_sql; name (and usage) subject to change
5208 (suggestions welcome).
5210 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5211 cust_refund, cust_credit or cust_pay).
5213 If TABLE is "cust_bill" or the unapplied_date option is true, only
5214 considers records with date earlier than START_TIME, and optionally not
5215 later than END_TIME .
5219 sub _money_table_where {
5220 my( $class, $table, $start, $end, %opt ) = @_;
5223 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5224 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5225 push @where, "$table._date <= $start" if defined($start) && length($start);
5226 push @where, "$table._date > $end" if defined($end) && length($end);
5228 push @where, @{$opt{'where'}} if $opt{'where'};
5229 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5235 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5236 use FS::cust_main::Search;
5239 FS::cust_main::Search->search(@_);
5248 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5250 Deprecated. Use event notification and message templates
5251 (L<FS::msg_template>) instead.
5253 Sends a templated email notification to the customer (see L<Text::Template>).
5255 OPTIONS is a hash and may include
5257 I<from> - the email sender (default is invoice_from)
5259 I<to> - comma-separated scalar or arrayref of recipients
5260 (default is invoicing_list)
5262 I<subject> - The subject line of the sent email notification
5263 (default is "Notice from company_name")
5265 I<extra_fields> - a hashref of name/value pairs which will be substituted
5268 The following variables are vavailable in the template.
5270 I<$first> - the customer first name
5271 I<$last> - the customer last name
5272 I<$company> - the customer company
5273 I<$payby> - a description of the method of payment for the customer
5274 # would be nice to use FS::payby::shortname
5275 I<$payinfo> - the account information used to collect for this customer
5276 I<$expdate> - the expiration of the customer payment in seconds from epoch
5281 my ($self, $template, %options) = @_;
5283 return unless $conf->exists($template);
5285 my $from = $conf->invoice_from_full($self->agentnum)
5286 if $conf->exists('invoice_from', $self->agentnum);
5287 $from = $options{from} if exists($options{from});
5289 my $to = join(',', $self->invoicing_list_emailonly);
5290 $to = $options{to} if exists($options{to});
5292 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5293 if $conf->exists('company_name', $self->agentnum);
5294 $subject = $options{subject} if exists($options{subject});
5296 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5297 SOURCE => [ map "$_\n",
5298 $conf->config($template)]
5300 or die "can't create new Text::Template object: Text::Template::ERROR";
5301 $notify_template->compile()
5302 or die "can't compile template: Text::Template::ERROR";
5304 $FS::notify_template::_template::company_name =
5305 $conf->config('company_name', $self->agentnum);
5306 $FS::notify_template::_template::company_address =
5307 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5309 my $paydate = $self->paydate || '2037-12-31';
5310 $FS::notify_template::_template::first = $self->first;
5311 $FS::notify_template::_template::last = $self->last;
5312 $FS::notify_template::_template::company = $self->company;
5313 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5314 my $payby = $self->payby;
5315 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5316 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5318 #credit cards expire at the end of the month/year of their exp date
5319 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5320 $FS::notify_template::_template::payby = 'credit card';
5321 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5322 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5324 }elsif ($payby eq 'COMP') {
5325 $FS::notify_template::_template::payby = 'complimentary account';
5327 $FS::notify_template::_template::payby = 'current method';
5329 $FS::notify_template::_template::expdate = $expire_time;
5331 for (keys %{$options{extra_fields}}){
5333 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5336 send_email(from => $from,
5338 subject => $subject,
5339 body => $notify_template->fill_in( PACKAGE =>
5340 'FS::notify_template::_template' ),
5345 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5347 Generates a templated notification to the customer (see L<Text::Template>).
5349 OPTIONS is a hash and may include
5351 I<extra_fields> - a hashref of name/value pairs which will be substituted
5352 into the template. These values may override values mentioned below
5353 and those from the customer record.
5355 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5357 The following variables are available in the template instead of or in addition
5358 to the fields of the customer record.
5360 I<$payby> - a description of the method of payment for the customer
5361 # would be nice to use FS::payby::shortname
5362 I<$payinfo> - the masked account information used to collect for this customer
5363 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5364 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5368 # a lot like cust_bill::print_latex
5369 sub generate_letter {
5370 my ($self, $template, %options) = @_;
5372 warn "Template $template does not exist" && return
5373 unless $conf->exists($template) || $options{'template_text'};
5375 my $template_source = $options{'template_text'}
5376 ? [ $options{'template_text'} ]
5377 : [ map "$_\n", $conf->config($template) ];
5379 my $letter_template = new Text::Template
5381 SOURCE => $template_source,
5382 DELIMITERS => [ '[@--', '--@]' ],
5384 or die "can't create new Text::Template object: Text::Template::ERROR";
5386 $letter_template->compile()
5387 or die "can't compile template: Text::Template::ERROR";
5389 my %letter_data = map { $_ => $self->$_ } $self->fields;
5390 $letter_data{payinfo} = $self->mask_payinfo;
5392 #my $paydate = $self->paydate || '2037-12-31';
5393 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5395 my $payby = $self->payby;
5396 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5397 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5399 #credit cards expire at the end of the month/year of their exp date
5400 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5401 $letter_data{payby} = 'credit card';
5402 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5403 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5405 }elsif ($payby eq 'COMP') {
5406 $letter_data{payby} = 'complimentary account';
5408 $letter_data{payby} = 'current method';
5410 $letter_data{expdate} = $expire_time;
5412 for (keys %{$options{extra_fields}}){
5413 $letter_data{$_} = $options{extra_fields}->{$_};
5416 unless(exists($letter_data{returnaddress})){
5417 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5418 $self->agent_template)
5420 if ( length($retadd) ) {
5421 $letter_data{returnaddress} = $retadd;
5422 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5423 $letter_data{returnaddress} =
5424 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5428 ( $conf->config('company_name', $self->agentnum),
5429 $conf->config('company_address', $self->agentnum),
5433 $letter_data{returnaddress} = '~';
5437 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5439 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5441 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5443 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5447 ) or die "can't open temp file: $!\n";
5448 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5449 or die "can't write temp file: $!\n";
5451 $letter_data{'logo_file'} = $lh->filename;
5453 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5457 ) or die "can't open temp file: $!\n";
5459 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5461 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5462 return ($1, $letter_data{'logo_file'});
5466 =item print_ps TEMPLATE
5468 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5474 my($file, $lfile) = $self->generate_letter(@_);
5475 my $ps = FS::Misc::generate_ps($file);
5476 unlink($file.'.tex');
5482 =item print TEMPLATE
5484 Prints the filled in template.
5486 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5490 sub queueable_print {
5493 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5494 or die "invalid customer number: " . $opt{custnum};
5496 my $error = $self->print( { 'template' => $opt{template} } );
5497 die $error if $error;
5501 my ($self, $template) = (shift, shift);
5503 [ $self->print_ps($template) ],
5504 'agentnum' => $self->agentnum,
5508 #these three subs should just go away once agent stuff is all config overrides
5510 sub agent_template {
5512 $self->_agent_plandata('agent_templatename');
5515 sub agent_invoice_from {
5517 $self->_agent_plandata('agent_invoice_from');
5520 sub _agent_plandata {
5521 my( $self, $option ) = @_;
5523 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5524 #agent-specific Conf
5526 use FS::part_event::Condition;
5528 my $agentnum = $self->agentnum;
5530 my $regexp = regexp_sql();
5532 my $part_event_option =
5534 'select' => 'part_event_option.*',
5535 'table' => 'part_event_option',
5537 LEFT JOIN part_event USING ( eventpart )
5538 LEFT JOIN part_event_option AS peo_agentnum
5539 ON ( part_event.eventpart = peo_agentnum.eventpart
5540 AND peo_agentnum.optionname = 'agentnum'
5541 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5543 LEFT JOIN part_event_condition
5544 ON ( part_event.eventpart = part_event_condition.eventpart
5545 AND part_event_condition.conditionname = 'cust_bill_age'
5547 LEFT JOIN part_event_condition_option
5548 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5549 AND part_event_condition_option.optionname = 'age'
5552 #'hashref' => { 'optionname' => $option },
5553 #'hashref' => { 'part_event_option.optionname' => $option },
5555 " WHERE part_event_option.optionname = ". dbh->quote($option).
5556 " AND action = 'cust_bill_send_agent' ".
5557 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5558 " AND peo_agentnum.optionname = 'agentnum' ".
5559 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5561 CASE WHEN part_event_condition_option.optionname IS NULL
5563 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5565 , part_event.weight".
5569 unless ( $part_event_option ) {
5570 return $self->agent->invoice_template || ''
5571 if $option eq 'agent_templatename';
5575 $part_event_option->optionvalue;
5579 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5581 Subroutine (not a method), designed to be called from the queue.
5583 Takes a list of options and values.
5585 Pulls up the customer record via the custnum option and calls bill_and_collect.
5590 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5592 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5593 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5595 #without this errors don't get rolled back
5596 $args{'fatal'} = 1; # runs from job queue, will be caught
5598 $cust_main->bill_and_collect( %args );
5601 sub process_bill_and_collect {
5603 my $param = thaw(decode_base64(shift));
5604 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5605 or die "custnum '$param->{custnum}' not found!\n";
5606 $param->{'job'} = $job;
5607 $param->{'fatal'} = 1; # runs from job queue, will be caught
5608 $param->{'retry'} = 1;
5610 $cust_main->bill_and_collect( %$param );
5613 #starting to take quite a while for big dbs
5614 # (JRNL: journaled so it only happens once per database)
5615 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5616 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5617 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5618 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5619 # JRNL leading/trailing spaces in first, last, company
5620 # - otaker upgrade? journal and call it good? (double check to make sure
5621 # we're not still setting otaker here)
5623 #only going to get worse with new location stuff...
5625 sub _upgrade_data { #class method
5626 my ($class, %opts) = @_;
5629 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5632 #this seems to be the only expensive one.. why does it take so long?
5633 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5635 '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';
5636 FS::upgrade_journal->set_done('cust_main__signupdate');
5639 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5641 # fix yyyy-m-dd formatted paydates
5642 if ( driver_name =~ /^mysql/i ) {
5644 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5645 } else { # the SQL standard
5647 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5649 FS::upgrade_journal->set_done('cust_main__paydate');
5652 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5654 push @statements, #fix the weird BILL with a cc# in payinfo problem
5656 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5658 FS::upgrade_journal->set_done('cust_main__payinfo');
5663 foreach my $sql ( @statements ) {
5664 my $sth = dbh->prepare($sql) or die dbh->errstr;
5665 $sth->execute or die $sth->errstr;
5666 #warn ( (time - $t). " seconds\n" );
5670 local($ignore_expired_card) = 1;
5671 local($ignore_banned_card) = 1;
5672 local($skip_fuzzyfiles) = 1;
5673 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5675 FS::cust_main::Location->_upgrade_data(%opts);
5677 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5679 foreach my $cust_main ( qsearch({
5680 'table' => 'cust_main',
5682 'extra_sql' => 'WHERE '.
5684 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5685 qw( first last company )
5688 my $error = $cust_main->replace;
5689 die $error if $error;
5692 FS::upgrade_journal->set_done('cust_main__trimspaces');
5696 $class->_upgrade_otaker(%opts);
5698 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5699 # existing records will be encrypted in queueable_upgrade (below)
5700 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5701 eval "use FS::Setup";
5703 FS::Setup::enable_encryption();
5706 $class->_upgrade_data_paydate_edgebug;
5709 =item _upgrade_data_paydate_edgebug
5711 Correct bad data injected into payment expire date column by Edge browser bug
5713 The month and year values may have an extra character injected into form POST
5714 data by Edge browser. It was possible for some bad month values to slip
5715 past data validation.
5717 If the stored value was out of range, it was causing payments screen to crash.
5718 We can detect and fix this by dropping the second digit.
5720 If the stored value is is 11 or 12, it's possible the user inputted a 1. In
5721 this case, the payment method will fail to authorize, but the record will
5722 not cause crashdumps for being out of range.
5724 In short, check for any expiration month > 12, and drop the extra digit
5728 sub _upgrade_data_paydate_edgebug {
5729 my $journal_label = 'cust_main_paydate_edgebug';
5730 return if FS::upgrade_journal->is_done( $journal_label );
5732 my $oldAutoCommit = $FS::UID::AutoCommit;
5733 local $FS::UID::AutoCommit = 0;
5736 FS::Record::qsearch(
5737 cust_main => { paydate => { op => '!=', value => '' }}
5740 next unless $row->ut_daten('paydate');
5742 # paydate column stored in database has failed date validation
5743 my $bad_paydate = $row->paydate;
5745 my @date = split /[\-\/]/, $bad_paydate;
5746 @date = @date[2,0,1] if $date[2] > 1900;
5748 # Only autocorrecting when month > 12 - notify operator
5749 unless ( $date[1] > 12 ) {
5751 'Unable to correct bad paydate stored in cust_main row '.
5752 'custnum(%s) paydate(%s)',
5758 $date[1] = substr( $date[1], 0, 1 );
5759 $row->paydate( join('-', @date ));
5761 if ( my $error = $row->replace ) {
5763 'Failed to autocorrect bad paydate stored in cust_main row '.
5764 'custnum(%s) paydate(%s) - error: %s',
5772 'Autocorrected bad paydate stored in cust_main row '.
5773 "custnum(%s) old-paydate(%s) new-paydate(%s)\n",
5781 FS::upgrade_journal->set_done( $journal_label );
5782 dbh->commit unless $oldAutoCommit;
5786 sub queueable_upgrade {
5789 ### encryption gets turned on in _upgrade_data, above
5791 eval "use FS::upgrade_journal";
5794 # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
5795 # clear that out before encrypting/tokenizing anything else
5796 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5797 foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5798 my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5799 my $sth = dbh->prepare($sql) or die dbh->errstr;
5800 $sth->execute or die $sth->errstr;
5802 FS::upgrade_journal->set_done('clear_payinfo_history');
5805 # fix Tokenized paycardtype and encrypt old records
5806 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5807 || ! FS::upgrade_journal->is_done('encryption_check')
5811 # allow replacement of closed cust_pay/cust_refund records
5812 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5814 # because it looks like nothing's changing
5815 local $FS::Record::no_update_diff = 1;
5817 # commit everything immediately
5818 local $FS::UID::AutoCommit = 1;
5820 # encrypt what's there
5821 foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5822 my $tclass = 'FS::'.$table;
5825 while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
5826 my $record = $tclass->by_key($recnum);
5827 next unless $record; # small chance it's been deleted, that's ok
5828 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5829 # window for possible conflict is practically nonexistant,
5830 # but just in case...
5831 $record = $record->select_for_update;
5832 if (!$record->custnum && $table eq 'cust_pay_pending') {
5833 $record->set('custnum_pending',1);
5835 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5837 local($ignore_expired_card) = 1;
5838 local($ignore_banned_card) = 1;
5839 local($skip_fuzzyfiles) = 1;
5840 local($import) = 1;#prevent automatic geocoding (need its own variable?)
5842 my $error = $record->replace;
5843 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5847 FS::upgrade_journal->set_done('paycardtype_Tokenized');
5848 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5853 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5854 # cust_payby might get deleted while this runs
5856 sub _upgrade_next_recnum {
5857 my ($dbh,$table,$lastrecnum,$recnums) = @_;
5858 my $recnum = shift @$recnums;
5859 return $recnum if $recnum;
5860 my $tclass = 'FS::'.$table;
5861 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
5862 my $sql = 'SELECT '.$tclass->primary_key.
5864 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5865 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5866 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
5867 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5868 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5869 $sth->execute() or die $sth->errstr;
5871 while (my $rec = $sth->fetchrow_hashref) {
5872 push @$recnums, $rec->{$tclass->primary_key};
5875 $$lastrecnum = $$recnums[-1];
5876 return shift @$recnums;
5885 The delete method should possibly take an FS::cust_main object reference
5886 instead of a scalar customer number.
5888 Bill and collect options should probably be passed as references instead of a
5891 There should probably be a configuration file with a list of allowed credit
5894 No multiple currency support (probably a larger project than just this module).
5896 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5898 Birthdates rely on negative epoch values.
5900 The payby for card/check batches is broken. With mixed batching, bad
5903 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5907 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5908 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5909 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.