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'
282 =item invoice_ship_address
284 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
294 Creates a new customer. To add the customer to the database, see L<"insert">.
296 Note that this stores the hash reference, not a distinct copy of the hash it
297 points to. You can ask the object for a copy with the I<hash> method.
301 sub table { 'cust_main'; }
303 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
305 Adds this customer to the database. If there is an error, returns the error,
306 otherwise returns false.
308 Usually the customer's location will not yet exist in the database, and
309 the C<bill_location> and C<ship_location> pseudo-fields must be set to
310 uninserted L<FS::cust_location> objects. These will be inserted and linked
311 (in both directions) to the new customer record. If they're references
312 to the same object, they will become the same location.
314 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
315 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
316 are inserted atomicly, or the transaction is rolled back. Passing an empty
317 hash reference is equivalent to not supplying this parameter. There should be
318 a better explanation of this, but until then, here's an example:
321 tie %hash, 'Tie::RefHash'; #this part is important
323 $cust_pkg => [ $svc_acct ],
326 $cust_main->insert( \%hash );
328 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
329 be set as the invoicing list (see L<"invoicing_list">). Errors return as
330 expected and rollback the entire transaction; it is not necessary to call
331 check_invoicing_list first. The invoicing_list is set after the records in the
332 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
333 invoicing_list destination to the newly-created svc_acct. Here's an example:
335 $cust_main->insert( {}, [ $email, 'POST' ] );
337 Currently available options are: I<depend_jobnum>, I<noexport>,
338 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
340 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
341 on the supplied jobnum (they will not run until the specific job completes).
342 This can be used to defer provisioning until some action completes (such
343 as running the customer's credit card successfully).
345 The I<noexport> option is deprecated. If I<noexport> is set true, no
346 provisioning jobs (exports) are scheduled. (You can schedule them later with
347 the B<reexport> method.)
349 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
350 of tax names and exemption numbers. FS::cust_main_exemption records will be
351 created and inserted.
353 If I<prospectnum> is set, moves contacts and locations from that prospect.
355 If I<contact> is set to an arrayref of FS::contact objects, inserts those
356 new contacts with this new customer.
358 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
359 unset), inserts those new contacts with this new customer. Handles CGI
360 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
362 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
363 new stored payment records with this new customer. Handles CGI parameters
364 for an "m2" multiple entry field as passed by edit/cust_main.cgi
370 my $cust_pkgs = @_ ? shift : {};
371 my $invoicing_list = @_ ? shift : '';
373 warn "$me insert called with options ".
374 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
377 local $SIG{HUP} = 'IGNORE';
378 local $SIG{INT} = 'IGNORE';
379 local $SIG{QUIT} = 'IGNORE';
380 local $SIG{TERM} = 'IGNORE';
381 local $SIG{TSTP} = 'IGNORE';
382 local $SIG{PIPE} = 'IGNORE';
384 my $oldAutoCommit = $FS::UID::AutoCommit;
385 local $FS::UID::AutoCommit = 0;
388 my $prepay_identifier = '';
389 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
391 if ( $self->payby eq 'PREPAY' ) {
393 $self->payby(''); #'BILL');
394 $prepay_identifier = $self->payinfo;
397 warn " looking up prepaid card $prepay_identifier\n"
400 my $error = $self->get_prepay( $prepay_identifier,
401 'amount_ref' => \$amount,
402 'seconds_ref' => \$seconds,
403 'upbytes_ref' => \$upbytes,
404 'downbytes_ref' => \$downbytes,
405 'totalbytes_ref' => \$totalbytes,
408 $dbh->rollback if $oldAutoCommit;
409 #return "error applying prepaid card (transaction rolled back): $error";
413 $payby = 'PREP' if $amount;
415 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
418 $self->payby(''); #'BILL');
419 $amount = $self->paid;
424 foreach my $l (qw(bill_location ship_location)) {
426 my $loc = delete $self->hashref->{$l} or next;
428 if ( !$loc->locationnum ) {
429 # warn the location that we're going to insert it with no custnum
430 $loc->set(custnum_pending => 1);
431 warn " inserting $l\n"
433 my $error = $loc->insert;
435 $dbh->rollback if $oldAutoCommit;
436 my $label = $l eq 'ship_location' ? 'service' : 'billing';
437 return "$error (in $label location)";
440 } elsif ( $loc->prospectnum ) {
442 $loc->prospectnum('');
443 $loc->set(custnum_pending => 1);
444 my $error = $loc->replace;
446 $dbh->rollback if $oldAutoCommit;
447 my $label = $l eq 'ship_location' ? 'service' : 'billing';
448 return "$error (moving $label location)";
451 } elsif ( ($loc->custnum || 0) > 0 ) {
452 # then it somehow belongs to another customer--shouldn't happen
453 $dbh->rollback if $oldAutoCommit;
454 return "$l belongs to customer ".$loc->custnum;
456 # else it already belongs to this customer
457 # (happens when ship_location is identical to bill_location)
459 $self->set($l.'num', $loc->locationnum);
461 if ( $self->get($l.'num') eq '' ) {
462 $dbh->rollback if $oldAutoCommit;
467 $self->_loc_change();
469 warn " inserting $self\n"
472 $self->signupdate(time) unless $self->signupdate;
474 $self->auto_agent_custid()
475 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
477 my $error = $self->SUPER::insert;
479 $dbh->rollback if $oldAutoCommit;
480 #return "inserting cust_main record (transaction rolled back): $error";
484 # now set cust_location.custnum
485 foreach my $l (qw(bill_location ship_location)) {
486 warn " setting $l.custnum\n"
488 my $loc = $self->$l or next;
489 unless ( $loc->custnum ) {
490 $loc->set(custnum => $self->custnum);
491 $error ||= $loc->replace;
495 $dbh->rollback if $oldAutoCommit;
496 return "error setting $l custnum: $error";
500 warn " setting invoicing list\n"
503 if ( $invoicing_list ) {
504 $error = $self->check_invoicing_list( $invoicing_list );
506 $dbh->rollback if $oldAutoCommit;
507 #return "checking invoicing_list (transaction rolled back): $error";
510 $self->invoicing_list( $invoicing_list );
513 warn " setting customer tags\n"
516 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
517 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
518 'custnum' => $self->custnum };
519 my $error = $cust_tag->insert;
521 $dbh->rollback if $oldAutoCommit;
526 my $prospectnum = delete $options{'prospectnum'};
527 if ( $prospectnum ) {
529 warn " moving contacts and locations from prospect $prospectnum\n"
533 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
534 unless ( $prospect_main ) {
535 $dbh->rollback if $oldAutoCommit;
536 return "Unknown prospectnum $prospectnum";
538 $prospect_main->custnum($self->custnum);
539 $prospect_main->disabled('Y');
540 my $error = $prospect_main->replace;
542 $dbh->rollback if $oldAutoCommit;
546 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
547 my $cust_contact = new FS::cust_contact {
548 'custnum' => $self->custnum,
549 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
551 my $error = $cust_contact->insert
552 || $prospect_contact->delete;
554 $dbh->rollback if $oldAutoCommit;
559 my @cust_location = $prospect_main->cust_location;
560 my @qual = $prospect_main->qual;
562 foreach my $r ( @cust_location, @qual ) {
564 $r->custnum($self->custnum);
565 my $error = $r->replace;
567 $dbh->rollback if $oldAutoCommit;
574 warn " setting contacts\n"
577 if ( my $contact = delete $options{'contact'} ) {
579 foreach my $c ( @$contact ) {
580 $c->custnum($self->custnum);
581 my $error = $c->insert;
583 $dbh->rollback if $oldAutoCommit;
589 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
591 my $error = $self->process_o2m( 'table' => 'contact',
592 'fields' => FS::contact->cgi_contact_fields,
593 'params' => $contact_params,
596 $dbh->rollback if $oldAutoCommit;
601 warn " setting cust_payby\n"
604 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
606 my $error = $self->process_o2m(
607 'table' => 'cust_payby',
608 'fields' => FS::cust_payby->cgi_cust_payby_fields,
609 'params' => $cust_payby_params,
610 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
613 $dbh->rollback if $oldAutoCommit;
619 warn " setting cust_main_exemption\n"
622 my $tax_exemption = delete $options{'tax_exemption'};
623 if ( $tax_exemption ) {
625 $tax_exemption = { map { $_ => '' } @$tax_exemption }
626 if ref($tax_exemption) eq 'ARRAY';
628 foreach my $taxname ( keys %$tax_exemption ) {
629 my $cust_main_exemption = new FS::cust_main_exemption {
630 'custnum' => $self->custnum,
631 'taxname' => $taxname,
632 'exempt_number' => $tax_exemption->{$taxname},
634 my $error = $cust_main_exemption->insert;
636 $dbh->rollback if $oldAutoCommit;
637 return "inserting cust_main_exemption (transaction rolled back): $error";
642 warn " ordering packages\n"
645 $error = $self->order_pkgs( $cust_pkgs,
647 'seconds_ref' => \$seconds,
648 'upbytes_ref' => \$upbytes,
649 'downbytes_ref' => \$downbytes,
650 'totalbytes_ref' => \$totalbytes,
653 $dbh->rollback if $oldAutoCommit;
658 $dbh->rollback if $oldAutoCommit;
659 return "No svc_acct record to apply pre-paid time";
661 if ( $upbytes || $downbytes || $totalbytes ) {
662 $dbh->rollback if $oldAutoCommit;
663 return "No svc_acct record to apply pre-paid data";
667 warn " inserting initial $payby payment of $amount\n"
669 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
671 $dbh->rollback if $oldAutoCommit;
672 return "inserting payment (transaction rolled back): $error";
676 unless ( $import || $skip_fuzzyfiles ) {
677 warn " queueing fuzzyfiles update\n"
679 $error = $self->queue_fuzzyfiles_update;
681 $dbh->rollback if $oldAutoCommit;
682 return "updating fuzzy search cache: $error";
686 # FS::geocode_Mixin::after_insert or something?
687 if ( $conf->config('tax_district_method') and !$import ) {
688 # if anything non-empty, try to look it up
689 my $queue = new FS::queue {
690 'job' => 'FS::geocode_Mixin::process_district_update',
691 'custnum' => $self->custnum,
693 my $error = $queue->insert( ref($self), $self->custnum );
695 $dbh->rollback if $oldAutoCommit;
696 return "queueing tax district update: $error";
701 warn " exporting\n" if $DEBUG > 1;
703 my $export_args = $options{'export_args'} || [];
706 map qsearch( 'part_export', {exportnum=>$_} ),
707 $conf->config('cust_main-exports'); #, $agentnum
709 foreach my $part_export ( @part_export ) {
710 my $error = $part_export->export_insert($self, @$export_args);
712 $dbh->rollback if $oldAutoCommit;
713 return "exporting to ". $part_export->exporttype.
714 " (transaction rolled back): $error";
718 #foreach my $depend_jobnum ( @$depend_jobnums ) {
719 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
721 # foreach my $jobnum ( @jobnums ) {
722 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
723 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
725 # my $error = $queue->depend_insert($depend_jobnum);
727 # $dbh->rollback if $oldAutoCommit;
728 # return "error queuing job dependancy: $error";
735 #if ( exists $options{'jobnums'} ) {
736 # push @{ $options{'jobnums'} }, @jobnums;
739 warn " insert complete; committing transaction\n"
742 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
747 use File::CounterFile;
748 sub auto_agent_custid {
751 my $format = $conf->config('cust_main-auto_agent_custid');
753 if ( $format eq '1YMMXXXXXXXX' ) {
755 my $counter = new File::CounterFile 'cust_main.agent_custid';
758 my $ym = 100000000000 + time2str('%y%m00000000', time);
759 if ( $ym > $counter->value ) {
760 $counter->{'value'} = $agent_custid = $ym;
761 $counter->{'updated'} = 1;
763 $agent_custid = $counter->inc;
769 die "Unknown cust_main-auto_agent_custid format: $format";
772 $self->agent_custid($agent_custid);
776 =item PACKAGE METHODS
778 Documentation on customer package methods has been moved to
779 L<FS::cust_main::Packages>.
781 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
783 Recharges this (existing) customer with the specified prepaid card (see
784 L<FS::prepay_credit>), specified either by I<identifier> or as an
785 FS::prepay_credit object. If there is an error, returns the error, otherwise
788 Optionally, five scalar references can be passed as well. They will have their
789 values filled in with the amount, number of seconds, and number of upload,
790 download, and total bytes applied by this prepaid card.
794 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
795 #the only place that uses these args
796 sub recharge_prepay {
797 my( $self, $prepay_credit, $amountref, $secondsref,
798 $upbytesref, $downbytesref, $totalbytesref ) = @_;
800 local $SIG{HUP} = 'IGNORE';
801 local $SIG{INT} = 'IGNORE';
802 local $SIG{QUIT} = 'IGNORE';
803 local $SIG{TERM} = 'IGNORE';
804 local $SIG{TSTP} = 'IGNORE';
805 local $SIG{PIPE} = 'IGNORE';
807 my $oldAutoCommit = $FS::UID::AutoCommit;
808 local $FS::UID::AutoCommit = 0;
811 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
813 my $error = $self->get_prepay( $prepay_credit,
814 'amount_ref' => \$amount,
815 'seconds_ref' => \$seconds,
816 'upbytes_ref' => \$upbytes,
817 'downbytes_ref' => \$downbytes,
818 'totalbytes_ref' => \$totalbytes,
820 || $self->increment_seconds($seconds)
821 || $self->increment_upbytes($upbytes)
822 || $self->increment_downbytes($downbytes)
823 || $self->increment_totalbytes($totalbytes)
824 || $self->insert_cust_pay_prepay( $amount,
826 ? $prepay_credit->identifier
831 $dbh->rollback if $oldAutoCommit;
835 if ( defined($amountref) ) { $$amountref = $amount; }
836 if ( defined($secondsref) ) { $$secondsref = $seconds; }
837 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
838 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
839 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
841 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
846 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
848 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
849 specified either by I<identifier> or as an FS::prepay_credit object.
851 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
852 incremented by the values of the prepaid card.
854 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
855 check or set this customer's I<agentnum>.
857 If there is an error, returns the error, otherwise returns false.
863 my( $self, $prepay_credit, %opt ) = @_;
865 local $SIG{HUP} = 'IGNORE';
866 local $SIG{INT} = 'IGNORE';
867 local $SIG{QUIT} = 'IGNORE';
868 local $SIG{TERM} = 'IGNORE';
869 local $SIG{TSTP} = 'IGNORE';
870 local $SIG{PIPE} = 'IGNORE';
872 my $oldAutoCommit = $FS::UID::AutoCommit;
873 local $FS::UID::AutoCommit = 0;
876 unless ( ref($prepay_credit) ) {
878 my $identifier = $prepay_credit;
880 $prepay_credit = qsearchs(
882 { 'identifier' => $identifier },
887 unless ( $prepay_credit ) {
888 $dbh->rollback if $oldAutoCommit;
889 return "Invalid prepaid card: ". $identifier;
894 if ( $prepay_credit->agentnum ) {
895 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
896 $dbh->rollback if $oldAutoCommit;
897 return "prepaid card not valid for agent ". $self->agentnum;
899 $self->agentnum($prepay_credit->agentnum);
902 my $error = $prepay_credit->delete;
904 $dbh->rollback if $oldAutoCommit;
905 return "removing prepay_credit (transaction rolled back): $error";
908 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
909 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
911 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
916 =item increment_upbytes SECONDS
918 Updates this customer's single or primary account (see L<FS::svc_acct>) by
919 the specified number of upbytes. If there is an error, returns the error,
920 otherwise returns false.
924 sub increment_upbytes {
925 _increment_column( shift, 'upbytes', @_);
928 =item increment_downbytes SECONDS
930 Updates this customer's single or primary account (see L<FS::svc_acct>) by
931 the specified number of downbytes. If there is an error, returns the error,
932 otherwise returns false.
936 sub increment_downbytes {
937 _increment_column( shift, 'downbytes', @_);
940 =item increment_totalbytes SECONDS
942 Updates this customer's single or primary account (see L<FS::svc_acct>) by
943 the specified number of totalbytes. If there is an error, returns the error,
944 otherwise returns false.
948 sub increment_totalbytes {
949 _increment_column( shift, 'totalbytes', @_);
952 =item increment_seconds SECONDS
954 Updates this customer's single or primary account (see L<FS::svc_acct>) by
955 the specified number of seconds. If there is an error, returns the error,
956 otherwise returns false.
960 sub increment_seconds {
961 _increment_column( shift, 'seconds', @_);
964 =item _increment_column AMOUNT
966 Updates this customer's single or primary account (see L<FS::svc_acct>) by
967 the specified number of seconds or bytes. If there is an error, returns
968 the error, otherwise returns false.
972 sub _increment_column {
973 my( $self, $column, $amount ) = @_;
974 warn "$me increment_column called: $column, $amount\n"
977 return '' unless $amount;
979 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
980 $self->ncancelled_pkgs;
983 return 'No packages with primary or single services found'.
984 ' to apply pre-paid time';
985 } elsif ( scalar(@cust_pkg) > 1 ) {
986 #maybe have a way to specify the package/account?
987 return 'Multiple packages found to apply pre-paid time';
990 my $cust_pkg = $cust_pkg[0];
991 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
995 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
998 return 'No account found to apply pre-paid time';
999 } elsif ( scalar(@cust_svc) > 1 ) {
1000 return 'Multiple accounts found to apply pre-paid time';
1003 my $svc_acct = $cust_svc[0]->svc_x;
1004 warn " found service svcnum ". $svc_acct->pkgnum.
1005 ' ('. $svc_acct->email. ")\n"
1008 $column = "increment_$column";
1009 $svc_acct->$column($amount);
1013 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1015 Inserts a prepayment in the specified amount for this customer. An optional
1016 second argument can specify the prepayment identifier for tracking purposes.
1017 If there is an error, returns the error, otherwise returns false.
1021 sub insert_cust_pay_prepay {
1022 shift->insert_cust_pay('PREP', @_);
1025 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1027 Inserts a cash payment in the specified amount for this customer. An optional
1028 second argument can specify the payment identifier for tracking purposes.
1029 If there is an error, returns the error, otherwise returns false.
1033 sub insert_cust_pay_cash {
1034 shift->insert_cust_pay('CASH', @_);
1037 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1039 Inserts a Western Union payment in the specified amount for this customer. An
1040 optional second argument can specify the prepayment identifier for tracking
1041 purposes. If there is an error, returns the error, otherwise returns false.
1045 sub insert_cust_pay_west {
1046 shift->insert_cust_pay('WEST', @_);
1049 sub insert_cust_pay {
1050 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1051 my $payinfo = scalar(@_) ? shift : '';
1053 my $cust_pay = new FS::cust_pay {
1054 'custnum' => $self->custnum,
1055 'paid' => sprintf('%.2f', $amount),
1056 #'_date' => #date the prepaid card was purchased???
1058 'payinfo' => $payinfo,
1064 =item delete [ OPTION => VALUE ... ]
1066 This deletes the customer. If there is an error, returns the error, otherwise
1069 This will completely remove all traces of the customer record. This is not
1070 what you want when a customer cancels service; for that, cancel all of the
1071 customer's packages (see L</cancel>).
1073 If the customer has any uncancelled packages, you need to pass a new (valid)
1074 customer number for those packages to be transferred to, as the "new_customer"
1075 option. Cancelled packages will be deleted. Did I mention that this is NOT
1076 what you want when a customer cancels service and that you really should be
1077 looking at L<FS::cust_pkg/cancel>?
1079 You can't delete a customer with invoices (see L<FS::cust_bill>),
1080 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1081 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1082 set the "delete_financials" option to a true value.
1087 my( $self, %opt ) = @_;
1089 local $SIG{HUP} = 'IGNORE';
1090 local $SIG{INT} = 'IGNORE';
1091 local $SIG{QUIT} = 'IGNORE';
1092 local $SIG{TERM} = 'IGNORE';
1093 local $SIG{TSTP} = 'IGNORE';
1094 local $SIG{PIPE} = 'IGNORE';
1096 my $oldAutoCommit = $FS::UID::AutoCommit;
1097 local $FS::UID::AutoCommit = 0;
1100 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1101 $dbh->rollback if $oldAutoCommit;
1102 return "Can't delete a master agent customer";
1105 #use FS::access_user
1106 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1107 $dbh->rollback if $oldAutoCommit;
1108 return "Can't delete a master employee customer";
1111 tie my %financial_tables, 'Tie::IxHash',
1112 'cust_bill' => 'invoices',
1113 'cust_statement' => 'statements',
1114 'cust_credit' => 'credits',
1115 'cust_pay' => 'payments',
1116 'cust_refund' => 'refunds',
1119 foreach my $table ( keys %financial_tables ) {
1121 my @records = $self->$table();
1123 if ( @records && ! $opt{'delete_financials'} ) {
1124 $dbh->rollback if $oldAutoCommit;
1125 return "Can't delete a customer with ". $financial_tables{$table};
1128 foreach my $record ( @records ) {
1129 my $error = $record->delete;
1131 $dbh->rollback if $oldAutoCommit;
1132 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1138 my @cust_pkg = $self->ncancelled_pkgs;
1140 my $new_custnum = $opt{'new_custnum'};
1141 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1142 $dbh->rollback if $oldAutoCommit;
1143 return "Invalid new customer number: $new_custnum";
1145 foreach my $cust_pkg ( @cust_pkg ) {
1146 my %hash = $cust_pkg->hash;
1147 $hash{'custnum'} = $new_custnum;
1148 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1149 my $error = $new_cust_pkg->replace($cust_pkg,
1150 options => { $cust_pkg->options },
1153 $dbh->rollback if $oldAutoCommit;
1158 my @cancelled_cust_pkg = $self->all_pkgs;
1159 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1160 my $error = $cust_pkg->delete;
1162 $dbh->rollback if $oldAutoCommit;
1167 #cust_tax_adjustment in financials?
1168 #cust_pay_pending? ouch
1169 foreach my $table (qw(
1170 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1171 cust_payby cust_location cust_main_note cust_tax_adjustment
1172 cust_pay_void cust_pay_batch queue cust_tax_exempt
1174 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1175 my $error = $record->delete;
1177 $dbh->rollback if $oldAutoCommit;
1183 my $sth = $dbh->prepare(
1184 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1186 my $errstr = $dbh->errstr;
1187 $dbh->rollback if $oldAutoCommit;
1190 $sth->execute($self->custnum) or do {
1191 my $errstr = $sth->errstr;
1192 $dbh->rollback if $oldAutoCommit;
1198 my $ticket_dbh = '';
1199 if ($conf->config('ticket_system') eq 'RT_Internal') {
1201 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1202 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1203 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1204 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1207 if ( $ticket_dbh ) {
1209 my $ticket_sth = $ticket_dbh->prepare(
1210 'DELETE FROM Links WHERE Target = ?'
1212 my $errstr = $ticket_dbh->errstr;
1213 $dbh->rollback if $oldAutoCommit;
1216 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1218 my $errstr = $ticket_sth->errstr;
1219 $dbh->rollback if $oldAutoCommit;
1223 #check and see if the customer is the only link on the ticket, and
1224 #if so, set the ticket to deleted status in RT?
1225 #maybe someday, for now this will at least fix tickets not displaying
1229 #delete the customer record
1231 my $error = $self->SUPER::delete;
1233 $dbh->rollback if $oldAutoCommit;
1237 # cust_main exports!
1239 #my $export_args = $options{'export_args'} || [];
1242 map qsearch( 'part_export', {exportnum=>$_} ),
1243 $conf->config('cust_main-exports'); #, $agentnum
1245 foreach my $part_export ( @part_export ) {
1246 my $error = $part_export->export_delete( $self ); #, @$export_args);
1248 $dbh->rollback if $oldAutoCommit;
1249 return "exporting to ". $part_export->exporttype.
1250 " (transaction rolled back): $error";
1254 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1259 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1261 Replaces the OLD_RECORD with this one in the database. If there is an error,
1262 returns the error, otherwise returns false.
1264 To change the customer's address, set the pseudo-fields C<bill_location> and
1265 C<ship_location>. The address will still only change if at least one of the
1266 address fields differs from the existing values.
1268 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1269 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1270 expected and rollback the entire transaction; it is not necessary to call
1271 check_invoicing_list first. Here's an example:
1273 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1275 Currently available options are: I<tax_exemption>.
1277 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1278 of tax names and exemption numbers. FS::cust_main_exemption records will be
1279 deleted and inserted as appropriate.
1286 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1288 : $self->replace_old;
1292 warn "$me replace called\n"
1295 my $curuser = $FS::CurrentUser::CurrentUser;
1296 return "You are not permitted to create complimentary accounts."
1297 if $self->complimentary eq 'Y'
1298 && $self->complimentary ne $old->complimentary
1299 && ! $curuser->access_right('Complimentary customer');
1301 local($ignore_expired_card) = 1
1302 if $old->payby =~ /^(CARD|DCRD)$/
1303 && $self->payby =~ /^(CARD|DCRD)$/
1304 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1306 local($ignore_banned_card) = 1
1307 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1308 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1309 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1311 return "Invoicing locale is required"
1314 && $conf->exists('cust_main-require_locale');
1316 local $SIG{HUP} = 'IGNORE';
1317 local $SIG{INT} = 'IGNORE';
1318 local $SIG{QUIT} = 'IGNORE';
1319 local $SIG{TERM} = 'IGNORE';
1320 local $SIG{TSTP} = 'IGNORE';
1321 local $SIG{PIPE} = 'IGNORE';
1323 my $oldAutoCommit = $FS::UID::AutoCommit;
1324 local $FS::UID::AutoCommit = 0;
1327 for my $l (qw(bill_location ship_location)) {
1328 #my $old_loc = $old->$l;
1329 my $new_loc = $self->$l or next;
1331 # find the existing location if there is one
1332 $new_loc->set('custnum' => $self->custnum);
1333 my $error = $new_loc->find_or_insert;
1335 $dbh->rollback if $oldAutoCommit;
1338 $self->set($l.'num', $new_loc->locationnum);
1341 $self->_loc_change($old);
1343 # replace the customer record
1344 my $error = $self->SUPER::replace($old);
1347 $dbh->rollback if $oldAutoCommit;
1351 # now move packages to the new service location
1352 $self->set('ship_location', ''); #flush cache
1353 if ( $old->ship_locationnum and # should only be null during upgrade...
1354 $old->ship_locationnum != $self->ship_locationnum ) {
1355 $error = $old->ship_location->move_to($self->ship_location);
1357 $dbh->rollback if $oldAutoCommit;
1361 # don't move packages based on the billing location, but
1362 # disable it if it's no longer in use
1363 if ( $old->bill_locationnum and
1364 $old->bill_locationnum != $self->bill_locationnum ) {
1365 $error = $old->bill_location->disable_if_unused;
1367 $dbh->rollback if $oldAutoCommit;
1372 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1373 my $invoicing_list = shift @param;
1374 $error = $self->check_invoicing_list( $invoicing_list );
1376 $dbh->rollback if $oldAutoCommit;
1379 $self->invoicing_list( $invoicing_list );
1382 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1384 #this could be more efficient than deleting and re-inserting, if it matters
1385 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1386 my $error = $cust_tag->delete;
1388 $dbh->rollback if $oldAutoCommit;
1392 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1393 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1394 'custnum' => $self->custnum };
1395 my $error = $cust_tag->insert;
1397 $dbh->rollback if $oldAutoCommit;
1404 my %options = @param;
1406 my $tax_exemption = delete $options{'tax_exemption'};
1407 if ( $tax_exemption ) {
1409 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1410 if ref($tax_exemption) eq 'ARRAY';
1412 my %cust_main_exemption =
1413 map { $_->taxname => $_ }
1414 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1416 foreach my $taxname ( keys %$tax_exemption ) {
1418 if ( $cust_main_exemption{$taxname} &&
1419 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1422 delete $cust_main_exemption{$taxname};
1426 my $cust_main_exemption = new FS::cust_main_exemption {
1427 'custnum' => $self->custnum,
1428 'taxname' => $taxname,
1429 'exempt_number' => $tax_exemption->{$taxname},
1431 my $error = $cust_main_exemption->insert;
1433 $dbh->rollback if $oldAutoCommit;
1434 return "inserting cust_main_exemption (transaction rolled back): $error";
1438 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1439 my $error = $cust_main_exemption->delete;
1441 $dbh->rollback if $oldAutoCommit;
1442 return "deleting cust_main_exemption (transaction rolled back): $error";
1448 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1450 my $error = $self->process_o2m(
1451 'table' => 'cust_payby',
1452 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1453 'params' => $cust_payby_params,
1454 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1457 $dbh->rollback if $oldAutoCommit;
1463 unless ( $import || $skip_fuzzyfiles ) {
1464 $error = $self->queue_fuzzyfiles_update;
1466 $dbh->rollback if $oldAutoCommit;
1467 return "updating fuzzy search cache: $error";
1471 # tax district update in cust_location
1473 # cust_main exports!
1475 my $export_args = $options{'export_args'} || [];
1478 map qsearch( 'part_export', {exportnum=>$_} ),
1479 $conf->config('cust_main-exports'); #, $agentnum
1481 foreach my $part_export ( @part_export ) {
1482 my $error = $part_export->export_replace( $self, $old, @$export_args);
1484 $dbh->rollback if $oldAutoCommit;
1485 return "exporting to ". $part_export->exporttype.
1486 " (transaction rolled back): $error";
1490 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1495 =item queue_fuzzyfiles_update
1497 Used by insert & replace to update the fuzzy search cache
1501 use FS::cust_main::Search;
1502 sub queue_fuzzyfiles_update {
1505 local $SIG{HUP} = 'IGNORE';
1506 local $SIG{INT} = 'IGNORE';
1507 local $SIG{QUIT} = 'IGNORE';
1508 local $SIG{TERM} = 'IGNORE';
1509 local $SIG{TSTP} = 'IGNORE';
1510 local $SIG{PIPE} = 'IGNORE';
1512 my $oldAutoCommit = $FS::UID::AutoCommit;
1513 local $FS::UID::AutoCommit = 0;
1516 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1517 my $queue = new FS::queue {
1518 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1520 my @args = "cust_main.$field", $self->get($field);
1521 my $error = $queue->insert( @args );
1523 $dbh->rollback if $oldAutoCommit;
1524 return "queueing job (transaction rolled back): $error";
1529 push @locations, $self->bill_location if $self->bill_locationnum;
1530 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1531 foreach my $location (@locations) {
1532 my $queue = new FS::queue {
1533 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1535 my @args = 'cust_location.address1', $location->address1;
1536 my $error = $queue->insert( @args );
1538 $dbh->rollback if $oldAutoCommit;
1539 return "queueing job (transaction rolled back): $error";
1543 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1550 Checks all fields to make sure this is a valid customer record. If there is
1551 an error, returns the error, otherwise returns false. Called by the insert
1552 and replace methods.
1559 warn "$me check BEFORE: \n". $self->_dump
1563 $self->ut_numbern('custnum')
1564 || $self->ut_number('agentnum')
1565 || $self->ut_textn('agent_custid')
1566 || $self->ut_number('refnum')
1567 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1568 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1569 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1570 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1571 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1572 || $self->ut_textn('custbatch')
1573 || $self->ut_name('last')
1574 || $self->ut_name('first')
1575 || $self->ut_snumbern('signupdate')
1576 || $self->ut_snumbern('birthdate')
1577 || $self->ut_namen('spouse_last')
1578 || $self->ut_namen('spouse_first')
1579 || $self->ut_snumbern('spouse_birthdate')
1580 || $self->ut_snumbern('anniversary_date')
1581 || $self->ut_textn('company')
1582 || $self->ut_textn('ship_company')
1583 || $self->ut_anything('comments')
1584 || $self->ut_numbern('referral_custnum')
1585 || $self->ut_textn('stateid')
1586 || $self->ut_textn('stateid_state')
1587 || $self->ut_textn('invoice_terms')
1588 || $self->ut_floatn('cdr_termination_percentage')
1589 || $self->ut_floatn('credit_limit')
1590 || $self->ut_numbern('billday')
1591 || $self->ut_numbern('prorate_day')
1592 || $self->ut_flag('edit_subject')
1593 || $self->ut_flag('calling_list_exempt')
1594 || $self->ut_flag('invoice_noemail')
1595 || $self->ut_flag('message_noemail')
1596 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1597 || $self->ut_currencyn('currency')
1598 || $self->ut_alphan('po_number')
1599 || $self->ut_enum('complimentary', [ '', 'Y' ])
1600 || $self->ut_flag('invoice_ship_address')
1603 foreach (qw(company ship_company)) {
1604 my $company = $self->get($_);
1605 $company =~ s/^\s+//;
1606 $company =~ s/\s+$//;
1607 $company =~ s/\s+/ /g;
1608 $self->set($_, $company);
1611 #barf. need message catalogs. i18n. etc.
1612 $error .= "Please select an advertising source."
1613 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1614 return $error if $error;
1616 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1617 or return "Unknown agent";
1619 if ( $self->currency ) {
1620 my $agent_currency = qsearchs( 'agent_currency', {
1621 'agentnum' => $agent->agentnum,
1622 'currency' => $self->currency,
1624 or return "Agent ". $agent->agent.
1625 " not permitted to offer ". $self->currency. " invoicing";
1628 return "Unknown refnum"
1629 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1631 return "Unknown referring custnum: ". $self->referral_custnum
1632 unless ! $self->referral_custnum
1633 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1635 if ( $self->ss eq '' ) {
1640 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1641 or return "Illegal social security number: ". $self->ss;
1642 $self->ss("$1-$2-$3");
1645 # cust_main_county verification now handled by cust_location check
1648 $self->ut_phonen('daytime', $self->country)
1649 || $self->ut_phonen('night', $self->country)
1650 || $self->ut_phonen('fax', $self->country)
1651 || $self->ut_phonen('mobile', $self->country)
1653 return $error if $error;
1655 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1657 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1660 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1662 : FS::Msgcat::_gettext('daytime');
1663 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1665 : FS::Msgcat::_gettext('night');
1667 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1669 : FS::Msgcat::_gettext('mobile');
1671 return "$daytime_label, $night_label or $mobile_label is required"
1675 ### start of stuff moved to cust_payby
1676 # then mostly kept here to support upgrades (can remove in 5.x)
1677 # but modified to allow everything to be empty
1679 if ( $self->payby ) {
1680 FS::payby->can_payby($self->table, $self->payby)
1681 or return "Illegal payby: ". $self->payby;
1686 $error = $self->ut_numbern('paystart_month')
1687 || $self->ut_numbern('paystart_year')
1688 || $self->ut_numbern('payissue')
1689 || $self->ut_textn('paytype')
1691 return $error if $error;
1693 if ( $self->payip eq '' ) {
1696 $error = $self->ut_ip('payip');
1697 return $error if $error;
1700 # If it is encrypted and the private key is not availaible then we can't
1701 # check the credit card.
1702 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1704 # Need some kind of global flag to accept invalid cards, for testing
1706 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1707 $self->payby =~ /^(CARD|DCRD)$/ ) {
1709 my $payinfo = $self->payinfo;
1710 $payinfo =~ s/\D//g;
1711 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1712 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1714 $self->payinfo($payinfo);
1716 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1718 return gettext('unknown_card_type')
1719 if $self->payinfo !~ /^99\d{14}$/ #token
1720 && cardtype($self->payinfo) eq "Unknown";
1722 unless ( $ignore_banned_card ) {
1723 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1725 if ( $ban->bantype eq 'warn' ) {
1726 #or others depending on value of $ban->reason ?
1727 return '_duplicate_card'.
1728 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1729 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1730 ' (ban# '. $ban->bannum. ')'
1731 unless $self->override_ban_warn;
1733 return 'Banned credit card: banned on '.
1734 time2str('%a %h %o at %r', $ban->_date).
1735 ' by '. $ban->otaker.
1736 ' (ban# '. $ban->bannum. ')';
1741 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1742 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1743 $self->paycvv =~ /^(\d{4})$/
1744 or return "CVV2 (CID) for American Express cards is four digits.";
1747 $self->paycvv =~ /^(\d{3})$/
1748 or return "CVV2 (CVC2/CID) is three digits.";
1755 my $cardtype = cardtype($payinfo);
1756 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1758 return "Start date or issue number is required for $cardtype cards"
1759 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1761 return "Start month must be between 1 and 12"
1762 if $self->paystart_month
1763 and $self->paystart_month < 1 || $self->paystart_month > 12;
1765 return "Start year must be 1990 or later"
1766 if $self->paystart_year
1767 and $self->paystart_year < 1990;
1769 return "Issue number must be beween 1 and 99"
1771 and $self->payissue < 1 || $self->payissue > 99;
1774 $self->paystart_month('');
1775 $self->paystart_year('');
1776 $self->payissue('');
1779 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1780 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1782 my $payinfo = $self->payinfo;
1783 $payinfo =~ s/[^\d\@\.]//g;
1784 if ( $conf->config('echeck-country') eq 'CA' ) {
1785 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1786 or return 'invalid echeck account@branch.bank';
1787 $payinfo = "$1\@$2.$3";
1788 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1789 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1790 $payinfo = "$1\@$2";
1792 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1793 $payinfo = "$1\@$2";
1795 $self->payinfo($payinfo);
1798 unless ( $ignore_banned_card ) {
1799 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1801 if ( $ban->bantype eq 'warn' ) {
1802 #or others depending on value of $ban->reason ?
1803 return '_duplicate_ach' unless $self->override_ban_warn;
1805 return 'Banned ACH account: banned on '.
1806 time2str('%a %h %o at %r', $ban->_date).
1807 ' by '. $ban->otaker.
1808 ' (ban# '. $ban->bannum. ')';
1813 } elsif ( $self->payby eq 'LECB' ) {
1815 my $payinfo = $self->payinfo;
1816 $payinfo =~ s/\D//g;
1817 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1819 $self->payinfo($payinfo);
1822 } elsif ( $self->payby eq 'BILL' ) {
1824 $error = $self->ut_textn('payinfo');
1825 return "Illegal P.O. number: ". $self->payinfo if $error;
1828 } elsif ( $self->payby eq 'COMP' ) {
1830 my $curuser = $FS::CurrentUser::CurrentUser;
1831 if ( ! $self->custnum
1832 && ! $curuser->access_right('Complimentary customer')
1835 return "You are not permitted to create complimentary accounts."
1838 $error = $self->ut_textn('payinfo');
1839 return "Illegal comp account issuer: ". $self->payinfo if $error;
1842 } elsif ( $self->payby eq 'PREPAY' ) {
1844 my $payinfo = $self->payinfo;
1845 $payinfo =~ s/\W//g; #anything else would just confuse things
1846 $self->payinfo($payinfo);
1847 $error = $self->ut_alpha('payinfo');
1848 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1849 return "Unknown prepayment identifier"
1850 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1855 return "You are not permitted to create complimentary accounts."
1857 && $self->complimentary eq 'Y'
1858 && ! $FS::CurrentUser->CurrentUser->access_right('Complimentary customer');
1860 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1861 return "Expiration date required"
1862 # shouldn't payinfo_check do this?
1863 unless ! $self->payby
1864 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1868 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1869 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1870 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1871 ( $m, $y ) = ( $2, "19$1" );
1872 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1873 ( $m, $y ) = ( $3, "20$2" );
1875 return "Illegal expiration date: ". $self->paydate;
1877 $m = sprintf('%02d',$m);
1878 $self->paydate("$y-$m-01");
1879 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1880 return gettext('expired_card')
1882 && !$ignore_expired_card
1883 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1886 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1887 ( ! $conf->exists('require_cardname')
1888 || $self->payby !~ /^(CARD|DCRD)$/ )
1890 $self->payname( $self->first. " ". $self->getfield('last') );
1893 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
1894 $self->payname =~ /^([\w \,\.\-\']*)$/
1895 or return gettext('illegal_name'). " payname: ". $self->payname;
1898 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
1899 or return gettext('illegal_name'). " payname: ". $self->payname;
1905 ### end of stuff moved to cust_payby
1907 return "Please select an invoicing locale"
1910 && $conf->exists('cust_main-require_locale');
1912 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1913 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1917 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1919 warn "$me check AFTER: \n". $self->_dump
1922 $self->SUPER::check;
1927 Returns a list of fields which have ship_ duplicates.
1932 qw( last first company
1934 address1 address2 city county state zip country
1936 daytime night fax mobile
1940 =item has_ship_address
1942 Returns true if this customer record has a separate shipping address.
1946 sub has_ship_address {
1948 $self->bill_locationnum != $self->ship_locationnum;
1953 Returns a list of key/value pairs, with the following keys: address1,
1954 adddress2, city, county, state, zip, country, district, and geocode. The
1955 shipping address is used if present.
1961 $self->ship_location->location_hash;
1966 Returns all locations (see L<FS::cust_location>) for this customer.
1972 qsearch('cust_location', { 'custnum' => $self->custnum,
1973 'prospectnum' => '' } );
1978 Returns all contact associations (see L<FS::cust_contact>) for this customer.
1984 qsearch('cust_contact', { 'custnum' => $self->custnum } );
1989 Returns all payment methods (see L<FS::cust_payby>) for this customer.
1996 'table' => 'cust_payby',
1997 'hashref' => { 'custnum' => $self->custnum },
1998 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2004 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2005 and L<FS::cust_pkg>) for this customer, except those on hold.
2007 Returns a list: an empty list on success or a list of errors.
2013 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2018 Unsuspends all suspended packages in the on-hold state (those without setup
2019 dates) for this customer.
2025 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2030 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2032 Returns a list: an empty list on success or a list of errors.
2038 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2041 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2043 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2044 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2045 of a list of pkgparts; the hashref has the following keys:
2049 =item pkgparts - listref of pkgparts
2051 =item (other options are passed to the suspend method)
2056 Returns a list: an empty list on success or a list of errors.
2060 sub suspend_if_pkgpart {
2062 my (@pkgparts, %opt);
2063 if (ref($_[0]) eq 'HASH'){
2064 @pkgparts = @{$_[0]{pkgparts}};
2069 grep { $_->suspend(%opt) }
2070 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2071 $self->unsuspended_pkgs;
2074 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2076 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2077 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2078 instead of a list of pkgparts; the hashref has the following keys:
2082 =item pkgparts - listref of pkgparts
2084 =item (other options are passed to the suspend method)
2088 Returns a list: an empty list on success or a list of errors.
2092 sub suspend_unless_pkgpart {
2094 my (@pkgparts, %opt);
2095 if (ref($_[0]) eq 'HASH'){
2096 @pkgparts = @{$_[0]{pkgparts}};
2101 grep { $_->suspend(%opt) }
2102 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2103 $self->unsuspended_pkgs;
2106 =item cancel [ OPTION => VALUE ... ]
2108 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2110 Available options are:
2114 =item quiet - can be set true to supress email cancellation notices.
2116 =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.
2118 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2120 =item nobill - can be set true to skip billing if it might otherwise be done.
2124 Always returns a list: an empty list on success or a list of errors.
2128 # nb that dates are not specified as valid options to this method
2131 my( $self, %opt ) = @_;
2133 warn "$me cancel called on customer ". $self->custnum. " with options ".
2134 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2137 return ( 'access denied' )
2138 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2140 if ( $opt{'ban'} ) {
2142 foreach my $cust_payby ( $self->cust_payby ) {
2144 #well, if they didn't get decrypted on search, then we don't have to
2145 # try again... queue a job for the server that does have decryption
2146 # capability if we're in a paranoid multi-server implementation?
2147 return ( "Can't (yet) ban encrypted credit cards" )
2148 if $cust_payby->is_encrypted($cust_payby->payinfo);
2150 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2151 my $error = $ban->insert;
2152 return ( $error ) if $error;
2158 my @pkgs = $self->ncancelled_pkgs;
2160 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2162 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2163 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2167 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2168 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2171 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2174 sub _banned_pay_hashref {
2185 'payby' => $payby2ban{$self->payby},
2186 'payinfo' => $self->payinfo,
2187 #don't ever *search* on reason! #'reason' =>
2193 Returns all notes (see L<FS::cust_main_note>) for this customer.
2198 my($self,$orderby_classnum) = (shift,shift);
2199 my $orderby = "sticky DESC, _date DESC";
2200 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2201 qsearch( 'cust_main_note',
2202 { 'custnum' => $self->custnum },
2204 "ORDER BY $orderby",
2210 Returns the agent (see L<FS::agent>) for this customer.
2214 Returns the agent name (see L<FS::agent>) for this customer.
2220 $self->agent->agent;
2225 Returns any tags associated with this customer, as FS::cust_tag objects,
2226 or an empty list if there are no tags.
2230 Returns any tags associated with this customer, as FS::part_tag objects,
2231 or an empty list if there are no tags.
2237 map $_->part_tag, $self->cust_tag;
2243 Returns the customer class, as an FS::cust_class object, or the empty string
2244 if there is no customer class.
2248 Returns the customer category name, or the empty string if there is no customer
2255 my $cust_class = $self->cust_class;
2257 ? $cust_class->categoryname
2263 Returns the customer class name, or the empty string if there is no customer
2270 my $cust_class = $self->cust_class;
2272 ? $cust_class->classname
2278 Returns the external tax status, as an FS::tax_status object, or the empty
2279 string if there is no tax status.
2285 if ( $self->taxstatusnum ) {
2286 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2294 Returns the tax status code if there is one.
2300 my $tax_status = $self->tax_status;
2302 ? $tax_status->taxstatus
2306 =item BILLING METHODS
2308 Documentation on billing methods has been moved to
2309 L<FS::cust_main::Billing>.
2311 =item REALTIME BILLING METHODS
2313 Documentation on realtime billing methods has been moved to
2314 L<FS::cust_main::Billing_Realtime>.
2318 Removes the I<paycvv> field from the database directly.
2320 If there is an error, returns the error, otherwise returns false.
2326 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2327 or return dbh->errstr;
2328 $sth->execute($self->custnum)
2329 or return $sth->errstr;
2336 Returns the total owed for this customer on all invoices
2337 (see L<FS::cust_bill/owed>).
2343 $self->total_owed_date(2145859200); #12/31/2037
2346 =item total_owed_date TIME
2348 Returns the total owed for this customer on all invoices with date earlier than
2349 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2350 see L<Time::Local> and L<Date::Parse> for conversion functions.
2354 sub total_owed_date {
2358 my $custnum = $self->custnum;
2360 my $owed_sql = FS::cust_bill->owed_sql;
2363 SELECT SUM($owed_sql) FROM cust_bill
2364 WHERE custnum = $custnum
2368 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2372 =item total_owed_pkgnum PKGNUM
2374 Returns the total owed on all invoices for this customer's specific package
2375 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2379 sub total_owed_pkgnum {
2380 my( $self, $pkgnum ) = @_;
2381 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2384 =item total_owed_date_pkgnum TIME PKGNUM
2386 Returns the total owed for this customer's specific package when using
2387 experimental package balances on all invoices with date earlier than
2388 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2389 see L<Time::Local> and L<Date::Parse> for conversion functions.
2393 sub total_owed_date_pkgnum {
2394 my( $self, $time, $pkgnum ) = @_;
2397 foreach my $cust_bill (
2398 grep { $_->_date <= $time }
2399 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2401 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2403 sprintf( "%.2f", $total_bill );
2409 Returns the total amount of all payments.
2416 $total += $_->paid foreach $self->cust_pay;
2417 sprintf( "%.2f", $total );
2420 =item total_unapplied_credits
2422 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2423 customer. See L<FS::cust_credit/credited>.
2425 =item total_credited
2427 Old name for total_unapplied_credits. Don't use.
2431 sub total_credited {
2432 #carp "total_credited deprecated, use total_unapplied_credits";
2433 shift->total_unapplied_credits(@_);
2436 sub total_unapplied_credits {
2439 my $custnum = $self->custnum;
2441 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2444 SELECT SUM($unapplied_sql) FROM cust_credit
2445 WHERE custnum = $custnum
2448 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2452 =item total_unapplied_credits_pkgnum PKGNUM
2454 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2455 customer. See L<FS::cust_credit/credited>.
2459 sub total_unapplied_credits_pkgnum {
2460 my( $self, $pkgnum ) = @_;
2461 my $total_credit = 0;
2462 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2463 sprintf( "%.2f", $total_credit );
2467 =item total_unapplied_payments
2469 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2470 See L<FS::cust_pay/unapplied>.
2474 sub total_unapplied_payments {
2477 my $custnum = $self->custnum;
2479 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2482 SELECT SUM($unapplied_sql) FROM cust_pay
2483 WHERE custnum = $custnum
2486 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2490 =item total_unapplied_payments_pkgnum PKGNUM
2492 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2493 specific package when using experimental package balances. See
2494 L<FS::cust_pay/unapplied>.
2498 sub total_unapplied_payments_pkgnum {
2499 my( $self, $pkgnum ) = @_;
2500 my $total_unapplied = 0;
2501 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2502 sprintf( "%.2f", $total_unapplied );
2506 =item total_unapplied_refunds
2508 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2509 customer. See L<FS::cust_refund/unapplied>.
2513 sub total_unapplied_refunds {
2515 my $custnum = $self->custnum;
2517 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2520 SELECT SUM($unapplied_sql) FROM cust_refund
2521 WHERE custnum = $custnum
2524 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2530 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2531 total_unapplied_credits minus total_unapplied_payments).
2537 $self->balance_date_range;
2540 =item balance_date TIME
2542 Returns the balance for this customer, only considering invoices with date
2543 earlier than TIME (total_owed_date minus total_credited minus
2544 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2545 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2552 $self->balance_date_range(shift);
2555 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2557 Returns the balance for this customer, optionally considering invoices with
2558 date earlier than START_TIME, and not later than END_TIME
2559 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2561 Times are specified as SQL fragments or numeric
2562 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2563 L<Date::Parse> for conversion functions. The empty string can be passed
2564 to disable that time constraint completely.
2566 Accepts the same options as L<balance_date_sql>:
2570 =item unapplied_date
2572 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)
2576 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2577 time will be ignored. Note that START_TIME and END_TIME only limit the date
2578 range for invoices and I<unapplied> payments, credits, and refunds.
2584 sub balance_date_range {
2586 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2587 ') FROM cust_main WHERE custnum='. $self->custnum;
2588 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2591 =item balance_pkgnum PKGNUM
2593 Returns the balance for this customer's specific package when using
2594 experimental package balances (total_owed plus total_unrefunded, minus
2595 total_unapplied_credits minus total_unapplied_payments)
2599 sub balance_pkgnum {
2600 my( $self, $pkgnum ) = @_;
2603 $self->total_owed_pkgnum($pkgnum)
2604 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2605 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2606 - $self->total_unapplied_credits_pkgnum($pkgnum)
2607 - $self->total_unapplied_payments_pkgnum($pkgnum)
2613 Returns a hash of useful information for making a payment.
2623 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2624 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2625 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2629 For credit card transactions:
2641 For electronic check transactions:
2656 $return{balance} = $self->balance;
2658 $return{payname} = $self->payname
2659 || ( $self->first. ' '. $self->get('last') );
2661 $return{$_} = $self->bill_location->$_
2662 for qw(address1 address2 city state zip);
2664 $return{payby} = $self->payby;
2665 $return{stateid_state} = $self->stateid_state;
2667 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2668 $return{card_type} = cardtype($self->payinfo);
2669 $return{payinfo} = $self->paymask;
2671 @return{'month', 'year'} = $self->paydate_monthyear;
2675 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2676 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2677 $return{payinfo1} = $payinfo1;
2678 $return{payinfo2} = $payinfo2;
2679 $return{paytype} = $self->paytype;
2680 $return{paystate} = $self->paystate;
2684 #doubleclick protection
2686 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2692 =item paydate_monthyear
2694 Returns a two-element list consisting of the month and year of this customer's
2695 paydate (credit card expiration date for CARD customers)
2699 sub paydate_monthyear {
2701 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2703 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2712 Returns the exact time in seconds corresponding to the payment method
2713 expiration date. For CARD/DCRD customers this is the end of the month;
2714 for others (COMP is the only other payby that uses paydate) it's the start.
2715 Returns 0 if the paydate is empty or set to the far future.
2721 my ($month, $year) = $self->paydate_monthyear;
2722 return 0 if !$year or $year >= 2037;
2723 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2725 if ( $month == 13 ) {
2729 return timelocal(0,0,0,1,$month-1,$year) - 1;
2732 return timelocal(0,0,0,1,$month-1,$year);
2736 =item paydate_epoch_sql
2738 Class method. Returns an SQL expression to obtain the payment expiration date
2739 as a number of seconds.
2743 # Special expiration date behavior for non-CARD/DCRD customers has been
2744 # carefully preserved. Do we really use that?
2745 sub paydate_epoch_sql {
2747 my $table = shift || 'cust_main';
2748 my ($case1, $case2);
2749 if ( driver_name eq 'Pg' ) {
2750 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2751 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2753 elsif ( lc(driver_name) eq 'mysql' ) {
2754 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2755 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2758 return "CASE WHEN $table.payby IN('CARD','DCRD')
2764 =item tax_exemption TAXNAME
2769 my( $self, $taxname ) = @_;
2771 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2772 'taxname' => $taxname,
2777 =item cust_main_exemption
2779 =item invoicing_list [ ARRAYREF ]
2781 If an arguement is given, sets these email addresses as invoice recipients
2782 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2783 (except as warnings), so use check_invoicing_list first.
2785 Returns a list of email addresses (with svcnum entries expanded).
2787 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2788 check it without disturbing anything by passing nothing.
2790 This interface may change in the future.
2794 sub invoicing_list {
2795 my( $self, $arrayref ) = @_;
2798 my @cust_main_invoice;
2799 if ( $self->custnum ) {
2800 @cust_main_invoice =
2801 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2803 @cust_main_invoice = ();
2805 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2806 #warn $cust_main_invoice->destnum;
2807 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2808 #warn $cust_main_invoice->destnum;
2809 my $error = $cust_main_invoice->delete;
2810 warn $error if $error;
2813 if ( $self->custnum ) {
2814 @cust_main_invoice =
2815 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2817 @cust_main_invoice = ();
2819 my %seen = map { $_->address => 1 } @cust_main_invoice;
2820 foreach my $address ( @{$arrayref} ) {
2821 next if exists $seen{$address} && $seen{$address};
2822 $seen{$address} = 1;
2823 my $cust_main_invoice = new FS::cust_main_invoice ( {
2824 'custnum' => $self->custnum,
2827 my $error = $cust_main_invoice->insert;
2828 warn $error if $error;
2832 if ( $self->custnum ) {
2834 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2841 =item check_invoicing_list ARRAYREF
2843 Checks these arguements as valid input for the invoicing_list method. If there
2844 is an error, returns the error, otherwise returns false.
2848 sub check_invoicing_list {
2849 my( $self, $arrayref ) = @_;
2851 foreach my $address ( @$arrayref ) {
2853 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2854 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2857 my $cust_main_invoice = new FS::cust_main_invoice ( {
2858 'custnum' => $self->custnum,
2861 my $error = $self->custnum
2862 ? $cust_main_invoice->check
2863 : $cust_main_invoice->checkdest
2865 return $error if $error;
2869 return "Email address required"
2870 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2871 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2876 =item set_default_invoicing_list
2878 Sets the invoicing list to all accounts associated with this customer,
2879 overwriting any previous invoicing list.
2883 sub set_default_invoicing_list {
2885 $self->invoicing_list($self->all_emails);
2890 Returns the email addresses of all accounts provisioned for this customer.
2897 foreach my $cust_pkg ( $self->all_pkgs ) {
2898 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2900 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2901 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2903 $list{$_}=1 foreach map { $_->email } @svc_acct;
2908 =item invoicing_list_addpost
2910 Adds postal invoicing to this customer. If this customer is already configured
2911 to receive postal invoices, does nothing.
2915 sub invoicing_list_addpost {
2917 return if grep { $_ eq 'POST' } $self->invoicing_list;
2918 my @invoicing_list = $self->invoicing_list;
2919 push @invoicing_list, 'POST';
2920 $self->invoicing_list(\@invoicing_list);
2923 =item invoicing_list_emailonly
2925 Returns the list of email invoice recipients (invoicing_list without non-email
2926 destinations such as POST and FAX).
2930 sub invoicing_list_emailonly {
2932 warn "$me invoicing_list_emailonly called"
2934 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2937 =item invoicing_list_emailonly_scalar
2939 Returns the list of email invoice recipients (invoicing_list without non-email
2940 destinations such as POST and FAX) as a comma-separated scalar.
2944 sub invoicing_list_emailonly_scalar {
2946 warn "$me invoicing_list_emailonly_scalar called"
2948 join(', ', $self->invoicing_list_emailonly);
2951 =item referral_custnum_cust_main
2953 Returns the customer who referred this customer (or the empty string, if
2954 this customer was not referred).
2956 Note the difference with referral_cust_main method: This method,
2957 referral_custnum_cust_main returns the single customer (if any) who referred
2958 this customer, while referral_cust_main returns an array of customers referred
2963 sub referral_custnum_cust_main {
2965 return '' unless $self->referral_custnum;
2966 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2969 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2971 Returns an array of customers referred by this customer (referral_custnum set
2972 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2973 customers referred by customers referred by this customer and so on, inclusive.
2974 The default behavior is DEPTH 1 (no recursion).
2976 Note the difference with referral_custnum_cust_main method: This method,
2977 referral_cust_main, returns an array of customers referred BY this customer,
2978 while referral_custnum_cust_main returns the single customer (if any) who
2979 referred this customer.
2983 sub referral_cust_main {
2985 my $depth = @_ ? shift : 1;
2986 my $exclude = @_ ? shift : {};
2989 map { $exclude->{$_->custnum}++; $_; }
2990 grep { ! $exclude->{ $_->custnum } }
2991 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2995 map { $_->referral_cust_main($depth-1, $exclude) }
3002 =item referral_cust_main_ncancelled
3004 Same as referral_cust_main, except only returns customers with uncancelled
3009 sub referral_cust_main_ncancelled {
3011 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3014 =item referral_cust_pkg [ DEPTH ]
3016 Like referral_cust_main, except returns a flat list of all unsuspended (and
3017 uncancelled) packages for each customer. The number of items in this list may
3018 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3022 sub referral_cust_pkg {
3024 my $depth = @_ ? shift : 1;
3026 map { $_->unsuspended_pkgs }
3027 grep { $_->unsuspended_pkgs }
3028 $self->referral_cust_main($depth);
3031 =item referring_cust_main
3033 Returns the single cust_main record for the customer who referred this customer
3034 (referral_custnum), or false.
3038 sub referring_cust_main {
3040 return '' unless $self->referral_custnum;
3041 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3044 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3046 Applies a credit to this customer. If there is an error, returns the error,
3047 otherwise returns false.
3049 REASON can be a text string, an FS::reason object, or a scalar reference to
3050 a reasonnum. If a text string, it will be automatically inserted as a new
3051 reason, and a 'reason_type' option must be passed to indicate the
3052 FS::reason_type for the new reason.
3054 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3055 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3056 I<commission_pkgnum>.
3058 Any other options are passed to FS::cust_credit::insert.
3063 my( $self, $amount, $reason, %options ) = @_;
3065 my $cust_credit = new FS::cust_credit {
3066 'custnum' => $self->custnum,
3067 'amount' => $amount,
3070 if ( ref($reason) ) {
3072 if ( ref($reason) eq 'SCALAR' ) {
3073 $cust_credit->reasonnum( $$reason );
3075 $cust_credit->reasonnum( $reason->reasonnum );
3079 $cust_credit->set('reason', $reason)
3082 $cust_credit->$_( delete $options{$_} )
3083 foreach grep exists($options{$_}),
3084 qw( addlinfo eventnum ),
3085 map "commission_$_", qw( agentnum salesnum pkgnum );
3087 $cust_credit->insert(%options);
3091 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3093 Creates a one-time charge for this customer. If there is an error, returns
3094 the error, otherwise returns false.
3096 New-style, with a hashref of options:
3098 my $error = $cust_main->charge(
3102 'start_date' => str2time('7/4/2009'),
3103 'pkg' => 'Description',
3104 'comment' => 'Comment',
3105 'additional' => [], #extra invoice detail
3106 'classnum' => 1, #pkg_class
3108 'setuptax' => '', # or 'Y' for tax exempt
3110 'locationnum'=> 1234, # optional
3113 'taxclass' => 'Tax class',
3116 'taxproduct' => 2, #part_pkg_taxproduct
3117 'override' => {}, #XXX describe
3119 #will be filled in with the new object
3120 'cust_pkg_ref' => \$cust_pkg,
3122 #generate an invoice immediately
3124 'invoice_terms' => '', #with these terms
3130 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3134 #super false laziness w/quotation::charge
3137 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3138 my ( $pkg, $comment, $additional );
3139 my ( $setuptax, $taxclass ); #internal taxes
3140 my ( $taxproduct, $override ); #vendor (CCH) taxes
3142 my $separate_bill = '';
3143 my $cust_pkg_ref = '';
3144 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3146 if ( ref( $_[0] ) ) {
3147 $amount = $_[0]->{amount};
3148 $setup_cost = $_[0]->{setup_cost};
3149 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3150 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3151 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3152 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3153 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3154 : '$'. sprintf("%.2f",$amount);
3155 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3156 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3157 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3158 $additional = $_[0]->{additional} || [];
3159 $taxproduct = $_[0]->{taxproductnum};
3160 $override = { '' => $_[0]->{tax_override} };
3161 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3162 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3163 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3164 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3165 $separate_bill = $_[0]->{separate_bill} || '';
3171 $pkg = @_ ? shift : 'One-time charge';
3172 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3174 $taxclass = @_ ? shift : '';
3178 local $SIG{HUP} = 'IGNORE';
3179 local $SIG{INT} = 'IGNORE';
3180 local $SIG{QUIT} = 'IGNORE';
3181 local $SIG{TERM} = 'IGNORE';
3182 local $SIG{TSTP} = 'IGNORE';
3183 local $SIG{PIPE} = 'IGNORE';
3185 my $oldAutoCommit = $FS::UID::AutoCommit;
3186 local $FS::UID::AutoCommit = 0;
3189 my $part_pkg = new FS::part_pkg ( {
3191 'comment' => $comment,
3195 'classnum' => ( $classnum ? $classnum : '' ),
3196 'setuptax' => $setuptax,
3197 'taxclass' => $taxclass,
3198 'taxproductnum' => $taxproduct,
3199 'setup_cost' => $setup_cost,
3202 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3203 ( 0 .. @$additional - 1 )
3205 'additional_count' => scalar(@$additional),
3206 'setup_fee' => $amount,
3209 my $error = $part_pkg->insert( options => \%options,
3210 tax_overrides => $override,
3213 $dbh->rollback if $oldAutoCommit;
3217 my $pkgpart = $part_pkg->pkgpart;
3218 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3219 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3220 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3221 $error = $type_pkgs->insert;
3223 $dbh->rollback if $oldAutoCommit;
3228 my $cust_pkg = new FS::cust_pkg ( {
3229 'custnum' => $self->custnum,
3230 'pkgpart' => $pkgpart,
3231 'quantity' => $quantity,
3232 'start_date' => $start_date,
3233 'no_auto' => $no_auto,
3234 'separate_bill' => $separate_bill,
3235 'locationnum'=> $locationnum,
3238 $error = $cust_pkg->insert;
3240 $dbh->rollback if $oldAutoCommit;
3242 } elsif ( $cust_pkg_ref ) {
3243 ${$cust_pkg_ref} = $cust_pkg;
3247 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3248 'pkg_list' => [ $cust_pkg ],
3251 $dbh->rollback if $oldAutoCommit;
3256 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3261 #=item charge_postal_fee
3263 #Applies a one time charge this customer. If there is an error,
3264 #returns the error, returns the cust_pkg charge object or false
3265 #if there was no charge.
3269 # This should be a customer event. For that to work requires that bill
3270 # also be a customer event.
3272 sub charge_postal_fee {
3275 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3276 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3278 my $cust_pkg = new FS::cust_pkg ( {
3279 'custnum' => $self->custnum,
3280 'pkgpart' => $pkgpart,
3284 my $error = $cust_pkg->insert;
3285 $error ? $error : $cust_pkg;
3288 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3290 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3292 Optionally, a list or hashref of additional arguments to the qsearch call can
3299 my $opt = ref($_[0]) ? shift : { @_ };
3301 #return $self->num_cust_bill unless wantarray || keys %$opt;
3303 $opt->{'table'} = 'cust_bill';
3304 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3305 $opt->{'hashref'}{'custnum'} = $self->custnum;
3306 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3308 map { $_ } #behavior of sort undefined in scalar context
3309 sort { $a->_date <=> $b->_date }
3313 =item open_cust_bill
3315 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3320 sub open_cust_bill {
3324 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3330 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3332 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3336 sub legacy_cust_bill {
3339 #return $self->num_legacy_cust_bill unless wantarray;
3341 map { $_ } #behavior of sort undefined in scalar context
3342 sort { $a->_date <=> $b->_date }
3343 qsearch({ 'table' => 'legacy_cust_bill',
3344 'hashref' => { 'custnum' => $self->custnum, },
3345 'order_by' => 'ORDER BY _date ASC',
3349 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3351 Returns all the statements (see L<FS::cust_statement>) for this customer.
3353 Optionally, a list or hashref of additional arguments to the qsearch call can
3358 =item cust_bill_void
3360 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3364 sub cust_bill_void {
3367 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3368 sort { $a->_date <=> $b->_date }
3369 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3372 sub cust_statement {
3374 my $opt = ref($_[0]) ? shift : { @_ };
3376 #return $self->num_cust_statement unless wantarray || keys %$opt;
3378 $opt->{'table'} = 'cust_statement';
3379 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3380 $opt->{'hashref'}{'custnum'} = $self->custnum;
3381 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3383 map { $_ } #behavior of sort undefined in scalar context
3384 sort { $a->_date <=> $b->_date }
3388 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3390 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3392 Optionally, a list or hashref of additional arguments to the qsearch call can
3393 be passed following the SVCDB.
3400 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3401 warn "$me svc_x requires a svcdb";
3404 my $opt = ref($_[0]) ? shift : { @_ };
3406 $opt->{'table'} = $svcdb;
3407 $opt->{'addl_from'} =
3408 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3409 ($opt->{'addl_from'} || '');
3411 my $custnum = $self->custnum;
3412 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3413 my $where = "cust_pkg.custnum = $custnum";
3415 my $extra_sql = $opt->{'extra_sql'} || '';
3416 if ( keys %{ $opt->{'hashref'} } ) {
3417 $extra_sql = " AND $where $extra_sql";
3420 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3421 $extra_sql = "WHERE $where AND $1";
3424 $extra_sql = "WHERE $where $extra_sql";
3427 $opt->{'extra_sql'} = $extra_sql;
3432 # required for use as an eventtable;
3435 $self->svc_x('svc_acct', @_);
3440 Returns all the credits (see L<FS::cust_credit>) for this customer.
3446 map { $_ } #return $self->num_cust_credit unless wantarray;
3447 sort { $a->_date <=> $b->_date }
3448 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3451 =item cust_credit_pkgnum
3453 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3454 package when using experimental package balances.
3458 sub cust_credit_pkgnum {
3459 my( $self, $pkgnum ) = @_;
3460 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3461 sort { $a->_date <=> $b->_date }
3462 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3463 'pkgnum' => $pkgnum,
3468 =item cust_credit_void
3470 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3474 sub cust_credit_void {
3477 sort { $a->_date <=> $b->_date }
3478 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3483 Returns all the payments (see L<FS::cust_pay>) for this customer.
3489 my $opt = ref($_[0]) ? shift : { @_ };
3491 return $self->num_cust_pay unless wantarray || keys %$opt;
3493 $opt->{'table'} = 'cust_pay';
3494 $opt->{'hashref'}{'custnum'} = $self->custnum;
3496 map { $_ } #behavior of sort undefined in scalar context
3497 sort { $a->_date <=> $b->_date }
3504 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3505 called automatically when the cust_pay method is used in a scalar context.
3511 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3512 my $sth = dbh->prepare($sql) or die dbh->errstr;
3513 $sth->execute($self->custnum) or die $sth->errstr;
3514 $sth->fetchrow_arrayref->[0];
3517 =item unapplied_cust_pay
3519 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3523 sub unapplied_cust_pay {
3527 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3533 =item cust_pay_pkgnum
3535 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3536 package when using experimental package balances.
3540 sub cust_pay_pkgnum {
3541 my( $self, $pkgnum ) = @_;
3542 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3543 sort { $a->_date <=> $b->_date }
3544 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3545 'pkgnum' => $pkgnum,
3552 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3558 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3559 sort { $a->_date <=> $b->_date }
3560 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3563 =item cust_pay_pending
3565 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3566 (without status "done").
3570 sub cust_pay_pending {
3572 return $self->num_cust_pay_pending unless wantarray;
3573 sort { $a->_date <=> $b->_date }
3574 qsearch( 'cust_pay_pending', {
3575 'custnum' => $self->custnum,
3576 'status' => { op=>'!=', value=>'done' },
3581 =item cust_pay_pending_attempt
3583 Returns all payment attempts / declined payments for this customer, as pending
3584 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3585 a corresponding payment (see L<FS::cust_pay>).
3589 sub cust_pay_pending_attempt {
3591 return $self->num_cust_pay_pending_attempt unless wantarray;
3592 sort { $a->_date <=> $b->_date }
3593 qsearch( 'cust_pay_pending', {
3594 'custnum' => $self->custnum,
3601 =item num_cust_pay_pending
3603 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3604 customer (without status "done"). Also called automatically when the
3605 cust_pay_pending method is used in a scalar context.
3609 sub num_cust_pay_pending {
3612 " SELECT COUNT(*) FROM cust_pay_pending ".
3613 " WHERE custnum = ? AND status != 'done' ",
3618 =item num_cust_pay_pending_attempt
3620 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3621 customer, with status "done" but without a corresp. Also called automatically when the
3622 cust_pay_pending method is used in a scalar context.
3626 sub num_cust_pay_pending_attempt {
3629 " SELECT COUNT(*) FROM cust_pay_pending ".
3630 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3637 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3643 map { $_ } #return $self->num_cust_refund unless wantarray;
3644 sort { $a->_date <=> $b->_date }
3645 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3648 =item display_custnum
3650 Returns the displayed customer number for this customer: agent_custid if
3651 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3655 sub display_custnum {
3658 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3659 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3660 if ( $special eq 'CoStAg' ) {
3661 $prefix = uc( join('',
3663 ($self->state =~ /^(..)/),
3664 $prefix || ($self->agent->agent =~ /^(..)/)
3667 elsif ( $special eq 'CoStCl' ) {
3668 $prefix = uc( join('',
3670 ($self->state =~ /^(..)/),
3671 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3674 # add any others here if needed
3677 my $length = $conf->config('cust_main-custnum-display_length');
3678 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3679 return $self->agent_custid;
3680 } elsif ( $prefix ) {
3681 $length = 8 if !defined($length);
3683 sprintf('%0'.$length.'d', $self->custnum)
3684 } elsif ( $length ) {
3685 return sprintf('%0'.$length.'d', $self->custnum);
3687 return $self->custnum;
3693 Returns a name string for this customer, either "Company (Last, First)" or
3700 my $name = $self->contact;
3701 $name = $self->company. " ($name)" if $self->company;
3705 =item service_contact
3707 Returns the L<FS::contact> object for this customer that has the 'Service'
3708 contact class, or undef if there is no such contact. Deprecated; don't use
3713 sub service_contact {
3715 if ( !exists($self->{service_contact}) ) {
3716 my $classnum = $self->scalar_sql(
3717 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3718 ) || 0; #if it's zero, qsearchs will return nothing
3719 my $cust_contact = qsearchs('cust_contact', {
3720 'classnum' => $classnum,
3721 'custnum' => $self->custnum,
3723 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3725 $self->{service_contact};
3730 Returns a name string for this (service/shipping) contact, either
3731 "Company (Last, First)" or "Last, First".
3738 my $name = $self->ship_contact;
3739 $name = $self->company. " ($name)" if $self->company;
3745 Returns a name string for this customer, either "Company" or "First Last".
3751 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3754 =item ship_name_short
3756 Returns a name string for this (service/shipping) contact, either "Company"
3761 sub ship_name_short {
3763 $self->service_contact
3764 ? $self->ship_contact_firstlast
3770 Returns this customer's full (billing) contact name only, "Last, First"
3776 $self->get('last'). ', '. $self->first;
3781 Returns this customer's full (shipping) contact name only, "Last, First"
3787 my $contact = $self->service_contact || $self;
3788 $contact->get('last') . ', ' . $contact->get('first');
3791 =item contact_firstlast
3793 Returns this customers full (billing) contact name only, "First Last".
3797 sub contact_firstlast {
3799 $self->first. ' '. $self->get('last');
3802 =item ship_contact_firstlast
3804 Returns this customer's full (shipping) contact name only, "First Last".
3808 sub ship_contact_firstlast {
3810 my $contact = $self->service_contact || $self;
3811 $contact->get('first') . ' '. $contact->get('last');
3814 #XXX this doesn't work in 3.x+
3817 #Returns this customer's full country name
3823 # code2country($self->country);
3826 sub bill_country_full {
3828 code2country($self->bill_location->country);
3831 sub ship_country_full {
3833 code2country($self->ship_location->country);
3836 =item county_state_county [ PREFIX ]
3838 Returns a string consisting of just the county, state and country.
3842 sub county_state_country {
3845 if ( @_ && $_[0] && $self->has_ship_address ) {
3846 $locationnum = $self->ship_locationnum;
3848 $locationnum = $self->bill_locationnum;
3850 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3851 $cust_location->county_state_country;
3854 =item geocode DATA_VENDOR
3856 Returns a value for the customer location as encoded by DATA_VENDOR.
3857 Currently this only makes sense for "CCH" as DATA_VENDOR.
3865 Returns a status string for this customer, currently:
3871 No packages have ever been ordered. Displayed as "No packages".
3875 Recurring packages all are new (not yet billed).
3879 One or more recurring packages is active.
3883 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3887 All non-cancelled recurring packages are suspended.
3891 All recurring packages are cancelled.
3895 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3896 cust_main-status_module configuration option.
3900 sub status { shift->cust_status(@_); }
3904 for my $status ( FS::cust_main->statuses() ) {
3905 my $method = $status.'_sql';
3906 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3907 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3908 $sth->execute( ($self->custnum) x $numnum )
3909 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3910 return $status if $sth->fetchrow_arrayref->[0];
3914 =item is_status_delay_cancel
3916 Returns true if customer status is 'suspended'
3917 and all suspended cust_pkg return true for
3918 cust_pkg->is_status_delay_cancel.
3920 This is not a real status, this only meant for hacking display
3921 values, because otherwise treating the customer as suspended is
3922 really the whole point of the delay_cancel option.
3926 sub is_status_delay_cancel {
3928 return 0 unless $self->status eq 'suspended';
3929 foreach my $cust_pkg ($self->ncancelled_pkgs) {
3930 return 0 unless $cust_pkg->is_status_delay_cancel;
3935 =item ucfirst_cust_status
3937 =item ucfirst_status
3939 Deprecated, use the cust_status_label method instead.
3941 Returns the status with the first character capitalized.
3945 sub ucfirst_status {
3946 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3947 local($ucfirst_nowarn) = 1;
3948 shift->ucfirst_cust_status(@_);
3951 sub ucfirst_cust_status {
3952 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3954 ucfirst($self->cust_status);
3957 =item cust_status_label
3961 Returns the display label for this status.
3965 sub status_label { shift->cust_status_label(@_); }
3967 sub cust_status_label {
3969 __PACKAGE__->statuslabels->{$self->cust_status};
3974 Returns a hex triplet color string for this customer's status.
3978 sub statuscolor { shift->cust_statuscolor(@_); }
3980 sub cust_statuscolor {
3982 __PACKAGE__->statuscolors->{$self->cust_status};
3985 =item tickets [ STATUS ]
3987 Returns an array of hashes representing the customer's RT tickets.
3989 An optional status (or arrayref or hashref of statuses) may be specified.
3995 my $status = ( @_ && $_[0] ) ? shift : '';
3997 my $num = $conf->config('cust_main-max_tickets') || 10;
4000 if ( $conf->config('ticket_system') ) {
4001 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4003 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4012 foreach my $priority (
4013 $conf->config('ticket_system-custom_priority_field-values'), ''
4015 last if scalar(@tickets) >= $num;
4017 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4018 $num - scalar(@tickets),
4029 # Return services representing svc_accts in customer support packages
4030 sub support_services {
4032 my %packages = map { $_ => 1 } $conf->config('support_packages');
4034 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4035 grep { $_->part_svc->svcdb eq 'svc_acct' }
4036 map { $_->cust_svc }
4037 grep { exists $packages{ $_->pkgpart } }
4038 $self->ncancelled_pkgs;
4042 # Return a list of latitude/longitude for one of the services (if any)
4043 sub service_coordinates {
4047 grep { $_->latitude && $_->longitude }
4049 map { $_->cust_svc }
4050 $self->ncancelled_pkgs;
4052 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4057 Returns a masked version of the named field
4062 my ($self,$field) = @_;
4066 'x'x(length($self->getfield($field))-4).
4067 substr($self->getfield($field), (length($self->getfield($field))-4));
4073 =head1 CLASS METHODS
4079 Class method that returns the list of possible status strings for customers
4080 (see L<the status method|/status>). For example:
4082 @statuses = FS::cust_main->statuses();
4088 keys %{ $self->statuscolors };
4091 =item cust_status_sql
4093 Returns an SQL fragment to determine the status of a cust_main record, as a
4098 sub cust_status_sql {
4100 for my $status ( FS::cust_main->statuses() ) {
4101 my $method = $status.'_sql';
4102 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4111 Returns an SQL expression identifying prospective cust_main records (customers
4112 with no packages ever ordered)
4116 use vars qw($select_count_pkgs);
4117 $select_count_pkgs =
4118 "SELECT COUNT(*) FROM cust_pkg
4119 WHERE cust_pkg.custnum = cust_main.custnum";
4121 sub select_count_pkgs_sql {
4126 " 0 = ( $select_count_pkgs ) ";
4131 Returns an SQL expression identifying ordered cust_main records (customers with
4132 no active packages, but recurring packages not yet setup or one time charges
4138 FS::cust_main->none_active_sql.
4139 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4144 Returns an SQL expression identifying active cust_main records (customers with
4145 active recurring packages).
4150 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4153 =item none_active_sql
4155 Returns an SQL expression identifying cust_main records with no active
4156 recurring packages. This includes customers of status prospect, ordered,
4157 inactive, and suspended.
4161 sub none_active_sql {
4162 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4167 Returns an SQL expression identifying inactive cust_main records (customers with
4168 no active recurring packages, but otherwise unsuspended/uncancelled).
4173 FS::cust_main->none_active_sql.
4174 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4180 Returns an SQL expression identifying suspended cust_main records.
4185 sub suspended_sql { susp_sql(@_); }
4187 FS::cust_main->none_active_sql.
4188 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4194 Returns an SQL expression identifying cancelled cust_main records.
4198 sub cancel_sql { shift->cancelled_sql(@_); }
4201 =item uncancelled_sql
4203 Returns an SQL expression identifying un-cancelled cust_main records.
4207 sub uncancelled_sql { uncancel_sql(@_); }
4208 sub uncancel_sql { "
4209 ( 0 < ( $select_count_pkgs
4210 AND ( cust_pkg.cancel IS NULL
4211 OR cust_pkg.cancel = 0
4214 OR 0 = ( $select_count_pkgs )
4220 Returns an SQL fragment to retreive the balance.
4225 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4226 WHERE cust_bill.custnum = cust_main.custnum )
4227 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4228 WHERE cust_pay.custnum = cust_main.custnum )
4229 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4230 WHERE cust_credit.custnum = cust_main.custnum )
4231 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4232 WHERE cust_refund.custnum = cust_main.custnum )
4235 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4237 Returns an SQL fragment to retreive the balance for this customer, optionally
4238 considering invoices with date earlier than START_TIME, and not
4239 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4240 total_unapplied_payments).
4242 Times are specified as SQL fragments or numeric
4243 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4244 L<Date::Parse> for conversion functions. The empty string can be passed
4245 to disable that time constraint completely.
4247 Available options are:
4251 =item unapplied_date
4253 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)
4258 set to true to remove all customer comparison clauses, for totals
4263 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4268 JOIN clause (typically used with the total option)
4272 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4273 time will be ignored. Note that START_TIME and END_TIME only limit the date
4274 range for invoices and I<unapplied> payments, credits, and refunds.
4280 sub balance_date_sql {
4281 my( $class, $start, $end, %opt ) = @_;
4283 my $cutoff = $opt{'cutoff'};
4285 my $owed = FS::cust_bill->owed_sql($cutoff);
4286 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4287 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4288 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4290 my $j = $opt{'join'} || '';
4292 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4293 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4294 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4295 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4297 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4298 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4299 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4300 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4305 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4307 Returns an SQL fragment to retreive the total unapplied payments for this
4308 customer, only considering payments with date earlier than START_TIME, and
4309 optionally not later than END_TIME.
4311 Times are specified as SQL fragments or numeric
4312 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4313 L<Date::Parse> for conversion functions. The empty string can be passed
4314 to disable that time constraint completely.
4316 Available options are:
4320 sub unapplied_payments_date_sql {
4321 my( $class, $start, $end, %opt ) = @_;
4323 my $cutoff = $opt{'cutoff'};
4325 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4327 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4328 'unapplied_date'=>1 );
4330 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4333 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4335 Helper method for balance_date_sql; name (and usage) subject to change
4336 (suggestions welcome).
4338 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4339 cust_refund, cust_credit or cust_pay).
4341 If TABLE is "cust_bill" or the unapplied_date option is true, only
4342 considers records with date earlier than START_TIME, and optionally not
4343 later than END_TIME .
4347 sub _money_table_where {
4348 my( $class, $table, $start, $end, %opt ) = @_;
4351 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4352 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4353 push @where, "$table._date <= $start" if defined($start) && length($start);
4354 push @where, "$table._date > $end" if defined($end) && length($end);
4356 push @where, @{$opt{'where'}} if $opt{'where'};
4357 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4363 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4364 use FS::cust_main::Search;
4367 FS::cust_main::Search->search(@_);
4376 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4378 Deprecated. Use event notification and message templates
4379 (L<FS::msg_template>) instead.
4381 Sends a templated email notification to the customer (see L<Text::Template>).
4383 OPTIONS is a hash and may include
4385 I<from> - the email sender (default is invoice_from)
4387 I<to> - comma-separated scalar or arrayref of recipients
4388 (default is invoicing_list)
4390 I<subject> - The subject line of the sent email notification
4391 (default is "Notice from company_name")
4393 I<extra_fields> - a hashref of name/value pairs which will be substituted
4396 The following variables are vavailable in the template.
4398 I<$first> - the customer first name
4399 I<$last> - the customer last name
4400 I<$company> - the customer company
4401 I<$payby> - a description of the method of payment for the customer
4402 # would be nice to use FS::payby::shortname
4403 I<$payinfo> - the account information used to collect for this customer
4404 I<$expdate> - the expiration of the customer payment in seconds from epoch
4409 my ($self, $template, %options) = @_;
4411 return unless $conf->exists($template);
4413 my $from = $conf->invoice_from_full($self->agentnum)
4414 if $conf->exists('invoice_from', $self->agentnum);
4415 $from = $options{from} if exists($options{from});
4417 my $to = join(',', $self->invoicing_list_emailonly);
4418 $to = $options{to} if exists($options{to});
4420 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4421 if $conf->exists('company_name', $self->agentnum);
4422 $subject = $options{subject} if exists($options{subject});
4424 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4425 SOURCE => [ map "$_\n",
4426 $conf->config($template)]
4428 or die "can't create new Text::Template object: Text::Template::ERROR";
4429 $notify_template->compile()
4430 or die "can't compile template: Text::Template::ERROR";
4432 $FS::notify_template::_template::company_name =
4433 $conf->config('company_name', $self->agentnum);
4434 $FS::notify_template::_template::company_address =
4435 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4437 my $paydate = $self->paydate || '2037-12-31';
4438 $FS::notify_template::_template::first = $self->first;
4439 $FS::notify_template::_template::last = $self->last;
4440 $FS::notify_template::_template::company = $self->company;
4441 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4442 my $payby = $self->payby;
4443 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4444 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4446 #credit cards expire at the end of the month/year of their exp date
4447 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4448 $FS::notify_template::_template::payby = 'credit card';
4449 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4450 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4452 }elsif ($payby eq 'COMP') {
4453 $FS::notify_template::_template::payby = 'complimentary account';
4455 $FS::notify_template::_template::payby = 'current method';
4457 $FS::notify_template::_template::expdate = $expire_time;
4459 for (keys %{$options{extra_fields}}){
4461 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4464 send_email(from => $from,
4466 subject => $subject,
4467 body => $notify_template->fill_in( PACKAGE =>
4468 'FS::notify_template::_template' ),
4473 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4475 Generates a templated notification to the customer (see L<Text::Template>).
4477 OPTIONS is a hash and may include
4479 I<extra_fields> - a hashref of name/value pairs which will be substituted
4480 into the template. These values may override values mentioned below
4481 and those from the customer record.
4483 The following variables are available in the template instead of or in addition
4484 to the fields of the customer record.
4486 I<$payby> - a description of the method of payment for the customer
4487 # would be nice to use FS::payby::shortname
4488 I<$payinfo> - the masked account information used to collect for this customer
4489 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4490 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4494 # a lot like cust_bill::print_latex
4495 sub generate_letter {
4496 my ($self, $template, %options) = @_;
4498 return unless $conf->exists($template);
4500 my $letter_template = new Text::Template
4502 SOURCE => [ map "$_\n", $conf->config($template)],
4503 DELIMITERS => [ '[@--', '--@]' ],
4505 or die "can't create new Text::Template object: Text::Template::ERROR";
4507 $letter_template->compile()
4508 or die "can't compile template: Text::Template::ERROR";
4510 my %letter_data = map { $_ => $self->$_ } $self->fields;
4511 $letter_data{payinfo} = $self->mask_payinfo;
4513 #my $paydate = $self->paydate || '2037-12-31';
4514 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4516 my $payby = $self->payby;
4517 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4518 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4520 #credit cards expire at the end of the month/year of their exp date
4521 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4522 $letter_data{payby} = 'credit card';
4523 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4524 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4526 }elsif ($payby eq 'COMP') {
4527 $letter_data{payby} = 'complimentary account';
4529 $letter_data{payby} = 'current method';
4531 $letter_data{expdate} = $expire_time;
4533 for (keys %{$options{extra_fields}}){
4534 $letter_data{$_} = $options{extra_fields}->{$_};
4537 unless(exists($letter_data{returnaddress})){
4538 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4539 $self->agent_template)
4541 if ( length($retadd) ) {
4542 $letter_data{returnaddress} = $retadd;
4543 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4544 $letter_data{returnaddress} =
4545 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4549 ( $conf->config('company_name', $self->agentnum),
4550 $conf->config('company_address', $self->agentnum),
4554 $letter_data{returnaddress} = '~';
4558 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4560 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4562 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4564 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4568 ) or die "can't open temp file: $!\n";
4569 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4570 or die "can't write temp file: $!\n";
4572 $letter_data{'logo_file'} = $lh->filename;
4574 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4578 ) or die "can't open temp file: $!\n";
4580 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4582 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4583 return ($1, $letter_data{'logo_file'});
4587 =item print_ps TEMPLATE
4589 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4595 my($file, $lfile) = $self->generate_letter(@_);
4596 my $ps = FS::Misc::generate_ps($file);
4597 unlink($file.'.tex');
4603 =item print TEMPLATE
4605 Prints the filled in template.
4607 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4611 sub queueable_print {
4614 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4615 or die "invalid customer number: " . $opt{custnum};
4617 my $error = $self->print( { 'template' => $opt{template} } );
4618 die $error if $error;
4622 my ($self, $template) = (shift, shift);
4624 [ $self->print_ps($template) ],
4625 'agentnum' => $self->agentnum,
4629 #these three subs should just go away once agent stuff is all config overrides
4631 sub agent_template {
4633 $self->_agent_plandata('agent_templatename');
4636 sub agent_invoice_from {
4638 $self->_agent_plandata('agent_invoice_from');
4641 sub _agent_plandata {
4642 my( $self, $option ) = @_;
4644 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4645 #agent-specific Conf
4647 use FS::part_event::Condition;
4649 my $agentnum = $self->agentnum;
4651 my $regexp = regexp_sql();
4653 my $part_event_option =
4655 'select' => 'part_event_option.*',
4656 'table' => 'part_event_option',
4658 LEFT JOIN part_event USING ( eventpart )
4659 LEFT JOIN part_event_option AS peo_agentnum
4660 ON ( part_event.eventpart = peo_agentnum.eventpart
4661 AND peo_agentnum.optionname = 'agentnum'
4662 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4664 LEFT JOIN part_event_condition
4665 ON ( part_event.eventpart = part_event_condition.eventpart
4666 AND part_event_condition.conditionname = 'cust_bill_age'
4668 LEFT JOIN part_event_condition_option
4669 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4670 AND part_event_condition_option.optionname = 'age'
4673 #'hashref' => { 'optionname' => $option },
4674 #'hashref' => { 'part_event_option.optionname' => $option },
4676 " WHERE part_event_option.optionname = ". dbh->quote($option).
4677 " AND action = 'cust_bill_send_agent' ".
4678 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4679 " AND peo_agentnum.optionname = 'agentnum' ".
4680 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4682 CASE WHEN part_event_condition_option.optionname IS NULL
4684 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4686 , part_event.weight".
4690 unless ( $part_event_option ) {
4691 return $self->agent->invoice_template || ''
4692 if $option eq 'agent_templatename';
4696 $part_event_option->optionvalue;
4700 sub process_o2m_qsearch {
4703 return qsearch($table, @_) unless $table eq 'contact';
4705 my $hashref = shift;
4706 my %hash = %$hashref;
4707 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4708 or die 'guru meditation #4343';
4710 qsearch({ 'table' => 'contact',
4711 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4712 'hashref' => \%hash,
4713 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4714 " cust_contact.custnum = $custnum "
4718 sub process_o2m_qsearchs {
4721 return qsearchs($table, @_) unless $table eq 'contact';
4723 my $hashref = shift;
4724 my %hash = %$hashref;
4725 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4726 or die 'guru meditation #2121';
4728 qsearchs({ 'table' => 'contact',
4729 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4730 'hashref' => \%hash,
4731 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4732 " cust_contact.custnum = $custnum "
4736 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4738 Subroutine (not a method), designed to be called from the queue.
4740 Takes a list of options and values.
4742 Pulls up the customer record via the custnum option and calls bill_and_collect.
4747 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4749 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4750 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4752 #without this errors don't get rolled back
4753 $args{'fatal'} = 1; # runs from job queue, will be caught
4755 $cust_main->bill_and_collect( %args );
4758 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4760 Like queued_bill, but instead of C<bill_and_collect>, just runs the
4761 C<collect> part. This is used in batch tax calculation, where invoice
4762 generation and collection events have to be completely separated.
4766 sub queued_collect {
4768 my $cust_main = FS::cust_main->by_key($args{'custnum'});
4770 $cust_main->collect(%args);
4773 sub process_bill_and_collect {
4776 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4777 or die "custnum '$param->{custnum}' not found!\n";
4778 $param->{'job'} = $job;
4779 $param->{'fatal'} = 1; # runs from job queue, will be caught
4780 $param->{'retry'} = 1;
4782 $cust_main->bill_and_collect( %$param );
4785 #hook for insert/replace
4786 #runs after locations have been set
4787 #but before custnum has been set (for insert)
4791 #turn off invoice_ship_address if ship & bill are the same
4792 if ($self->bill_locationnum eq $self->ship_locationnum) {
4793 $self->invoice_ship_address('');
4795 #preserve old value if global config is set (replace only)
4796 elsif ($old && $conf->exists('invoice-ship_address')) {
4797 $self->invoice_ship_address($old->invoice_ship_address);
4801 #starting to take quite a while for big dbs
4802 # (JRNL: journaled so it only happens once per database)
4803 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
4804 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
4805 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
4806 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
4807 # JRNL leading/trailing spaces in first, last, company
4808 # JRNL migrate to cust_payby
4809 # - otaker upgrade? journal and call it good? (double check to make sure
4810 # we're not still setting otaker here)
4812 #only going to get worse with new location stuff...
4814 sub _upgrade_data { #class method
4815 my ($class, %opts) = @_;
4818 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4821 #this seems to be the only expensive one.. why does it take so long?
4822 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
4824 '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';
4825 FS::upgrade_journal->set_done('cust_main__signupdate');
4828 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
4830 # fix yyyy-m-dd formatted paydates
4831 if ( driver_name =~ /^mysql/i ) {
4833 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4834 } else { # the SQL standard
4836 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4838 FS::upgrade_journal->set_done('cust_main__paydate');
4841 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
4843 push @statements, #fix the weird BILL with a cc# in payinfo problem
4845 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
4847 FS::upgrade_journal->set_done('cust_main__payinfo');
4852 foreach my $sql ( @statements ) {
4853 my $sth = dbh->prepare($sql) or die dbh->errstr;
4854 $sth->execute or die $sth->errstr;
4855 #warn ( (time - $t). " seconds\n" );
4859 local($ignore_expired_card) = 1;
4860 local($ignore_banned_card) = 1;
4861 local($skip_fuzzyfiles) = 1;
4862 local($import) = 1; #prevent automatic geocoding (need its own variable?)
4864 FS::cust_main::Location->_upgrade_data(%opts);
4866 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
4868 foreach my $cust_main ( qsearch({
4869 'table' => 'cust_main',
4871 'extra_sql' => 'WHERE '.
4873 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
4874 qw( first last company )
4877 my $error = $cust_main->replace;
4878 die $error if $error;
4881 FS::upgrade_journal->set_done('cust_main__trimspaces');
4885 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
4887 #we don't want to decrypt them, just stuff them as-is into cust_payby
4888 local(@encrypted_fields) = ();
4890 local($FS::cust_payby::ignore_expired_card) = 1;
4891 local($FS::cust_payby::ignore_banned_card) = 1;
4893 my @payfields = qw( payby payinfo paycvv paymask
4894 paydate paystart_month paystart_year payissue
4895 payname paystate paytype payip
4898 my $search = new FS::Cursor {
4899 'table' => 'cust_main',
4900 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
4903 while (my $cust_main = $search->fetch) {
4905 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
4907 my $cust_payby = new FS::cust_payby {
4908 'custnum' => $cust_main->custnum,
4910 map { $_ => $cust_main->$_(); } @payfields
4913 my $error = $cust_payby->insert;
4914 die $error if $error;
4918 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
4920 $cust_main->invoice_attn( $cust_main->payname )
4921 if $cust_main->payby eq 'BILL' && $cust_main->payname;
4922 $cust_main->po_number( $cust_main->payinfo )
4923 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
4925 $cust_main->setfield($_, '') foreach @payfields;
4926 my $error = $cust_main->replace;
4927 die "Error upgradging payment information for custnum ".
4928 $cust_main->custnum. ": $error"
4933 FS::upgrade_journal->set_done('cust_main__cust_payby');
4936 $class->_upgrade_otaker(%opts);
4946 The delete method should possibly take an FS::cust_main object reference
4947 instead of a scalar customer number.
4949 Bill and collect options should probably be passed as references instead of a
4952 There should probably be a configuration file with a list of allowed credit
4955 No multiple currency support (probably a larger project than just this module).
4957 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4959 Birthdates rely on negative epoch values.
4961 The payby for card/check batches is broken. With mixed batching, bad
4964 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4968 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4969 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4970 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.