2 use base qw( FS::cust_main::Packages
4 FS::cust_main::NationalID
6 FS::cust_main::Billing_Realtime
7 FS::cust_main::Billing_Batch
8 FS::cust_main::Billing_Discount
9 FS::cust_main::Billing_ThirdParty
10 FS::cust_main::Location
11 FS::cust_main::Credit_Limit
14 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
15 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
23 use Scalar::Util qw( blessed );
24 use Time::Local qw(timelocal);
29 use File::Temp; #qw( tempfile );
30 use Business::CreditCard 0.28;
32 use FS::UID qw( dbh driver_name );
33 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
35 use FS::Misc qw( generate_email send_email generate_ps do_print );
36 use FS::Msgcat qw(gettext);
43 use FS::cust_bill_void;
44 use FS::legacy_cust_bill;
46 use FS::cust_pay_pending;
47 use FS::cust_pay_void;
48 use FS::cust_pay_batch;
51 use FS::part_referral;
52 use FS::cust_main_county;
53 use FS::cust_location;
56 use FS::cust_main_exemption;
57 use FS::cust_tax_adjustment;
58 use FS::cust_tax_location;
59 use FS::agent_currency;
60 use FS::cust_main_invoice;
62 use FS::prepay_credit;
68 use FS::payment_gateway;
69 use FS::agent_payment_gateway;
71 use FS::cust_main_note;
72 use FS::cust_attachment;
75 use FS::upgrade_journal;
80 # 1 is mostly method/subroutine entry and options
81 # 2 traces progress of some operations
82 # 3 is even more information including possibly sensitive data
84 our $me = '[FS::cust_main]';
87 our $ignore_expired_card = 0;
88 our $ignore_banned_card = 0;
89 our $ignore_invalid_card = 0;
91 our $skip_fuzzyfiles = 0;
93 our $ucfirst_nowarn = 0;
95 #this info is in cust_payby as of 4.x
96 #this and the fields themselves can be removed in 5.x
97 our @encrypted_fields = ('payinfo', 'paycvv');
98 sub nohistory_fields { ('payinfo', 'paycvv'); }
101 #ask FS::UID to run this stuff for us later
102 #$FS::UID::callback{'FS::cust_main'} = sub {
103 install_callback FS::UID sub {
104 $conf = new FS::Conf;
105 #yes, need it for stuff below (prolly should be cached)
106 $ignore_invalid_card = $conf->exists('allow_invalid_cards');
111 my ( $hashref, $cache ) = @_;
112 if ( exists $hashref->{'pkgnum'} ) {
113 #@{ $self->{'_pkgnum'} } = ();
114 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
115 $self->{'_pkgnum'} = $subcache;
116 #push @{ $self->{'_pkgnum'} },
117 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
123 FS::cust_main - Object methods for cust_main records
129 $record = new FS::cust_main \%hash;
130 $record = new FS::cust_main { 'column' => 'value' };
132 $error = $record->insert;
134 $error = $new_record->replace($old_record);
136 $error = $record->delete;
138 $error = $record->check;
140 @cust_pkg = $record->all_pkgs;
142 @cust_pkg = $record->ncancelled_pkgs;
144 @cust_pkg = $record->suspended_pkgs;
146 $error = $record->bill;
147 $error = $record->bill %options;
148 $error = $record->bill 'time' => $time;
150 $error = $record->collect;
151 $error = $record->collect %options;
152 $error = $record->collect 'invoice_time' => $time,
157 An FS::cust_main object represents a customer. FS::cust_main inherits from
158 FS::Record. The following fields are currently supported:
164 Primary key (assigned automatically for new customers)
168 Agent (see L<FS::agent>)
172 Advertising source (see L<FS::part_referral>)
184 Cocial security number (optional)
208 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
212 Payment Information (See L<FS::payinfo_Mixin> for data format)
216 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
220 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
224 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
228 Start date month (maestro/solo cards only)
232 Start date year (maestro/solo cards only)
236 Issue number (maestro/solo cards only)
240 Name on card or billing name
244 IP address from which payment information was received
248 Tax exempt, empty or `Y'
252 Order taker (see L<FS::access_user>)
258 =item referral_custnum
260 Referring customer number
264 Enable individual CDR spooling, empty or `Y'
268 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
272 Discourage individual CDR printing, empty or `Y'
276 Allow self-service editing of ticket subjects, empty or 'Y'
278 =item calling_list_exempt
280 Do not call, empty or 'Y'
290 Creates a new customer. To add the customer to the database, see L<"insert">.
292 Note that this stores the hash reference, not a distinct copy of the hash it
293 points to. You can ask the object for a copy with the I<hash> method.
297 sub table { 'cust_main'; }
299 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
301 Adds this customer to the database. If there is an error, returns the error,
302 otherwise returns false.
304 Usually the customer's location will not yet exist in the database, and
305 the C<bill_location> and C<ship_location> pseudo-fields must be set to
306 uninserted L<FS::cust_location> objects. These will be inserted and linked
307 (in both directions) to the new customer record. If they're references
308 to the same object, they will become the same location.
310 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
311 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
312 are inserted atomicly, or the transaction is rolled back. Passing an empty
313 hash reference is equivalent to not supplying this parameter. There should be
314 a better explanation of this, but until then, here's an example:
317 tie %hash, 'Tie::RefHash'; #this part is important
319 $cust_pkg => [ $svc_acct ],
322 $cust_main->insert( \%hash );
324 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
325 be set as the invoicing list (see L<"invoicing_list">). Errors return as
326 expected and rollback the entire transaction; it is not necessary to call
327 check_invoicing_list first. The invoicing_list is set after the records in the
328 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
329 invoicing_list destination to the newly-created svc_acct. Here's an example:
331 $cust_main->insert( {}, [ $email, 'POST' ] );
333 Currently available options are: I<depend_jobnum>, I<noexport>,
334 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
336 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
337 on the supplied jobnum (they will not run until the specific job completes).
338 This can be used to defer provisioning until some action completes (such
339 as running the customer's credit card successfully).
341 The I<noexport> option is deprecated. If I<noexport> is set true, no
342 provisioning jobs (exports) are scheduled. (You can schedule them later with
343 the B<reexport> method.)
345 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
346 of tax names and exemption numbers. FS::cust_main_exemption records will be
347 created and inserted.
349 If I<prospectnum> is set, moves contacts and locations from that prospect.
351 If I<contact> is set to an arrayref of FS::contact objects, inserts those
352 new contacts with this new customer.
354 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
355 unset), inserts those new contacts with this new customer. Handles CGI
356 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
358 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
359 new stored payment records with this new customer. Handles CGI parameters
360 for an "m2" multiple entry field as passed by edit/cust_main.cgi
366 my $cust_pkgs = @_ ? shift : {};
367 my $invoicing_list = @_ ? shift : '';
369 warn "$me insert called with options ".
370 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
373 local $SIG{HUP} = 'IGNORE';
374 local $SIG{INT} = 'IGNORE';
375 local $SIG{QUIT} = 'IGNORE';
376 local $SIG{TERM} = 'IGNORE';
377 local $SIG{TSTP} = 'IGNORE';
378 local $SIG{PIPE} = 'IGNORE';
380 my $oldAutoCommit = $FS::UID::AutoCommit;
381 local $FS::UID::AutoCommit = 0;
384 my $prepay_identifier = '';
385 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
387 if ( $self->payby eq 'PREPAY' ) {
389 $self->payby(''); #'BILL');
390 $prepay_identifier = $self->payinfo;
393 warn " looking up prepaid card $prepay_identifier\n"
396 my $error = $self->get_prepay( $prepay_identifier,
397 'amount_ref' => \$amount,
398 'seconds_ref' => \$seconds,
399 'upbytes_ref' => \$upbytes,
400 'downbytes_ref' => \$downbytes,
401 'totalbytes_ref' => \$totalbytes,
404 $dbh->rollback if $oldAutoCommit;
405 #return "error applying prepaid card (transaction rolled back): $error";
409 $payby = 'PREP' if $amount;
411 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
414 $self->payby(''); #'BILL');
415 $amount = $self->paid;
420 foreach my $l (qw(bill_location ship_location)) {
422 my $loc = delete $self->hashref->{$l} or next;
424 if ( !$loc->locationnum ) {
425 # warn the location that we're going to insert it with no custnum
426 $loc->set(custnum_pending => 1);
427 warn " inserting $l\n"
429 my $error = $loc->insert;
431 $dbh->rollback if $oldAutoCommit;
432 my $label = $l eq 'ship_location' ? 'service' : 'billing';
433 return "$error (in $label location)";
436 } elsif ( $loc->prospectnum ) {
438 $loc->prospectnum('');
439 $loc->set(custnum_pending => 1);
440 my $error = $loc->replace;
442 $dbh->rollback if $oldAutoCommit;
443 my $label = $l eq 'ship_location' ? 'service' : 'billing';
444 return "$error (moving $label location)";
447 } elsif ( ($loc->custnum || 0) > 0 ) {
448 # then it somehow belongs to another customer--shouldn't happen
449 $dbh->rollback if $oldAutoCommit;
450 return "$l belongs to customer ".$loc->custnum;
452 # else it already belongs to this customer
453 # (happens when ship_location is identical to bill_location)
455 $self->set($l.'num', $loc->locationnum);
457 if ( $self->get($l.'num') eq '' ) {
458 $dbh->rollback if $oldAutoCommit;
463 warn " inserting $self\n"
466 $self->signupdate(time) unless $self->signupdate;
468 $self->auto_agent_custid()
469 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
471 my $error = $self->SUPER::insert;
473 $dbh->rollback if $oldAutoCommit;
474 #return "inserting cust_main record (transaction rolled back): $error";
478 # now set cust_location.custnum
479 foreach my $l (qw(bill_location ship_location)) {
480 warn " setting $l.custnum\n"
482 my $loc = $self->$l or next;
483 unless ( $loc->custnum ) {
484 $loc->set(custnum => $self->custnum);
485 $error ||= $loc->replace;
489 $dbh->rollback if $oldAutoCommit;
490 return "error setting $l custnum: $error";
494 warn " setting invoicing list\n"
497 if ( $invoicing_list ) {
498 $error = $self->check_invoicing_list( $invoicing_list );
500 $dbh->rollback if $oldAutoCommit;
501 #return "checking invoicing_list (transaction rolled back): $error";
504 $self->invoicing_list( $invoicing_list );
507 warn " setting customer tags\n"
510 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
511 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
512 'custnum' => $self->custnum };
513 my $error = $cust_tag->insert;
515 $dbh->rollback if $oldAutoCommit;
520 my $prospectnum = delete $options{'prospectnum'};
521 if ( $prospectnum ) {
523 warn " moving contacts and locations from prospect $prospectnum\n"
527 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
528 unless ( $prospect_main ) {
529 $dbh->rollback if $oldAutoCommit;
530 return "Unknown prospectnum $prospectnum";
532 $prospect_main->custnum($self->custnum);
533 $prospect_main->disabled('Y');
534 my $error = $prospect_main->replace;
536 $dbh->rollback if $oldAutoCommit;
540 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
541 my $cust_contact = new FS::cust_contact {
542 'custnum' => $self->custnum,
543 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
545 my $error = $cust_contact->insert
546 || $prospect_contact->delete;
548 $dbh->rollback if $oldAutoCommit;
553 my @cust_location = $prospect_main->cust_location;
554 my @qual = $prospect_main->qual;
556 foreach my $r ( @cust_location, @qual ) {
558 $r->custnum($self->custnum);
559 my $error = $r->replace;
561 $dbh->rollback if $oldAutoCommit;
568 warn " setting contacts\n"
571 if ( my $contact = delete $options{'contact'} ) {
573 foreach my $c ( @$contact ) {
574 $c->custnum($self->custnum);
575 my $error = $c->insert;
577 $dbh->rollback if $oldAutoCommit;
583 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
585 my $error = $self->process_o2m( 'table' => 'contact',
586 'fields' => FS::contact->cgi_contact_fields,
587 'params' => $contact_params,
590 $dbh->rollback if $oldAutoCommit;
595 warn " setting cust_payby\n"
598 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
600 my $error = $self->process_o2m(
601 'table' => 'cust_payby',
602 'fields' => FS::cust_payby->cgi_cust_payby_fields,
603 'params' => $cust_payby_params,
604 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
607 $dbh->rollback if $oldAutoCommit;
613 warn " setting cust_main_exemption\n"
616 my $tax_exemption = delete $options{'tax_exemption'};
617 if ( $tax_exemption ) {
619 $tax_exemption = { map { $_ => '' } @$tax_exemption }
620 if ref($tax_exemption) eq 'ARRAY';
622 foreach my $taxname ( keys %$tax_exemption ) {
623 my $cust_main_exemption = new FS::cust_main_exemption {
624 'custnum' => $self->custnum,
625 'taxname' => $taxname,
626 'exempt_number' => $tax_exemption->{$taxname},
628 my $error = $cust_main_exemption->insert;
630 $dbh->rollback if $oldAutoCommit;
631 return "inserting cust_main_exemption (transaction rolled back): $error";
636 warn " ordering packages\n"
639 $error = $self->order_pkgs( $cust_pkgs,
641 'seconds_ref' => \$seconds,
642 'upbytes_ref' => \$upbytes,
643 'downbytes_ref' => \$downbytes,
644 'totalbytes_ref' => \$totalbytes,
647 $dbh->rollback if $oldAutoCommit;
652 $dbh->rollback if $oldAutoCommit;
653 return "No svc_acct record to apply pre-paid time";
655 if ( $upbytes || $downbytes || $totalbytes ) {
656 $dbh->rollback if $oldAutoCommit;
657 return "No svc_acct record to apply pre-paid data";
661 warn " inserting initial $payby payment of $amount\n"
663 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
665 $dbh->rollback if $oldAutoCommit;
666 return "inserting payment (transaction rolled back): $error";
670 unless ( $import || $skip_fuzzyfiles ) {
671 warn " queueing fuzzyfiles update\n"
673 $error = $self->queue_fuzzyfiles_update;
675 $dbh->rollback if $oldAutoCommit;
676 return "updating fuzzy search cache: $error";
680 # FS::geocode_Mixin::after_insert or something?
681 if ( $conf->config('tax_district_method') and !$import ) {
682 # if anything non-empty, try to look it up
683 my $queue = new FS::queue {
684 'job' => 'FS::geocode_Mixin::process_district_update',
685 'custnum' => $self->custnum,
687 my $error = $queue->insert( ref($self), $self->custnum );
689 $dbh->rollback if $oldAutoCommit;
690 return "queueing tax district update: $error";
695 warn " exporting\n" if $DEBUG > 1;
697 my $export_args = $options{'export_args'} || [];
700 map qsearch( 'part_export', {exportnum=>$_} ),
701 $conf->config('cust_main-exports'); #, $agentnum
703 foreach my $part_export ( @part_export ) {
704 my $error = $part_export->export_insert($self, @$export_args);
706 $dbh->rollback if $oldAutoCommit;
707 return "exporting to ". $part_export->exporttype.
708 " (transaction rolled back): $error";
712 #foreach my $depend_jobnum ( @$depend_jobnums ) {
713 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
715 # foreach my $jobnum ( @jobnums ) {
716 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
717 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
719 # my $error = $queue->depend_insert($depend_jobnum);
721 # $dbh->rollback if $oldAutoCommit;
722 # return "error queuing job dependancy: $error";
729 #if ( exists $options{'jobnums'} ) {
730 # push @{ $options{'jobnums'} }, @jobnums;
733 warn " insert complete; committing transaction\n"
736 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
741 use File::CounterFile;
742 sub auto_agent_custid {
745 my $format = $conf->config('cust_main-auto_agent_custid');
747 if ( $format eq '1YMMXXXXXXXX' ) {
749 my $counter = new File::CounterFile 'cust_main.agent_custid';
752 my $ym = 100000000000 + time2str('%y%m00000000', time);
753 if ( $ym > $counter->value ) {
754 $counter->{'value'} = $agent_custid = $ym;
755 $counter->{'updated'} = 1;
757 $agent_custid = $counter->inc;
763 die "Unknown cust_main-auto_agent_custid format: $format";
766 $self->agent_custid($agent_custid);
770 =item PACKAGE METHODS
772 Documentation on customer package methods has been moved to
773 L<FS::cust_main::Packages>.
775 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
777 Recharges this (existing) customer with the specified prepaid card (see
778 L<FS::prepay_credit>), specified either by I<identifier> or as an
779 FS::prepay_credit object. If there is an error, returns the error, otherwise
782 Optionally, five scalar references can be passed as well. They will have their
783 values filled in with the amount, number of seconds, and number of upload,
784 download, and total bytes applied by this prepaid card.
788 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
789 #the only place that uses these args
790 sub recharge_prepay {
791 my( $self, $prepay_credit, $amountref, $secondsref,
792 $upbytesref, $downbytesref, $totalbytesref ) = @_;
794 local $SIG{HUP} = 'IGNORE';
795 local $SIG{INT} = 'IGNORE';
796 local $SIG{QUIT} = 'IGNORE';
797 local $SIG{TERM} = 'IGNORE';
798 local $SIG{TSTP} = 'IGNORE';
799 local $SIG{PIPE} = 'IGNORE';
801 my $oldAutoCommit = $FS::UID::AutoCommit;
802 local $FS::UID::AutoCommit = 0;
805 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
807 my $error = $self->get_prepay( $prepay_credit,
808 'amount_ref' => \$amount,
809 'seconds_ref' => \$seconds,
810 'upbytes_ref' => \$upbytes,
811 'downbytes_ref' => \$downbytes,
812 'totalbytes_ref' => \$totalbytes,
814 || $self->increment_seconds($seconds)
815 || $self->increment_upbytes($upbytes)
816 || $self->increment_downbytes($downbytes)
817 || $self->increment_totalbytes($totalbytes)
818 || $self->insert_cust_pay_prepay( $amount,
820 ? $prepay_credit->identifier
825 $dbh->rollback if $oldAutoCommit;
829 if ( defined($amountref) ) { $$amountref = $amount; }
830 if ( defined($secondsref) ) { $$secondsref = $seconds; }
831 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
832 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
833 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
835 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
840 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
842 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
843 specified either by I<identifier> or as an FS::prepay_credit object.
845 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
846 incremented by the values of the prepaid card.
848 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
849 check or set this customer's I<agentnum>.
851 If there is an error, returns the error, otherwise returns false.
857 my( $self, $prepay_credit, %opt ) = @_;
859 local $SIG{HUP} = 'IGNORE';
860 local $SIG{INT} = 'IGNORE';
861 local $SIG{QUIT} = 'IGNORE';
862 local $SIG{TERM} = 'IGNORE';
863 local $SIG{TSTP} = 'IGNORE';
864 local $SIG{PIPE} = 'IGNORE';
866 my $oldAutoCommit = $FS::UID::AutoCommit;
867 local $FS::UID::AutoCommit = 0;
870 unless ( ref($prepay_credit) ) {
872 my $identifier = $prepay_credit;
874 $prepay_credit = qsearchs(
876 { 'identifier' => $identifier },
881 unless ( $prepay_credit ) {
882 $dbh->rollback if $oldAutoCommit;
883 return "Invalid prepaid card: ". $identifier;
888 if ( $prepay_credit->agentnum ) {
889 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
890 $dbh->rollback if $oldAutoCommit;
891 return "prepaid card not valid for agent ". $self->agentnum;
893 $self->agentnum($prepay_credit->agentnum);
896 my $error = $prepay_credit->delete;
898 $dbh->rollback if $oldAutoCommit;
899 return "removing prepay_credit (transaction rolled back): $error";
902 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
903 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
905 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
910 =item increment_upbytes SECONDS
912 Updates this customer's single or primary account (see L<FS::svc_acct>) by
913 the specified number of upbytes. If there is an error, returns the error,
914 otherwise returns false.
918 sub increment_upbytes {
919 _increment_column( shift, 'upbytes', @_);
922 =item increment_downbytes SECONDS
924 Updates this customer's single or primary account (see L<FS::svc_acct>) by
925 the specified number of downbytes. If there is an error, returns the error,
926 otherwise returns false.
930 sub increment_downbytes {
931 _increment_column( shift, 'downbytes', @_);
934 =item increment_totalbytes SECONDS
936 Updates this customer's single or primary account (see L<FS::svc_acct>) by
937 the specified number of totalbytes. If there is an error, returns the error,
938 otherwise returns false.
942 sub increment_totalbytes {
943 _increment_column( shift, 'totalbytes', @_);
946 =item increment_seconds SECONDS
948 Updates this customer's single or primary account (see L<FS::svc_acct>) by
949 the specified number of seconds. If there is an error, returns the error,
950 otherwise returns false.
954 sub increment_seconds {
955 _increment_column( shift, 'seconds', @_);
958 =item _increment_column AMOUNT
960 Updates this customer's single or primary account (see L<FS::svc_acct>) by
961 the specified number of seconds or bytes. If there is an error, returns
962 the error, otherwise returns false.
966 sub _increment_column {
967 my( $self, $column, $amount ) = @_;
968 warn "$me increment_column called: $column, $amount\n"
971 return '' unless $amount;
973 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
974 $self->ncancelled_pkgs;
977 return 'No packages with primary or single services found'.
978 ' to apply pre-paid time';
979 } elsif ( scalar(@cust_pkg) > 1 ) {
980 #maybe have a way to specify the package/account?
981 return 'Multiple packages found to apply pre-paid time';
984 my $cust_pkg = $cust_pkg[0];
985 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
989 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
992 return 'No account found to apply pre-paid time';
993 } elsif ( scalar(@cust_svc) > 1 ) {
994 return 'Multiple accounts found to apply pre-paid time';
997 my $svc_acct = $cust_svc[0]->svc_x;
998 warn " found service svcnum ". $svc_acct->pkgnum.
999 ' ('. $svc_acct->email. ")\n"
1002 $column = "increment_$column";
1003 $svc_acct->$column($amount);
1007 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1009 Inserts a prepayment in the specified amount for this customer. An optional
1010 second argument can specify the prepayment identifier for tracking purposes.
1011 If there is an error, returns the error, otherwise returns false.
1015 sub insert_cust_pay_prepay {
1016 shift->insert_cust_pay('PREP', @_);
1019 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1021 Inserts a cash payment in the specified amount for this customer. An optional
1022 second argument can specify the payment identifier for tracking purposes.
1023 If there is an error, returns the error, otherwise returns false.
1027 sub insert_cust_pay_cash {
1028 shift->insert_cust_pay('CASH', @_);
1031 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1033 Inserts a Western Union payment in the specified amount for this customer. An
1034 optional second argument can specify the prepayment identifier for tracking
1035 purposes. If there is an error, returns the error, otherwise returns false.
1039 sub insert_cust_pay_west {
1040 shift->insert_cust_pay('WEST', @_);
1043 sub insert_cust_pay {
1044 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1045 my $payinfo = scalar(@_) ? shift : '';
1047 my $cust_pay = new FS::cust_pay {
1048 'custnum' => $self->custnum,
1049 'paid' => sprintf('%.2f', $amount),
1050 #'_date' => #date the prepaid card was purchased???
1052 'payinfo' => $payinfo,
1058 =item delete [ OPTION => VALUE ... ]
1060 This deletes the customer. If there is an error, returns the error, otherwise
1063 This will completely remove all traces of the customer record. This is not
1064 what you want when a customer cancels service; for that, cancel all of the
1065 customer's packages (see L</cancel>).
1067 If the customer has any uncancelled packages, you need to pass a new (valid)
1068 customer number for those packages to be transferred to, as the "new_customer"
1069 option. Cancelled packages will be deleted. Did I mention that this is NOT
1070 what you want when a customer cancels service and that you really should be
1071 looking at L<FS::cust_pkg/cancel>?
1073 You can't delete a customer with invoices (see L<FS::cust_bill>),
1074 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1075 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1076 set the "delete_financials" option to a true value.
1081 my( $self, %opt ) = @_;
1083 local $SIG{HUP} = 'IGNORE';
1084 local $SIG{INT} = 'IGNORE';
1085 local $SIG{QUIT} = 'IGNORE';
1086 local $SIG{TERM} = 'IGNORE';
1087 local $SIG{TSTP} = 'IGNORE';
1088 local $SIG{PIPE} = 'IGNORE';
1090 my $oldAutoCommit = $FS::UID::AutoCommit;
1091 local $FS::UID::AutoCommit = 0;
1094 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1095 $dbh->rollback if $oldAutoCommit;
1096 return "Can't delete a master agent customer";
1099 #use FS::access_user
1100 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1101 $dbh->rollback if $oldAutoCommit;
1102 return "Can't delete a master employee customer";
1105 tie my %financial_tables, 'Tie::IxHash',
1106 'cust_bill' => 'invoices',
1107 'cust_statement' => 'statements',
1108 'cust_credit' => 'credits',
1109 'cust_pay' => 'payments',
1110 'cust_refund' => 'refunds',
1113 foreach my $table ( keys %financial_tables ) {
1115 my @records = $self->$table();
1117 if ( @records && ! $opt{'delete_financials'} ) {
1118 $dbh->rollback if $oldAutoCommit;
1119 return "Can't delete a customer with ". $financial_tables{$table};
1122 foreach my $record ( @records ) {
1123 my $error = $record->delete;
1125 $dbh->rollback if $oldAutoCommit;
1126 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1132 my @cust_pkg = $self->ncancelled_pkgs;
1134 my $new_custnum = $opt{'new_custnum'};
1135 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1136 $dbh->rollback if $oldAutoCommit;
1137 return "Invalid new customer number: $new_custnum";
1139 foreach my $cust_pkg ( @cust_pkg ) {
1140 my %hash = $cust_pkg->hash;
1141 $hash{'custnum'} = $new_custnum;
1142 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1143 my $error = $new_cust_pkg->replace($cust_pkg,
1144 options => { $cust_pkg->options },
1147 $dbh->rollback if $oldAutoCommit;
1152 my @cancelled_cust_pkg = $self->all_pkgs;
1153 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1154 my $error = $cust_pkg->delete;
1156 $dbh->rollback if $oldAutoCommit;
1161 #cust_tax_adjustment in financials?
1162 #cust_pay_pending? ouch
1163 foreach my $table (qw(
1164 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1165 cust_payby cust_location cust_main_note cust_tax_adjustment
1166 cust_pay_void cust_pay_batch queue cust_tax_exempt
1168 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1169 my $error = $record->delete;
1171 $dbh->rollback if $oldAutoCommit;
1177 my $sth = $dbh->prepare(
1178 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1180 my $errstr = $dbh->errstr;
1181 $dbh->rollback if $oldAutoCommit;
1184 $sth->execute($self->custnum) or do {
1185 my $errstr = $sth->errstr;
1186 $dbh->rollback if $oldAutoCommit;
1192 my $ticket_dbh = '';
1193 if ($conf->config('ticket_system') eq 'RT_Internal') {
1195 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1196 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1197 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1198 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1201 if ( $ticket_dbh ) {
1203 my $ticket_sth = $ticket_dbh->prepare(
1204 'DELETE FROM Links WHERE Target = ?'
1206 my $errstr = $ticket_dbh->errstr;
1207 $dbh->rollback if $oldAutoCommit;
1210 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1212 my $errstr = $ticket_sth->errstr;
1213 $dbh->rollback if $oldAutoCommit;
1217 #check and see if the customer is the only link on the ticket, and
1218 #if so, set the ticket to deleted status in RT?
1219 #maybe someday, for now this will at least fix tickets not displaying
1223 #delete the customer record
1225 my $error = $self->SUPER::delete;
1227 $dbh->rollback if $oldAutoCommit;
1231 # cust_main exports!
1233 #my $export_args = $options{'export_args'} || [];
1236 map qsearch( 'part_export', {exportnum=>$_} ),
1237 $conf->config('cust_main-exports'); #, $agentnum
1239 foreach my $part_export ( @part_export ) {
1240 my $error = $part_export->export_delete( $self ); #, @$export_args);
1242 $dbh->rollback if $oldAutoCommit;
1243 return "exporting to ". $part_export->exporttype.
1244 " (transaction rolled back): $error";
1248 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1253 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1255 Replaces the OLD_RECORD with this one in the database. If there is an error,
1256 returns the error, otherwise returns false.
1258 To change the customer's address, set the pseudo-fields C<bill_location> and
1259 C<ship_location>. The address will still only change if at least one of the
1260 address fields differs from the existing values.
1262 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1263 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1264 expected and rollback the entire transaction; it is not necessary to call
1265 check_invoicing_list first. Here's an example:
1267 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1269 Currently available options are: I<tax_exemption>.
1271 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1272 of tax names and exemption numbers. FS::cust_main_exemption records will be
1273 deleted and inserted as appropriate.
1280 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1282 : $self->replace_old;
1286 warn "$me replace called\n"
1289 my $curuser = $FS::CurrentUser::CurrentUser;
1290 return "You are not permitted to create complimentary accounts."
1291 if $self->complimentary eq 'Y'
1292 && $self->complimentary ne $old->complimentary
1293 && ! $curuser->access_right('Complimentary customer');
1295 local($ignore_expired_card) = 1
1296 if $old->payby =~ /^(CARD|DCRD)$/
1297 && $self->payby =~ /^(CARD|DCRD)$/
1298 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1300 local($ignore_banned_card) = 1
1301 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1302 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1303 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1305 return "Invoicing locale is required"
1308 && $conf->exists('cust_main-require_locale');
1310 local $SIG{HUP} = 'IGNORE';
1311 local $SIG{INT} = 'IGNORE';
1312 local $SIG{QUIT} = 'IGNORE';
1313 local $SIG{TERM} = 'IGNORE';
1314 local $SIG{TSTP} = 'IGNORE';
1315 local $SIG{PIPE} = 'IGNORE';
1317 my $oldAutoCommit = $FS::UID::AutoCommit;
1318 local $FS::UID::AutoCommit = 0;
1321 for my $l (qw(bill_location ship_location)) {
1322 #my $old_loc = $old->$l;
1323 my $new_loc = $self->$l or next;
1325 # find the existing location if there is one
1326 $new_loc->set('custnum' => $self->custnum);
1327 my $error = $new_loc->find_or_insert;
1329 $dbh->rollback if $oldAutoCommit;
1332 $self->set($l.'num', $new_loc->locationnum);
1335 # replace the customer record
1336 my $error = $self->SUPER::replace($old);
1339 $dbh->rollback if $oldAutoCommit;
1343 # now move packages to the new service location
1344 $self->set('ship_location', ''); #flush cache
1345 if ( $old->ship_locationnum and # should only be null during upgrade...
1346 $old->ship_locationnum != $self->ship_locationnum ) {
1347 $error = $old->ship_location->move_to($self->ship_location);
1349 $dbh->rollback if $oldAutoCommit;
1353 # don't move packages based on the billing location, but
1354 # disable it if it's no longer in use
1355 if ( $old->bill_locationnum and
1356 $old->bill_locationnum != $self->bill_locationnum ) {
1357 $error = $old->bill_location->disable_if_unused;
1359 $dbh->rollback if $oldAutoCommit;
1364 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1365 my $invoicing_list = shift @param;
1366 $error = $self->check_invoicing_list( $invoicing_list );
1368 $dbh->rollback if $oldAutoCommit;
1371 $self->invoicing_list( $invoicing_list );
1374 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1376 #this could be more efficient than deleting and re-inserting, if it matters
1377 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1378 my $error = $cust_tag->delete;
1380 $dbh->rollback if $oldAutoCommit;
1384 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1385 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1386 'custnum' => $self->custnum };
1387 my $error = $cust_tag->insert;
1389 $dbh->rollback if $oldAutoCommit;
1396 my %options = @param;
1398 my $tax_exemption = delete $options{'tax_exemption'};
1399 if ( $tax_exemption ) {
1401 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1402 if ref($tax_exemption) eq 'ARRAY';
1404 my %cust_main_exemption =
1405 map { $_->taxname => $_ }
1406 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1408 foreach my $taxname ( keys %$tax_exemption ) {
1410 if ( $cust_main_exemption{$taxname} &&
1411 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1414 delete $cust_main_exemption{$taxname};
1418 my $cust_main_exemption = new FS::cust_main_exemption {
1419 'custnum' => $self->custnum,
1420 'taxname' => $taxname,
1421 'exempt_number' => $tax_exemption->{$taxname},
1423 my $error = $cust_main_exemption->insert;
1425 $dbh->rollback if $oldAutoCommit;
1426 return "inserting cust_main_exemption (transaction rolled back): $error";
1430 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1431 my $error = $cust_main_exemption->delete;
1433 $dbh->rollback if $oldAutoCommit;
1434 return "deleting cust_main_exemption (transaction rolled back): $error";
1440 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1442 my $error = $self->process_o2m(
1443 'table' => 'cust_payby',
1444 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1445 'params' => $cust_payby_params,
1446 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1449 $dbh->rollback if $oldAutoCommit;
1455 unless ( $import || $skip_fuzzyfiles ) {
1456 $error = $self->queue_fuzzyfiles_update;
1458 $dbh->rollback if $oldAutoCommit;
1459 return "updating fuzzy search cache: $error";
1463 # tax district update in cust_location
1465 # cust_main exports!
1467 my $export_args = $options{'export_args'} || [];
1470 map qsearch( 'part_export', {exportnum=>$_} ),
1471 $conf->config('cust_main-exports'); #, $agentnum
1473 foreach my $part_export ( @part_export ) {
1474 my $error = $part_export->export_replace( $self, $old, @$export_args);
1476 $dbh->rollback if $oldAutoCommit;
1477 return "exporting to ". $part_export->exporttype.
1478 " (transaction rolled back): $error";
1482 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1487 =item queue_fuzzyfiles_update
1489 Used by insert & replace to update the fuzzy search cache
1493 use FS::cust_main::Search;
1494 sub queue_fuzzyfiles_update {
1497 local $SIG{HUP} = 'IGNORE';
1498 local $SIG{INT} = 'IGNORE';
1499 local $SIG{QUIT} = 'IGNORE';
1500 local $SIG{TERM} = 'IGNORE';
1501 local $SIG{TSTP} = 'IGNORE';
1502 local $SIG{PIPE} = 'IGNORE';
1504 my $oldAutoCommit = $FS::UID::AutoCommit;
1505 local $FS::UID::AutoCommit = 0;
1508 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1509 my $queue = new FS::queue {
1510 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1512 my @args = "cust_main.$field", $self->get($field);
1513 my $error = $queue->insert( @args );
1515 $dbh->rollback if $oldAutoCommit;
1516 return "queueing job (transaction rolled back): $error";
1521 push @locations, $self->bill_location if $self->bill_locationnum;
1522 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1523 foreach my $location (@locations) {
1524 my $queue = new FS::queue {
1525 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1527 my @args = 'cust_location.address1', $location->address1;
1528 my $error = $queue->insert( @args );
1530 $dbh->rollback if $oldAutoCommit;
1531 return "queueing job (transaction rolled back): $error";
1535 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1542 Checks all fields to make sure this is a valid customer record. If there is
1543 an error, returns the error, otherwise returns false. Called by the insert
1544 and replace methods.
1551 warn "$me check BEFORE: \n". $self->_dump
1555 $self->ut_numbern('custnum')
1556 || $self->ut_number('agentnum')
1557 || $self->ut_textn('agent_custid')
1558 || $self->ut_number('refnum')
1559 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1560 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1561 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1562 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1563 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1564 || $self->ut_textn('custbatch')
1565 || $self->ut_name('last')
1566 || $self->ut_name('first')
1567 || $self->ut_snumbern('signupdate')
1568 || $self->ut_snumbern('birthdate')
1569 || $self->ut_namen('spouse_last')
1570 || $self->ut_namen('spouse_first')
1571 || $self->ut_snumbern('spouse_birthdate')
1572 || $self->ut_snumbern('anniversary_date')
1573 || $self->ut_textn('company')
1574 || $self->ut_textn('ship_company')
1575 || $self->ut_anything('comments')
1576 || $self->ut_numbern('referral_custnum')
1577 || $self->ut_textn('stateid')
1578 || $self->ut_textn('stateid_state')
1579 || $self->ut_textn('invoice_terms')
1580 || $self->ut_floatn('cdr_termination_percentage')
1581 || $self->ut_floatn('credit_limit')
1582 || $self->ut_numbern('billday')
1583 || $self->ut_numbern('prorate_day')
1584 || $self->ut_flag('edit_subject')
1585 || $self->ut_flag('calling_list_exempt')
1586 || $self->ut_flag('invoice_noemail')
1587 || $self->ut_flag('message_noemail')
1588 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1589 || $self->ut_currencyn('currency')
1590 || $self->ut_alphan('po_number')
1591 || $self->ut_enum('complimentary', [ '', 'Y' ])
1594 foreach (qw(company ship_company)) {
1595 my $company = $self->get($_);
1596 $company =~ s/^\s+//;
1597 $company =~ s/\s+$//;
1598 $company =~ s/\s+/ /g;
1599 $self->set($_, $company);
1602 #barf. need message catalogs. i18n. etc.
1603 $error .= "Please select an advertising source."
1604 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1605 return $error if $error;
1607 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1608 or return "Unknown agent";
1610 if ( $self->currency ) {
1611 my $agent_currency = qsearchs( 'agent_currency', {
1612 'agentnum' => $agent->agentnum,
1613 'currency' => $self->currency,
1615 or return "Agent ". $agent->agent.
1616 " not permitted to offer ". $self->currency. " invoicing";
1619 return "Unknown refnum"
1620 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1622 return "Unknown referring custnum: ". $self->referral_custnum
1623 unless ! $self->referral_custnum
1624 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1626 if ( $self->ss eq '' ) {
1631 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1632 or return "Illegal social security number: ". $self->ss;
1633 $self->ss("$1-$2-$3");
1636 # cust_main_county verification now handled by cust_location check
1639 $self->ut_phonen('daytime', $self->country)
1640 || $self->ut_phonen('night', $self->country)
1641 || $self->ut_phonen('fax', $self->country)
1642 || $self->ut_phonen('mobile', $self->country)
1644 return $error if $error;
1646 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1648 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1651 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1653 : FS::Msgcat::_gettext('daytime');
1654 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1656 : FS::Msgcat::_gettext('night');
1658 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1660 : FS::Msgcat::_gettext('mobile');
1662 return "$daytime_label, $night_label or $mobile_label is required"
1666 ### start of stuff moved to cust_payby
1667 # then mostly kept here to support upgrades (can remove in 5.x)
1668 # but modified to allow everything to be empty
1670 if ( $self->payby ) {
1671 FS::payby->can_payby($self->table, $self->payby)
1672 or return "Illegal payby: ". $self->payby;
1677 $error = $self->ut_numbern('paystart_month')
1678 || $self->ut_numbern('paystart_year')
1679 || $self->ut_numbern('payissue')
1680 || $self->ut_textn('paytype')
1682 return $error if $error;
1684 if ( $self->payip eq '' ) {
1687 $error = $self->ut_ip('payip');
1688 return $error if $error;
1691 # If it is encrypted and the private key is not availaible then we can't
1692 # check the credit card.
1693 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1695 # Need some kind of global flag to accept invalid cards, for testing
1697 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1698 $self->payby =~ /^(CARD|DCRD)$/ ) {
1700 my $payinfo = $self->payinfo;
1701 $payinfo =~ s/\D//g;
1702 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1703 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1705 $self->payinfo($payinfo);
1707 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1709 return gettext('unknown_card_type')
1710 if $self->payinfo !~ /^99\d{14}$/ #token
1711 && cardtype($self->payinfo) eq "Unknown";
1713 unless ( $ignore_banned_card ) {
1714 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1716 if ( $ban->bantype eq 'warn' ) {
1717 #or others depending on value of $ban->reason ?
1718 return '_duplicate_card'.
1719 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1720 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1721 ' (ban# '. $ban->bannum. ')'
1722 unless $self->override_ban_warn;
1724 return 'Banned credit card: banned on '.
1725 time2str('%a %h %o at %r', $ban->_date).
1726 ' by '. $ban->otaker.
1727 ' (ban# '. $ban->bannum. ')';
1732 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1733 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1734 $self->paycvv =~ /^(\d{4})$/
1735 or return "CVV2 (CID) for American Express cards is four digits.";
1738 $self->paycvv =~ /^(\d{3})$/
1739 or return "CVV2 (CVC2/CID) is three digits.";
1746 my $cardtype = cardtype($payinfo);
1747 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1749 return "Start date or issue number is required for $cardtype cards"
1750 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1752 return "Start month must be between 1 and 12"
1753 if $self->paystart_month
1754 and $self->paystart_month < 1 || $self->paystart_month > 12;
1756 return "Start year must be 1990 or later"
1757 if $self->paystart_year
1758 and $self->paystart_year < 1990;
1760 return "Issue number must be beween 1 and 99"
1762 and $self->payissue < 1 || $self->payissue > 99;
1765 $self->paystart_month('');
1766 $self->paystart_year('');
1767 $self->payissue('');
1770 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1771 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1773 my $payinfo = $self->payinfo;
1774 $payinfo =~ s/[^\d\@\.]//g;
1775 if ( $conf->config('echeck-country') eq 'CA' ) {
1776 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1777 or return 'invalid echeck account@branch.bank';
1778 $payinfo = "$1\@$2.$3";
1779 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1780 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1781 $payinfo = "$1\@$2";
1783 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1784 $payinfo = "$1\@$2";
1786 $self->payinfo($payinfo);
1789 unless ( $ignore_banned_card ) {
1790 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1792 if ( $ban->bantype eq 'warn' ) {
1793 #or others depending on value of $ban->reason ?
1794 return '_duplicate_ach' unless $self->override_ban_warn;
1796 return 'Banned ACH account: banned on '.
1797 time2str('%a %h %o at %r', $ban->_date).
1798 ' by '. $ban->otaker.
1799 ' (ban# '. $ban->bannum. ')';
1804 } elsif ( $self->payby eq 'LECB' ) {
1806 my $payinfo = $self->payinfo;
1807 $payinfo =~ s/\D//g;
1808 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1810 $self->payinfo($payinfo);
1813 } elsif ( $self->payby eq 'BILL' ) {
1815 $error = $self->ut_textn('payinfo');
1816 return "Illegal P.O. number: ". $self->payinfo if $error;
1819 } elsif ( $self->payby eq 'COMP' ) {
1821 my $curuser = $FS::CurrentUser::CurrentUser;
1822 if ( ! $self->custnum
1823 && ! $curuser->access_right('Complimentary customer')
1826 return "You are not permitted to create complimentary accounts."
1829 $error = $self->ut_textn('payinfo');
1830 return "Illegal comp account issuer: ". $self->payinfo if $error;
1833 } elsif ( $self->payby eq 'PREPAY' ) {
1835 my $payinfo = $self->payinfo;
1836 $payinfo =~ s/\W//g; #anything else would just confuse things
1837 $self->payinfo($payinfo);
1838 $error = $self->ut_alpha('payinfo');
1839 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1840 return "Unknown prepayment identifier"
1841 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1846 return "You are not permitted to create complimentary accounts."
1848 && $self->complimentary eq 'Y'
1849 && ! $FS::CurrentUser->CurrentUser->access_right('Complimentary customer');
1851 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1852 return "Expiration date required"
1853 # shouldn't payinfo_check do this?
1854 unless ! $self->payby
1855 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1859 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1860 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1861 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1862 ( $m, $y ) = ( $2, "19$1" );
1863 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1864 ( $m, $y ) = ( $3, "20$2" );
1866 return "Illegal expiration date: ". $self->paydate;
1868 $m = sprintf('%02d',$m);
1869 $self->paydate("$y-$m-01");
1870 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1871 return gettext('expired_card')
1873 && !$ignore_expired_card
1874 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1877 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1878 ( ! $conf->exists('require_cardname')
1879 || $self->payby !~ /^(CARD|DCRD)$/ )
1881 $self->payname( $self->first. " ". $self->getfield('last') );
1884 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
1885 $self->payname =~ /^([\w \,\.\-\']*)$/
1886 or return gettext('illegal_name'). " payname: ". $self->payname;
1889 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
1890 or return gettext('illegal_name'). " payname: ". $self->payname;
1896 ### end of stuff moved to cust_payby
1898 return "Please select an invoicing locale"
1901 && $conf->exists('cust_main-require_locale');
1903 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1904 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1908 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1910 warn "$me check AFTER: \n". $self->_dump
1913 $self->SUPER::check;
1918 Returns a list of fields which have ship_ duplicates.
1923 qw( last first company
1925 address1 address2 city county state zip country
1927 daytime night fax mobile
1931 =item has_ship_address
1933 Returns true if this customer record has a separate shipping address.
1937 sub has_ship_address {
1939 $self->bill_locationnum != $self->ship_locationnum;
1944 Returns a list of key/value pairs, with the following keys: address1,
1945 adddress2, city, county, state, zip, country, district, and geocode. The
1946 shipping address is used if present.
1952 $self->ship_location->location_hash;
1957 Returns all locations (see L<FS::cust_location>) for this customer.
1963 qsearch('cust_location', { 'custnum' => $self->custnum,
1964 'prospectnum' => '' } );
1969 Returns all contact associations (see L<FS::cust_contact>) for this customer.
1975 qsearch('cust_contact', { 'custnum' => $self->custnum } );
1980 Returns all payment methods (see L<FS::cust_payby>) for this customer.
1987 'table' => 'cust_payby',
1988 'hashref' => { 'custnum' => $self->custnum },
1989 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
1995 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1996 and L<FS::cust_pkg>) for this customer, except those on hold.
1998 Returns a list: an empty list on success or a list of errors.
2004 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2009 Unsuspends all suspended packages in the on-hold state (those without setup
2010 dates) for this customer.
2016 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2021 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2023 Returns a list: an empty list on success or a list of errors.
2029 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2032 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2034 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2035 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2036 of a list of pkgparts; the hashref has the following keys:
2040 =item pkgparts - listref of pkgparts
2042 =item (other options are passed to the suspend method)
2047 Returns a list: an empty list on success or a list of errors.
2051 sub suspend_if_pkgpart {
2053 my (@pkgparts, %opt);
2054 if (ref($_[0]) eq 'HASH'){
2055 @pkgparts = @{$_[0]{pkgparts}};
2060 grep { $_->suspend(%opt) }
2061 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2062 $self->unsuspended_pkgs;
2065 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2067 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2068 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2069 instead of a list of pkgparts; the hashref has the following keys:
2073 =item pkgparts - listref of pkgparts
2075 =item (other options are passed to the suspend method)
2079 Returns a list: an empty list on success or a list of errors.
2083 sub suspend_unless_pkgpart {
2085 my (@pkgparts, %opt);
2086 if (ref($_[0]) eq 'HASH'){
2087 @pkgparts = @{$_[0]{pkgparts}};
2092 grep { $_->suspend(%opt) }
2093 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2094 $self->unsuspended_pkgs;
2097 =item cancel [ OPTION => VALUE ... ]
2099 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2101 Available options are:
2105 =item quiet - can be set true to supress email cancellation notices.
2107 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2109 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2111 =item nobill - can be set true to skip billing if it might otherwise be done.
2115 Always returns a list: an empty list on success or a list of errors.
2119 # nb that dates are not specified as valid options to this method
2122 my( $self, %opt ) = @_;
2124 warn "$me cancel called on customer ". $self->custnum. " with options ".
2125 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2128 return ( 'access denied' )
2129 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2131 if ( $opt{'ban'} ) {
2133 foreach my $cust_payby ( $self->cust_payby ) {
2135 #well, if they didn't get decrypted on search, then we don't have to
2136 # try again... queue a job for the server that does have decryption
2137 # capability if we're in a paranoid multi-server implementation?
2138 return ( "Can't (yet) ban encrypted credit cards" )
2139 if $cust_payby->is_encrypted($cust_payby->payinfo);
2141 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2142 my $error = $ban->insert;
2143 return ( $error ) if $error;
2149 my @pkgs = $self->ncancelled_pkgs;
2151 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2153 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2154 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2158 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2159 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2162 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2165 sub _banned_pay_hashref {
2176 'payby' => $payby2ban{$self->payby},
2177 'payinfo' => $self->payinfo,
2178 #don't ever *search* on reason! #'reason' =>
2184 Returns all notes (see L<FS::cust_main_note>) for this customer.
2189 my($self,$orderby_classnum) = (shift,shift);
2190 my $orderby = "sticky DESC, _date DESC";
2191 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2192 qsearch( 'cust_main_note',
2193 { 'custnum' => $self->custnum },
2195 "ORDER BY $orderby",
2201 Returns the agent (see L<FS::agent>) for this customer.
2205 Returns the agent name (see L<FS::agent>) for this customer.
2211 $self->agent->agent;
2216 Returns any tags associated with this customer, as FS::cust_tag objects,
2217 or an empty list if there are no tags.
2221 Returns any tags associated with this customer, as FS::part_tag objects,
2222 or an empty list if there are no tags.
2228 map $_->part_tag, $self->cust_tag;
2234 Returns the customer class, as an FS::cust_class object, or the empty string
2235 if there is no customer class.
2239 Returns the customer category name, or the empty string if there is no customer
2246 my $cust_class = $self->cust_class;
2248 ? $cust_class->categoryname
2254 Returns the customer class name, or the empty string if there is no customer
2261 my $cust_class = $self->cust_class;
2263 ? $cust_class->classname
2269 Returns the external tax status, as an FS::tax_status object, or the empty
2270 string if there is no tax status.
2276 if ( $self->taxstatusnum ) {
2277 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2285 Returns the tax status code if there is one.
2291 my $tax_status = $self->tax_status;
2293 ? $tax_status->taxstatus
2297 =item BILLING METHODS
2299 Documentation on billing methods has been moved to
2300 L<FS::cust_main::Billing>.
2302 =item REALTIME BILLING METHODS
2304 Documentation on realtime billing methods has been moved to
2305 L<FS::cust_main::Billing_Realtime>.
2309 Removes the I<paycvv> field from the database directly.
2311 If there is an error, returns the error, otherwise returns false.
2317 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2318 or return dbh->errstr;
2319 $sth->execute($self->custnum)
2320 or return $sth->errstr;
2327 Returns the total owed for this customer on all invoices
2328 (see L<FS::cust_bill/owed>).
2334 $self->total_owed_date(2145859200); #12/31/2037
2337 =item total_owed_date TIME
2339 Returns the total owed for this customer on all invoices with date earlier than
2340 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2341 see L<Time::Local> and L<Date::Parse> for conversion functions.
2345 sub total_owed_date {
2349 my $custnum = $self->custnum;
2351 my $owed_sql = FS::cust_bill->owed_sql;
2354 SELECT SUM($owed_sql) FROM cust_bill
2355 WHERE custnum = $custnum
2359 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2363 =item total_owed_pkgnum PKGNUM
2365 Returns the total owed on all invoices for this customer's specific package
2366 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2370 sub total_owed_pkgnum {
2371 my( $self, $pkgnum ) = @_;
2372 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2375 =item total_owed_date_pkgnum TIME PKGNUM
2377 Returns the total owed for this customer's specific package when using
2378 experimental package balances on all invoices with date earlier than
2379 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2380 see L<Time::Local> and L<Date::Parse> for conversion functions.
2384 sub total_owed_date_pkgnum {
2385 my( $self, $time, $pkgnum ) = @_;
2388 foreach my $cust_bill (
2389 grep { $_->_date <= $time }
2390 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2392 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2394 sprintf( "%.2f", $total_bill );
2400 Returns the total amount of all payments.
2407 $total += $_->paid foreach $self->cust_pay;
2408 sprintf( "%.2f", $total );
2411 =item total_unapplied_credits
2413 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2414 customer. See L<FS::cust_credit/credited>.
2416 =item total_credited
2418 Old name for total_unapplied_credits. Don't use.
2422 sub total_credited {
2423 #carp "total_credited deprecated, use total_unapplied_credits";
2424 shift->total_unapplied_credits(@_);
2427 sub total_unapplied_credits {
2430 my $custnum = $self->custnum;
2432 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2435 SELECT SUM($unapplied_sql) FROM cust_credit
2436 WHERE custnum = $custnum
2439 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2443 =item total_unapplied_credits_pkgnum PKGNUM
2445 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2446 customer. See L<FS::cust_credit/credited>.
2450 sub total_unapplied_credits_pkgnum {
2451 my( $self, $pkgnum ) = @_;
2452 my $total_credit = 0;
2453 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2454 sprintf( "%.2f", $total_credit );
2458 =item total_unapplied_payments
2460 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2461 See L<FS::cust_pay/unapplied>.
2465 sub total_unapplied_payments {
2468 my $custnum = $self->custnum;
2470 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2473 SELECT SUM($unapplied_sql) FROM cust_pay
2474 WHERE custnum = $custnum
2477 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2481 =item total_unapplied_payments_pkgnum PKGNUM
2483 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2484 specific package when using experimental package balances. See
2485 L<FS::cust_pay/unapplied>.
2489 sub total_unapplied_payments_pkgnum {
2490 my( $self, $pkgnum ) = @_;
2491 my $total_unapplied = 0;
2492 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2493 sprintf( "%.2f", $total_unapplied );
2497 =item total_unapplied_refunds
2499 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2500 customer. See L<FS::cust_refund/unapplied>.
2504 sub total_unapplied_refunds {
2506 my $custnum = $self->custnum;
2508 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2511 SELECT SUM($unapplied_sql) FROM cust_refund
2512 WHERE custnum = $custnum
2515 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2521 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2522 total_unapplied_credits minus total_unapplied_payments).
2528 $self->balance_date_range;
2531 =item balance_date TIME
2533 Returns the balance for this customer, only considering invoices with date
2534 earlier than TIME (total_owed_date minus total_credited minus
2535 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2536 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2543 $self->balance_date_range(shift);
2546 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2548 Returns the balance for this customer, optionally considering invoices with
2549 date earlier than START_TIME, and not later than END_TIME
2550 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2552 Times are specified as SQL fragments or numeric
2553 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2554 L<Date::Parse> for conversion functions. The empty string can be passed
2555 to disable that time constraint completely.
2557 Accepts the same options as L<balance_date_sql>:
2561 =item unapplied_date
2563 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)
2567 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2568 time will be ignored. Note that START_TIME and END_TIME only limit the date
2569 range for invoices and I<unapplied> payments, credits, and refunds.
2575 sub balance_date_range {
2577 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2578 ') FROM cust_main WHERE custnum='. $self->custnum;
2579 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2582 =item balance_pkgnum PKGNUM
2584 Returns the balance for this customer's specific package when using
2585 experimental package balances (total_owed plus total_unrefunded, minus
2586 total_unapplied_credits minus total_unapplied_payments)
2590 sub balance_pkgnum {
2591 my( $self, $pkgnum ) = @_;
2594 $self->total_owed_pkgnum($pkgnum)
2595 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2596 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2597 - $self->total_unapplied_credits_pkgnum($pkgnum)
2598 - $self->total_unapplied_payments_pkgnum($pkgnum)
2604 Returns a hash of useful information for making a payment.
2614 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2615 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2616 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2620 For credit card transactions:
2632 For electronic check transactions:
2647 $return{balance} = $self->balance;
2649 $return{payname} = $self->payname
2650 || ( $self->first. ' '. $self->get('last') );
2652 $return{$_} = $self->bill_location->$_
2653 for qw(address1 address2 city state zip);
2655 $return{payby} = $self->payby;
2656 $return{stateid_state} = $self->stateid_state;
2658 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2659 $return{card_type} = cardtype($self->payinfo);
2660 $return{payinfo} = $self->paymask;
2662 @return{'month', 'year'} = $self->paydate_monthyear;
2666 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2667 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2668 $return{payinfo1} = $payinfo1;
2669 $return{payinfo2} = $payinfo2;
2670 $return{paytype} = $self->paytype;
2671 $return{paystate} = $self->paystate;
2675 #doubleclick protection
2677 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2683 =item paydate_monthyear
2685 Returns a two-element list consisting of the month and year of this customer's
2686 paydate (credit card expiration date for CARD customers)
2690 sub paydate_monthyear {
2692 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2694 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2703 Returns the exact time in seconds corresponding to the payment method
2704 expiration date. For CARD/DCRD customers this is the end of the month;
2705 for others (COMP is the only other payby that uses paydate) it's the start.
2706 Returns 0 if the paydate is empty or set to the far future.
2712 my ($month, $year) = $self->paydate_monthyear;
2713 return 0 if !$year or $year >= 2037;
2714 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2716 if ( $month == 13 ) {
2720 return timelocal(0,0,0,1,$month-1,$year) - 1;
2723 return timelocal(0,0,0,1,$month-1,$year);
2727 =item paydate_epoch_sql
2729 Class method. Returns an SQL expression to obtain the payment expiration date
2730 as a number of seconds.
2734 # Special expiration date behavior for non-CARD/DCRD customers has been
2735 # carefully preserved. Do we really use that?
2736 sub paydate_epoch_sql {
2738 my $table = shift || 'cust_main';
2739 my ($case1, $case2);
2740 if ( driver_name eq 'Pg' ) {
2741 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2742 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2744 elsif ( lc(driver_name) eq 'mysql' ) {
2745 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2746 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2749 return "CASE WHEN $table.payby IN('CARD','DCRD')
2755 =item tax_exemption TAXNAME
2760 my( $self, $taxname ) = @_;
2762 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2763 'taxname' => $taxname,
2768 =item cust_main_exemption
2770 =item invoicing_list [ ARRAYREF ]
2772 If an arguement is given, sets these email addresses as invoice recipients
2773 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2774 (except as warnings), so use check_invoicing_list first.
2776 Returns a list of email addresses (with svcnum entries expanded).
2778 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2779 check it without disturbing anything by passing nothing.
2781 This interface may change in the future.
2785 sub invoicing_list {
2786 my( $self, $arrayref ) = @_;
2789 my @cust_main_invoice;
2790 if ( $self->custnum ) {
2791 @cust_main_invoice =
2792 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2794 @cust_main_invoice = ();
2796 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2797 #warn $cust_main_invoice->destnum;
2798 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2799 #warn $cust_main_invoice->destnum;
2800 my $error = $cust_main_invoice->delete;
2801 warn $error if $error;
2804 if ( $self->custnum ) {
2805 @cust_main_invoice =
2806 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2808 @cust_main_invoice = ();
2810 my %seen = map { $_->address => 1 } @cust_main_invoice;
2811 foreach my $address ( @{$arrayref} ) {
2812 next if exists $seen{$address} && $seen{$address};
2813 $seen{$address} = 1;
2814 my $cust_main_invoice = new FS::cust_main_invoice ( {
2815 'custnum' => $self->custnum,
2818 my $error = $cust_main_invoice->insert;
2819 warn $error if $error;
2823 if ( $self->custnum ) {
2825 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2832 =item check_invoicing_list ARRAYREF
2834 Checks these arguements as valid input for the invoicing_list method. If there
2835 is an error, returns the error, otherwise returns false.
2839 sub check_invoicing_list {
2840 my( $self, $arrayref ) = @_;
2842 foreach my $address ( @$arrayref ) {
2844 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2845 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2848 my $cust_main_invoice = new FS::cust_main_invoice ( {
2849 'custnum' => $self->custnum,
2852 my $error = $self->custnum
2853 ? $cust_main_invoice->check
2854 : $cust_main_invoice->checkdest
2856 return $error if $error;
2860 return "Email address required"
2861 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2862 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2867 =item set_default_invoicing_list
2869 Sets the invoicing list to all accounts associated with this customer,
2870 overwriting any previous invoicing list.
2874 sub set_default_invoicing_list {
2876 $self->invoicing_list($self->all_emails);
2881 Returns the email addresses of all accounts provisioned for this customer.
2888 foreach my $cust_pkg ( $self->all_pkgs ) {
2889 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2891 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2892 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2894 $list{$_}=1 foreach map { $_->email } @svc_acct;
2899 =item invoicing_list_addpost
2901 Adds postal invoicing to this customer. If this customer is already configured
2902 to receive postal invoices, does nothing.
2906 sub invoicing_list_addpost {
2908 return if grep { $_ eq 'POST' } $self->invoicing_list;
2909 my @invoicing_list = $self->invoicing_list;
2910 push @invoicing_list, 'POST';
2911 $self->invoicing_list(\@invoicing_list);
2914 =item invoicing_list_emailonly
2916 Returns the list of email invoice recipients (invoicing_list without non-email
2917 destinations such as POST and FAX).
2921 sub invoicing_list_emailonly {
2923 warn "$me invoicing_list_emailonly called"
2925 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2928 =item invoicing_list_emailonly_scalar
2930 Returns the list of email invoice recipients (invoicing_list without non-email
2931 destinations such as POST and FAX) as a comma-separated scalar.
2935 sub invoicing_list_emailonly_scalar {
2937 warn "$me invoicing_list_emailonly_scalar called"
2939 join(', ', $self->invoicing_list_emailonly);
2942 =item referral_custnum_cust_main
2944 Returns the customer who referred this customer (or the empty string, if
2945 this customer was not referred).
2947 Note the difference with referral_cust_main method: This method,
2948 referral_custnum_cust_main returns the single customer (if any) who referred
2949 this customer, while referral_cust_main returns an array of customers referred
2954 sub referral_custnum_cust_main {
2956 return '' unless $self->referral_custnum;
2957 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2960 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2962 Returns an array of customers referred by this customer (referral_custnum set
2963 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2964 customers referred by customers referred by this customer and so on, inclusive.
2965 The default behavior is DEPTH 1 (no recursion).
2967 Note the difference with referral_custnum_cust_main method: This method,
2968 referral_cust_main, returns an array of customers referred BY this customer,
2969 while referral_custnum_cust_main returns the single customer (if any) who
2970 referred this customer.
2974 sub referral_cust_main {
2976 my $depth = @_ ? shift : 1;
2977 my $exclude = @_ ? shift : {};
2980 map { $exclude->{$_->custnum}++; $_; }
2981 grep { ! $exclude->{ $_->custnum } }
2982 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2986 map { $_->referral_cust_main($depth-1, $exclude) }
2993 =item referral_cust_main_ncancelled
2995 Same as referral_cust_main, except only returns customers with uncancelled
3000 sub referral_cust_main_ncancelled {
3002 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3005 =item referral_cust_pkg [ DEPTH ]
3007 Like referral_cust_main, except returns a flat list of all unsuspended (and
3008 uncancelled) packages for each customer. The number of items in this list may
3009 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3013 sub referral_cust_pkg {
3015 my $depth = @_ ? shift : 1;
3017 map { $_->unsuspended_pkgs }
3018 grep { $_->unsuspended_pkgs }
3019 $self->referral_cust_main($depth);
3022 =item referring_cust_main
3024 Returns the single cust_main record for the customer who referred this customer
3025 (referral_custnum), or false.
3029 sub referring_cust_main {
3031 return '' unless $self->referral_custnum;
3032 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3035 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3037 Applies a credit to this customer. If there is an error, returns the error,
3038 otherwise returns false.
3040 REASON can be a text string, an FS::reason object, or a scalar reference to
3041 a reasonnum. If a text string, it will be automatically inserted as a new
3042 reason, and a 'reason_type' option must be passed to indicate the
3043 FS::reason_type for the new reason.
3045 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3046 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3047 I<commission_pkgnum>.
3049 Any other options are passed to FS::cust_credit::insert.
3054 my( $self, $amount, $reason, %options ) = @_;
3056 my $cust_credit = new FS::cust_credit {
3057 'custnum' => $self->custnum,
3058 'amount' => $amount,
3061 if ( ref($reason) ) {
3063 if ( ref($reason) eq 'SCALAR' ) {
3064 $cust_credit->reasonnum( $$reason );
3066 $cust_credit->reasonnum( $reason->reasonnum );
3070 $cust_credit->set('reason', $reason)
3073 $cust_credit->$_( delete $options{$_} )
3074 foreach grep exists($options{$_}),
3075 qw( addlinfo eventnum ),
3076 map "commission_$_", qw( agentnum salesnum pkgnum );
3078 $cust_credit->insert(%options);
3082 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3084 Creates a one-time charge for this customer. If there is an error, returns
3085 the error, otherwise returns false.
3087 New-style, with a hashref of options:
3089 my $error = $cust_main->charge(
3093 'start_date' => str2time('7/4/2009'),
3094 'pkg' => 'Description',
3095 'comment' => 'Comment',
3096 'additional' => [], #extra invoice detail
3097 'classnum' => 1, #pkg_class
3099 'setuptax' => '', # or 'Y' for tax exempt
3101 'locationnum'=> 1234, # optional
3104 'taxclass' => 'Tax class',
3107 'taxproduct' => 2, #part_pkg_taxproduct
3108 'override' => {}, #XXX describe
3110 #will be filled in with the new object
3111 'cust_pkg_ref' => \$cust_pkg,
3113 #generate an invoice immediately
3115 'invoice_terms' => '', #with these terms
3121 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3125 #super false laziness w/quotation::charge
3128 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3129 my ( $pkg, $comment, $additional );
3130 my ( $setuptax, $taxclass ); #internal taxes
3131 my ( $taxproduct, $override ); #vendor (CCH) taxes
3133 my $separate_bill = '';
3134 my $cust_pkg_ref = '';
3135 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3137 if ( ref( $_[0] ) ) {
3138 $amount = $_[0]->{amount};
3139 $setup_cost = $_[0]->{setup_cost};
3140 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3141 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3142 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3143 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3144 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3145 : '$'. sprintf("%.2f",$amount);
3146 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3147 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3148 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3149 $additional = $_[0]->{additional} || [];
3150 $taxproduct = $_[0]->{taxproductnum};
3151 $override = { '' => $_[0]->{tax_override} };
3152 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3153 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3154 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3155 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3156 $separate_bill = $_[0]->{separate_bill} || '';
3162 $pkg = @_ ? shift : 'One-time charge';
3163 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3165 $taxclass = @_ ? shift : '';
3169 local $SIG{HUP} = 'IGNORE';
3170 local $SIG{INT} = 'IGNORE';
3171 local $SIG{QUIT} = 'IGNORE';
3172 local $SIG{TERM} = 'IGNORE';
3173 local $SIG{TSTP} = 'IGNORE';
3174 local $SIG{PIPE} = 'IGNORE';
3176 my $oldAutoCommit = $FS::UID::AutoCommit;
3177 local $FS::UID::AutoCommit = 0;
3180 my $part_pkg = new FS::part_pkg ( {
3182 'comment' => $comment,
3186 'classnum' => ( $classnum ? $classnum : '' ),
3187 'setuptax' => $setuptax,
3188 'taxclass' => $taxclass,
3189 'taxproductnum' => $taxproduct,
3190 'setup_cost' => $setup_cost,
3193 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3194 ( 0 .. @$additional - 1 )
3196 'additional_count' => scalar(@$additional),
3197 'setup_fee' => $amount,
3200 my $error = $part_pkg->insert( options => \%options,
3201 tax_overrides => $override,
3204 $dbh->rollback if $oldAutoCommit;
3208 my $pkgpart = $part_pkg->pkgpart;
3209 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3210 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3211 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3212 $error = $type_pkgs->insert;
3214 $dbh->rollback if $oldAutoCommit;
3219 my $cust_pkg = new FS::cust_pkg ( {
3220 'custnum' => $self->custnum,
3221 'pkgpart' => $pkgpart,
3222 'quantity' => $quantity,
3223 'start_date' => $start_date,
3224 'no_auto' => $no_auto,
3225 'separate_bill' => $separate_bill,
3226 'locationnum'=> $locationnum,
3229 $error = $cust_pkg->insert;
3231 $dbh->rollback if $oldAutoCommit;
3233 } elsif ( $cust_pkg_ref ) {
3234 ${$cust_pkg_ref} = $cust_pkg;
3238 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3239 'pkg_list' => [ $cust_pkg ],
3242 $dbh->rollback if $oldAutoCommit;
3247 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3252 #=item charge_postal_fee
3254 #Applies a one time charge this customer. If there is an error,
3255 #returns the error, returns the cust_pkg charge object or false
3256 #if there was no charge.
3260 # This should be a customer event. For that to work requires that bill
3261 # also be a customer event.
3263 sub charge_postal_fee {
3266 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3267 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3269 my $cust_pkg = new FS::cust_pkg ( {
3270 'custnum' => $self->custnum,
3271 'pkgpart' => $pkgpart,
3275 my $error = $cust_pkg->insert;
3276 $error ? $error : $cust_pkg;
3279 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3281 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3283 Optionally, a list or hashref of additional arguments to the qsearch call can
3290 my $opt = ref($_[0]) ? shift : { @_ };
3292 #return $self->num_cust_bill unless wantarray || keys %$opt;
3294 $opt->{'table'} = 'cust_bill';
3295 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3296 $opt->{'hashref'}{'custnum'} = $self->custnum;
3297 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3299 map { $_ } #behavior of sort undefined in scalar context
3300 sort { $a->_date <=> $b->_date }
3304 =item open_cust_bill
3306 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3311 sub open_cust_bill {
3315 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3321 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3323 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3327 sub legacy_cust_bill {
3330 #return $self->num_legacy_cust_bill unless wantarray;
3332 map { $_ } #behavior of sort undefined in scalar context
3333 sort { $a->_date <=> $b->_date }
3334 qsearch({ 'table' => 'legacy_cust_bill',
3335 'hashref' => { 'custnum' => $self->custnum, },
3336 'order_by' => 'ORDER BY _date ASC',
3340 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3342 Returns all the statements (see L<FS::cust_statement>) for this customer.
3344 Optionally, a list or hashref of additional arguments to the qsearch call can
3349 =item cust_bill_void
3351 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3355 sub cust_bill_void {
3358 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3359 sort { $a->_date <=> $b->_date }
3360 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3363 sub cust_statement {
3365 my $opt = ref($_[0]) ? shift : { @_ };
3367 #return $self->num_cust_statement unless wantarray || keys %$opt;
3369 $opt->{'table'} = 'cust_statement';
3370 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3371 $opt->{'hashref'}{'custnum'} = $self->custnum;
3372 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3374 map { $_ } #behavior of sort undefined in scalar context
3375 sort { $a->_date <=> $b->_date }
3379 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3381 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3383 Optionally, a list or hashref of additional arguments to the qsearch call can
3384 be passed following the SVCDB.
3391 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3392 warn "$me svc_x requires a svcdb";
3395 my $opt = ref($_[0]) ? shift : { @_ };
3397 $opt->{'table'} = $svcdb;
3398 $opt->{'addl_from'} =
3399 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3400 ($opt->{'addl_from'} || '');
3402 my $custnum = $self->custnum;
3403 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3404 my $where = "cust_pkg.custnum = $custnum";
3406 my $extra_sql = $opt->{'extra_sql'} || '';
3407 if ( keys %{ $opt->{'hashref'} } ) {
3408 $extra_sql = " AND $where $extra_sql";
3411 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3412 $extra_sql = "WHERE $where AND $1";
3415 $extra_sql = "WHERE $where $extra_sql";
3418 $opt->{'extra_sql'} = $extra_sql;
3423 # required for use as an eventtable;
3426 $self->svc_x('svc_acct', @_);
3431 Returns all the credits (see L<FS::cust_credit>) for this customer.
3437 map { $_ } #return $self->num_cust_credit unless wantarray;
3438 sort { $a->_date <=> $b->_date }
3439 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3442 =item cust_credit_pkgnum
3444 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3445 package when using experimental package balances.
3449 sub cust_credit_pkgnum {
3450 my( $self, $pkgnum ) = @_;
3451 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3452 sort { $a->_date <=> $b->_date }
3453 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3454 'pkgnum' => $pkgnum,
3459 =item cust_credit_void
3461 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3465 sub cust_credit_void {
3468 sort { $a->_date <=> $b->_date }
3469 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3474 Returns all the payments (see L<FS::cust_pay>) for this customer.
3480 my $opt = ref($_[0]) ? shift : { @_ };
3482 return $self->num_cust_pay unless wantarray || keys %$opt;
3484 $opt->{'table'} = 'cust_pay';
3485 $opt->{'hashref'}{'custnum'} = $self->custnum;
3487 map { $_ } #behavior of sort undefined in scalar context
3488 sort { $a->_date <=> $b->_date }
3495 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3496 called automatically when the cust_pay method is used in a scalar context.
3502 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3503 my $sth = dbh->prepare($sql) or die dbh->errstr;
3504 $sth->execute($self->custnum) or die $sth->errstr;
3505 $sth->fetchrow_arrayref->[0];
3508 =item unapplied_cust_pay
3510 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3514 sub unapplied_cust_pay {
3518 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3524 =item cust_pay_pkgnum
3526 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3527 package when using experimental package balances.
3531 sub cust_pay_pkgnum {
3532 my( $self, $pkgnum ) = @_;
3533 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3534 sort { $a->_date <=> $b->_date }
3535 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3536 'pkgnum' => $pkgnum,
3543 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3549 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3550 sort { $a->_date <=> $b->_date }
3551 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3554 =item cust_pay_pending
3556 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3557 (without status "done").
3561 sub cust_pay_pending {
3563 return $self->num_cust_pay_pending unless wantarray;
3564 sort { $a->_date <=> $b->_date }
3565 qsearch( 'cust_pay_pending', {
3566 'custnum' => $self->custnum,
3567 'status' => { op=>'!=', value=>'done' },
3572 =item cust_pay_pending_attempt
3574 Returns all payment attempts / declined payments for this customer, as pending
3575 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3576 a corresponding payment (see L<FS::cust_pay>).
3580 sub cust_pay_pending_attempt {
3582 return $self->num_cust_pay_pending_attempt unless wantarray;
3583 sort { $a->_date <=> $b->_date }
3584 qsearch( 'cust_pay_pending', {
3585 'custnum' => $self->custnum,
3592 =item num_cust_pay_pending
3594 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3595 customer (without status "done"). Also called automatically when the
3596 cust_pay_pending method is used in a scalar context.
3600 sub num_cust_pay_pending {
3603 " SELECT COUNT(*) FROM cust_pay_pending ".
3604 " WHERE custnum = ? AND status != 'done' ",
3609 =item num_cust_pay_pending_attempt
3611 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3612 customer, with status "done" but without a corresp. Also called automatically when the
3613 cust_pay_pending method is used in a scalar context.
3617 sub num_cust_pay_pending_attempt {
3620 " SELECT COUNT(*) FROM cust_pay_pending ".
3621 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3628 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3634 map { $_ } #return $self->num_cust_refund unless wantarray;
3635 sort { $a->_date <=> $b->_date }
3636 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3639 =item display_custnum
3641 Returns the displayed customer number for this customer: agent_custid if
3642 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3646 sub display_custnum {
3649 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3650 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3651 if ( $special eq 'CoStAg' ) {
3652 $prefix = uc( join('',
3654 ($self->state =~ /^(..)/),
3655 $prefix || ($self->agent->agent =~ /^(..)/)
3658 elsif ( $special eq 'CoStCl' ) {
3659 $prefix = uc( join('',
3661 ($self->state =~ /^(..)/),
3662 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3665 # add any others here if needed
3668 my $length = $conf->config('cust_main-custnum-display_length');
3669 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3670 return $self->agent_custid;
3671 } elsif ( $prefix ) {
3672 $length = 8 if !defined($length);
3674 sprintf('%0'.$length.'d', $self->custnum)
3675 } elsif ( $length ) {
3676 return sprintf('%0'.$length.'d', $self->custnum);
3678 return $self->custnum;
3684 Returns a name string for this customer, either "Company (Last, First)" or
3691 my $name = $self->contact;
3692 $name = $self->company. " ($name)" if $self->company;
3696 =item service_contact
3698 Returns the L<FS::contact> object for this customer that has the 'Service'
3699 contact class, or undef if there is no such contact. Deprecated; don't use
3704 sub service_contact {
3706 if ( !exists($self->{service_contact}) ) {
3707 my $classnum = $self->scalar_sql(
3708 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3709 ) || 0; #if it's zero, qsearchs will return nothing
3710 my $cust_contact = qsearchs('cust_contact', {
3711 'classnum' => $classnum,
3712 'custnum' => $self->custnum,
3714 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3716 $self->{service_contact};
3721 Returns a name string for this (service/shipping) contact, either
3722 "Company (Last, First)" or "Last, First".
3729 my $name = $self->ship_contact;
3730 $name = $self->company. " ($name)" if $self->company;
3736 Returns a name string for this customer, either "Company" or "First Last".
3742 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3745 =item ship_name_short
3747 Returns a name string for this (service/shipping) contact, either "Company"
3752 sub ship_name_short {
3754 $self->service_contact
3755 ? $self->ship_contact_firstlast
3761 Returns this customer's full (billing) contact name only, "Last, First"
3767 $self->get('last'). ', '. $self->first;
3772 Returns this customer's full (shipping) contact name only, "Last, First"
3778 my $contact = $self->service_contact || $self;
3779 $contact->get('last') . ', ' . $contact->get('first');
3782 =item contact_firstlast
3784 Returns this customers full (billing) contact name only, "First Last".
3788 sub contact_firstlast {
3790 $self->first. ' '. $self->get('last');
3793 =item ship_contact_firstlast
3795 Returns this customer's full (shipping) contact name only, "First Last".
3799 sub ship_contact_firstlast {
3801 my $contact = $self->service_contact || $self;
3802 $contact->get('first') . ' '. $contact->get('last');
3805 #XXX this doesn't work in 3.x+
3808 #Returns this customer's full country name
3814 # code2country($self->country);
3817 sub bill_country_full {
3819 code2country($self->bill_location->country);
3822 sub ship_country_full {
3824 code2country($self->ship_location->country);
3827 =item county_state_county [ PREFIX ]
3829 Returns a string consisting of just the county, state and country.
3833 sub county_state_country {
3836 if ( @_ && $_[0] && $self->has_ship_address ) {
3837 $locationnum = $self->ship_locationnum;
3839 $locationnum = $self->bill_locationnum;
3841 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3842 $cust_location->county_state_country;
3845 =item geocode DATA_VENDOR
3847 Returns a value for the customer location as encoded by DATA_VENDOR.
3848 Currently this only makes sense for "CCH" as DATA_VENDOR.
3856 Returns a status string for this customer, currently:
3862 No packages have ever been ordered. Displayed as "No packages".
3866 Recurring packages all are new (not yet billed).
3870 One or more recurring packages is active.
3874 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3878 All non-cancelled recurring packages are suspended.
3882 All recurring packages are cancelled.
3886 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3887 cust_main-status_module configuration option.
3891 sub status { shift->cust_status(@_); }
3895 for my $status ( FS::cust_main->statuses() ) {
3896 my $method = $status.'_sql';
3897 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3898 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3899 $sth->execute( ($self->custnum) x $numnum )
3900 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3901 return $status if $sth->fetchrow_arrayref->[0];
3905 =item is_status_delay_cancel
3907 Returns true if customer status is 'suspended'
3908 and all suspended cust_pkg return true for
3909 cust_pkg->is_status_delay_cancel.
3911 This is not a real status, this only meant for hacking display
3912 values, because otherwise treating the customer as suspended is
3913 really the whole point of the delay_cancel option.
3917 sub is_status_delay_cancel {
3919 return 0 unless $self->status eq 'suspended';
3920 foreach my $cust_pkg ($self->ncancelled_pkgs) {
3921 return 0 unless $cust_pkg->is_status_delay_cancel;
3926 =item ucfirst_cust_status
3928 =item ucfirst_status
3930 Deprecated, use the cust_status_label method instead.
3932 Returns the status with the first character capitalized.
3936 sub ucfirst_status {
3937 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3938 local($ucfirst_nowarn) = 1;
3939 shift->ucfirst_cust_status(@_);
3942 sub ucfirst_cust_status {
3943 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3945 ucfirst($self->cust_status);
3948 =item cust_status_label
3952 Returns the display label for this status.
3956 sub status_label { shift->cust_status_label(@_); }
3958 sub cust_status_label {
3960 __PACKAGE__->statuslabels->{$self->cust_status};
3965 Returns a hex triplet color string for this customer's status.
3969 sub statuscolor { shift->cust_statuscolor(@_); }
3971 sub cust_statuscolor {
3973 __PACKAGE__->statuscolors->{$self->cust_status};
3976 =item tickets [ STATUS ]
3978 Returns an array of hashes representing the customer's RT tickets.
3980 An optional status (or arrayref or hashref of statuses) may be specified.
3986 my $status = ( @_ && $_[0] ) ? shift : '';
3988 my $num = $conf->config('cust_main-max_tickets') || 10;
3991 if ( $conf->config('ticket_system') ) {
3992 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3994 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4003 foreach my $priority (
4004 $conf->config('ticket_system-custom_priority_field-values'), ''
4006 last if scalar(@tickets) >= $num;
4008 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4009 $num - scalar(@tickets),
4020 # Return services representing svc_accts in customer support packages
4021 sub support_services {
4023 my %packages = map { $_ => 1 } $conf->config('support_packages');
4025 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4026 grep { $_->part_svc->svcdb eq 'svc_acct' }
4027 map { $_->cust_svc }
4028 grep { exists $packages{ $_->pkgpart } }
4029 $self->ncancelled_pkgs;
4033 # Return a list of latitude/longitude for one of the services (if any)
4034 sub service_coordinates {
4038 grep { $_->latitude && $_->longitude }
4040 map { $_->cust_svc }
4041 $self->ncancelled_pkgs;
4043 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4048 Returns a masked version of the named field
4053 my ($self,$field) = @_;
4057 'x'x(length($self->getfield($field))-4).
4058 substr($self->getfield($field), (length($self->getfield($field))-4));
4064 =head1 CLASS METHODS
4070 Class method that returns the list of possible status strings for customers
4071 (see L<the status method|/status>). For example:
4073 @statuses = FS::cust_main->statuses();
4079 keys %{ $self->statuscolors };
4082 =item cust_status_sql
4084 Returns an SQL fragment to determine the status of a cust_main record, as a
4089 sub cust_status_sql {
4091 for my $status ( FS::cust_main->statuses() ) {
4092 my $method = $status.'_sql';
4093 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4102 Returns an SQL expression identifying prospective cust_main records (customers
4103 with no packages ever ordered)
4107 use vars qw($select_count_pkgs);
4108 $select_count_pkgs =
4109 "SELECT COUNT(*) FROM cust_pkg
4110 WHERE cust_pkg.custnum = cust_main.custnum";
4112 sub select_count_pkgs_sql {
4117 " 0 = ( $select_count_pkgs ) ";
4122 Returns an SQL expression identifying ordered cust_main records (customers with
4123 no active packages, but recurring packages not yet setup or one time charges
4129 FS::cust_main->none_active_sql.
4130 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4135 Returns an SQL expression identifying active cust_main records (customers with
4136 active recurring packages).
4141 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4144 =item none_active_sql
4146 Returns an SQL expression identifying cust_main records with no active
4147 recurring packages. This includes customers of status prospect, ordered,
4148 inactive, and suspended.
4152 sub none_active_sql {
4153 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4158 Returns an SQL expression identifying inactive cust_main records (customers with
4159 no active recurring packages, but otherwise unsuspended/uncancelled).
4164 FS::cust_main->none_active_sql.
4165 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4171 Returns an SQL expression identifying suspended cust_main records.
4176 sub suspended_sql { susp_sql(@_); }
4178 FS::cust_main->none_active_sql.
4179 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4185 Returns an SQL expression identifying cancelled cust_main records.
4189 sub cancel_sql { shift->cancelled_sql(@_); }
4192 =item uncancelled_sql
4194 Returns an SQL expression identifying un-cancelled cust_main records.
4198 sub uncancelled_sql { uncancel_sql(@_); }
4199 sub uncancel_sql { "
4200 ( 0 < ( $select_count_pkgs
4201 AND ( cust_pkg.cancel IS NULL
4202 OR cust_pkg.cancel = 0
4205 OR 0 = ( $select_count_pkgs )
4211 Returns an SQL fragment to retreive the balance.
4216 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4217 WHERE cust_bill.custnum = cust_main.custnum )
4218 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4219 WHERE cust_pay.custnum = cust_main.custnum )
4220 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4221 WHERE cust_credit.custnum = cust_main.custnum )
4222 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4223 WHERE cust_refund.custnum = cust_main.custnum )
4226 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4228 Returns an SQL fragment to retreive the balance for this customer, optionally
4229 considering invoices with date earlier than START_TIME, and not
4230 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4231 total_unapplied_payments).
4233 Times are specified as SQL fragments or numeric
4234 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4235 L<Date::Parse> for conversion functions. The empty string can be passed
4236 to disable that time constraint completely.
4238 Available options are:
4242 =item unapplied_date
4244 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)
4249 set to true to remove all customer comparison clauses, for totals
4254 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4259 JOIN clause (typically used with the total option)
4263 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4264 time will be ignored. Note that START_TIME and END_TIME only limit the date
4265 range for invoices and I<unapplied> payments, credits, and refunds.
4271 sub balance_date_sql {
4272 my( $class, $start, $end, %opt ) = @_;
4274 my $cutoff = $opt{'cutoff'};
4276 my $owed = FS::cust_bill->owed_sql($cutoff);
4277 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4278 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4279 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4281 my $j = $opt{'join'} || '';
4283 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4284 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4285 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4286 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4288 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4289 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4290 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4291 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4296 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4298 Returns an SQL fragment to retreive the total unapplied payments for this
4299 customer, only considering payments with date earlier than START_TIME, and
4300 optionally not later than END_TIME.
4302 Times are specified as SQL fragments or numeric
4303 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4304 L<Date::Parse> for conversion functions. The empty string can be passed
4305 to disable that time constraint completely.
4307 Available options are:
4311 sub unapplied_payments_date_sql {
4312 my( $class, $start, $end, %opt ) = @_;
4314 my $cutoff = $opt{'cutoff'};
4316 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4318 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4319 'unapplied_date'=>1 );
4321 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4324 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4326 Helper method for balance_date_sql; name (and usage) subject to change
4327 (suggestions welcome).
4329 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4330 cust_refund, cust_credit or cust_pay).
4332 If TABLE is "cust_bill" or the unapplied_date option is true, only
4333 considers records with date earlier than START_TIME, and optionally not
4334 later than END_TIME .
4338 sub _money_table_where {
4339 my( $class, $table, $start, $end, %opt ) = @_;
4342 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4343 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4344 push @where, "$table._date <= $start" if defined($start) && length($start);
4345 push @where, "$table._date > $end" if defined($end) && length($end);
4347 push @where, @{$opt{'where'}} if $opt{'where'};
4348 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4354 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4355 use FS::cust_main::Search;
4358 FS::cust_main::Search->search(@_);
4367 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4369 Deprecated. Use event notification and message templates
4370 (L<FS::msg_template>) instead.
4372 Sends a templated email notification to the customer (see L<Text::Template>).
4374 OPTIONS is a hash and may include
4376 I<from> - the email sender (default is invoice_from)
4378 I<to> - comma-separated scalar or arrayref of recipients
4379 (default is invoicing_list)
4381 I<subject> - The subject line of the sent email notification
4382 (default is "Notice from company_name")
4384 I<extra_fields> - a hashref of name/value pairs which will be substituted
4387 The following variables are vavailable in the template.
4389 I<$first> - the customer first name
4390 I<$last> - the customer last name
4391 I<$company> - the customer company
4392 I<$payby> - a description of the method of payment for the customer
4393 # would be nice to use FS::payby::shortname
4394 I<$payinfo> - the account information used to collect for this customer
4395 I<$expdate> - the expiration of the customer payment in seconds from epoch
4400 my ($self, $template, %options) = @_;
4402 return unless $conf->exists($template);
4404 my $from = $conf->invoice_from_full($self->agentnum)
4405 if $conf->exists('invoice_from', $self->agentnum);
4406 $from = $options{from} if exists($options{from});
4408 my $to = join(',', $self->invoicing_list_emailonly);
4409 $to = $options{to} if exists($options{to});
4411 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4412 if $conf->exists('company_name', $self->agentnum);
4413 $subject = $options{subject} if exists($options{subject});
4415 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4416 SOURCE => [ map "$_\n",
4417 $conf->config($template)]
4419 or die "can't create new Text::Template object: Text::Template::ERROR";
4420 $notify_template->compile()
4421 or die "can't compile template: Text::Template::ERROR";
4423 $FS::notify_template::_template::company_name =
4424 $conf->config('company_name', $self->agentnum);
4425 $FS::notify_template::_template::company_address =
4426 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4428 my $paydate = $self->paydate || '2037-12-31';
4429 $FS::notify_template::_template::first = $self->first;
4430 $FS::notify_template::_template::last = $self->last;
4431 $FS::notify_template::_template::company = $self->company;
4432 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4433 my $payby = $self->payby;
4434 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4435 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4437 #credit cards expire at the end of the month/year of their exp date
4438 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4439 $FS::notify_template::_template::payby = 'credit card';
4440 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4441 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4443 }elsif ($payby eq 'COMP') {
4444 $FS::notify_template::_template::payby = 'complimentary account';
4446 $FS::notify_template::_template::payby = 'current method';
4448 $FS::notify_template::_template::expdate = $expire_time;
4450 for (keys %{$options{extra_fields}}){
4452 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4455 send_email(from => $from,
4457 subject => $subject,
4458 body => $notify_template->fill_in( PACKAGE =>
4459 'FS::notify_template::_template' ),
4464 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4466 Generates a templated notification to the customer (see L<Text::Template>).
4468 OPTIONS is a hash and may include
4470 I<extra_fields> - a hashref of name/value pairs which will be substituted
4471 into the template. These values may override values mentioned below
4472 and those from the customer record.
4474 The following variables are available in the template instead of or in addition
4475 to the fields of the customer record.
4477 I<$payby> - a description of the method of payment for the customer
4478 # would be nice to use FS::payby::shortname
4479 I<$payinfo> - the masked account information used to collect for this customer
4480 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4481 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4485 # a lot like cust_bill::print_latex
4486 sub generate_letter {
4487 my ($self, $template, %options) = @_;
4489 return unless $conf->exists($template);
4491 my $letter_template = new Text::Template
4493 SOURCE => [ map "$_\n", $conf->config($template)],
4494 DELIMITERS => [ '[@--', '--@]' ],
4496 or die "can't create new Text::Template object: Text::Template::ERROR";
4498 $letter_template->compile()
4499 or die "can't compile template: Text::Template::ERROR";
4501 my %letter_data = map { $_ => $self->$_ } $self->fields;
4502 $letter_data{payinfo} = $self->mask_payinfo;
4504 #my $paydate = $self->paydate || '2037-12-31';
4505 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4507 my $payby = $self->payby;
4508 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4509 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4511 #credit cards expire at the end of the month/year of their exp date
4512 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4513 $letter_data{payby} = 'credit card';
4514 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4515 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4517 }elsif ($payby eq 'COMP') {
4518 $letter_data{payby} = 'complimentary account';
4520 $letter_data{payby} = 'current method';
4522 $letter_data{expdate} = $expire_time;
4524 for (keys %{$options{extra_fields}}){
4525 $letter_data{$_} = $options{extra_fields}->{$_};
4528 unless(exists($letter_data{returnaddress})){
4529 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4530 $self->agent_template)
4532 if ( length($retadd) ) {
4533 $letter_data{returnaddress} = $retadd;
4534 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4535 $letter_data{returnaddress} =
4536 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4540 ( $conf->config('company_name', $self->agentnum),
4541 $conf->config('company_address', $self->agentnum),
4545 $letter_data{returnaddress} = '~';
4549 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4551 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4553 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4555 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4559 ) or die "can't open temp file: $!\n";
4560 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4561 or die "can't write temp file: $!\n";
4563 $letter_data{'logo_file'} = $lh->filename;
4565 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4569 ) or die "can't open temp file: $!\n";
4571 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4573 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4574 return ($1, $letter_data{'logo_file'});
4578 =item print_ps TEMPLATE
4580 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4586 my($file, $lfile) = $self->generate_letter(@_);
4587 my $ps = FS::Misc::generate_ps($file);
4588 unlink($file.'.tex');
4594 =item print TEMPLATE
4596 Prints the filled in template.
4598 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4602 sub queueable_print {
4605 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4606 or die "invalid customer number: " . $opt{custnum};
4608 my $error = $self->print( { 'template' => $opt{template} } );
4609 die $error if $error;
4613 my ($self, $template) = (shift, shift);
4615 [ $self->print_ps($template) ],
4616 'agentnum' => $self->agentnum,
4620 #these three subs should just go away once agent stuff is all config overrides
4622 sub agent_template {
4624 $self->_agent_plandata('agent_templatename');
4627 sub agent_invoice_from {
4629 $self->_agent_plandata('agent_invoice_from');
4632 sub _agent_plandata {
4633 my( $self, $option ) = @_;
4635 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4636 #agent-specific Conf
4638 use FS::part_event::Condition;
4640 my $agentnum = $self->agentnum;
4642 my $regexp = regexp_sql();
4644 my $part_event_option =
4646 'select' => 'part_event_option.*',
4647 'table' => 'part_event_option',
4649 LEFT JOIN part_event USING ( eventpart )
4650 LEFT JOIN part_event_option AS peo_agentnum
4651 ON ( part_event.eventpart = peo_agentnum.eventpart
4652 AND peo_agentnum.optionname = 'agentnum'
4653 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4655 LEFT JOIN part_event_condition
4656 ON ( part_event.eventpart = part_event_condition.eventpart
4657 AND part_event_condition.conditionname = 'cust_bill_age'
4659 LEFT JOIN part_event_condition_option
4660 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4661 AND part_event_condition_option.optionname = 'age'
4664 #'hashref' => { 'optionname' => $option },
4665 #'hashref' => { 'part_event_option.optionname' => $option },
4667 " WHERE part_event_option.optionname = ". dbh->quote($option).
4668 " AND action = 'cust_bill_send_agent' ".
4669 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4670 " AND peo_agentnum.optionname = 'agentnum' ".
4671 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4673 CASE WHEN part_event_condition_option.optionname IS NULL
4675 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4677 , part_event.weight".
4681 unless ( $part_event_option ) {
4682 return $self->agent->invoice_template || ''
4683 if $option eq 'agent_templatename';
4687 $part_event_option->optionvalue;
4691 sub process_o2m_qsearch {
4694 return qsearch($table, @_) unless $table eq 'contact';
4696 my $hashref = shift;
4697 my %hash = %$hashref;
4698 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4699 or die 'guru meditation #4343';
4701 qsearch({ 'table' => 'contact',
4702 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4703 'hashref' => \%hash,
4704 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4705 " cust_contact.custnum = $custnum "
4709 sub process_o2m_qsearchs {
4712 return qsearchs($table, @_) unless $table eq 'contact';
4714 my $hashref = shift;
4715 my %hash = %$hashref;
4716 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4717 or die 'guru meditation #2121';
4719 qsearchs({ 'table' => 'contact',
4720 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4721 'hashref' => \%hash,
4722 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4723 " cust_contact.custnum = $custnum "
4727 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4729 Subroutine (not a method), designed to be called from the queue.
4731 Takes a list of options and values.
4733 Pulls up the customer record via the custnum option and calls bill_and_collect.
4738 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4740 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4741 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4743 #without this errors don't get rolled back
4744 $args{'fatal'} = 1; # runs from job queue, will be caught
4746 $cust_main->bill_and_collect( %args );
4749 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4751 Like queued_bill, but instead of C<bill_and_collect>, just runs the
4752 C<collect> part. This is used in batch tax calculation, where invoice
4753 generation and collection events have to be completely separated.
4757 sub queued_collect {
4759 my $cust_main = FS::cust_main->by_key($args{'custnum'});
4761 $cust_main->collect(%args);
4764 sub process_bill_and_collect {
4767 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4768 or die "custnum '$param->{custnum}' not found!\n";
4769 $param->{'job'} = $job;
4770 $param->{'fatal'} = 1; # runs from job queue, will be caught
4771 $param->{'retry'} = 1;
4773 $cust_main->bill_and_collect( %$param );
4776 #starting to take quite a while for big dbs
4777 # (JRNL: journaled so it only happens once per database)
4778 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
4779 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
4780 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
4781 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
4782 # JRNL leading/trailing spaces in first, last, company
4783 # JRNL migrate to cust_payby
4784 # - otaker upgrade? journal and call it good? (double check to make sure
4785 # we're not still setting otaker here)
4787 #only going to get worse with new location stuff...
4789 sub _upgrade_data { #class method
4790 my ($class, %opts) = @_;
4793 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4796 #this seems to be the only expensive one.. why does it take so long?
4797 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
4799 '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';
4800 FS::upgrade_journal->set_done('cust_main__signupdate');
4803 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
4805 # fix yyyy-m-dd formatted paydates
4806 if ( driver_name =~ /^mysql/i ) {
4808 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4809 } else { # the SQL standard
4811 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4813 FS::upgrade_journal->set_done('cust_main__paydate');
4816 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
4818 push @statements, #fix the weird BILL with a cc# in payinfo problem
4820 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
4822 FS::upgrade_journal->set_done('cust_main__payinfo');
4827 foreach my $sql ( @statements ) {
4828 my $sth = dbh->prepare($sql) or die dbh->errstr;
4829 $sth->execute or die $sth->errstr;
4830 #warn ( (time - $t). " seconds\n" );
4834 local($ignore_expired_card) = 1;
4835 local($ignore_banned_card) = 1;
4836 local($skip_fuzzyfiles) = 1;
4837 local($import) = 1; #prevent automatic geocoding (need its own variable?)
4839 FS::cust_main::Location->_upgrade_data(%opts);
4841 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
4843 foreach my $cust_main ( qsearch({
4844 'table' => 'cust_main',
4846 'extra_sql' => 'WHERE '.
4848 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
4849 qw( first last company )
4852 my $error = $cust_main->replace;
4853 die $error if $error;
4856 FS::upgrade_journal->set_done('cust_main__trimspaces');
4860 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
4862 #we don't want to decrypt them, just stuff them as-is into cust_payby
4863 local(@encrypted_fields) = ();
4865 local($FS::cust_payby::ignore_expired_card) = 1;
4866 local($FS::cust_payby::ignore_banned_card) = 1;
4868 my @payfields = qw( payby payinfo paycvv paymask
4869 paydate paystart_month paystart_year payissue
4870 payname paystate paytype payip
4873 my $search = new FS::Cursor {
4874 'table' => 'cust_main',
4875 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
4878 while (my $cust_main = $search->fetch) {
4880 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
4882 my $cust_payby = new FS::cust_payby {
4883 'custnum' => $cust_main->custnum,
4885 map { $_ => $cust_main->$_(); } @payfields
4888 my $error = $cust_payby->insert;
4889 die $error if $error;
4893 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
4895 $cust_main->invoice_attn( $cust_main->payname )
4896 if $cust_main->payby eq 'BILL' && $cust_main->payname;
4897 $cust_main->po_number( $cust_main->payinfo )
4898 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
4900 $cust_main->setfield($_, '') foreach @payfields;
4901 my $error = $cust_main->replace;
4902 die "Error upgradging payment information for custnum ".
4903 $cust_main->custnum. ": $error"
4908 FS::upgrade_journal->set_done('cust_main__cust_payby');
4911 $class->_upgrade_otaker(%opts);
4921 The delete method should possibly take an FS::cust_main object reference
4922 instead of a scalar customer number.
4924 Bill and collect options should probably be passed as references instead of a
4927 There should probably be a configuration file with a list of allowed credit
4930 No multiple currency support (probably a larger project than just this module).
4932 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4934 Birthdates rely on negative epoch values.
4936 The payby for card/check batches is broken. With mixed batching, bad
4939 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4943 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4944 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4945 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.