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_ps do_print money_pretty );
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: No longer supported.
330 Currently available options are: I<depend_jobnum>, I<noexport>,
331 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
333 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
334 on the supplied jobnum (they will not run until the specific job completes).
335 This can be used to defer provisioning until some action completes (such
336 as running the customer's credit card successfully).
338 The I<noexport> option is deprecated. If I<noexport> is set true, no
339 provisioning jobs (exports) are scheduled. (You can schedule them later with
340 the B<reexport> method.)
342 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
343 of tax names and exemption numbers. FS::cust_main_exemption records will be
344 created and inserted.
346 If I<prospectnum> is set, moves contacts and locations from that prospect.
348 If I<contact> is set to an arrayref of FS::contact objects, those will be
351 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
352 unset), inserts those new contacts with this new customer. Handles CGI
353 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
355 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
356 new stored payment records with this new customer. Handles CGI parameters
357 for an "m2" multiple entry field as passed by edit/cust_main.cgi
363 my $cust_pkgs = @_ ? shift : {};
364 my $invoicing_list = $_[0];
365 if ( $invoicing_list and ref($invoicing_list) eq 'ARRAY' ) {
369 warn "$me insert called with options ".
370 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
373 local $SIG{HUP} = 'IGNORE';
374 local $SIG{INT} = 'IGNORE';
375 local $SIG{QUIT} = 'IGNORE';
376 local $SIG{TERM} = 'IGNORE';
377 local $SIG{TSTP} = 'IGNORE';
378 local $SIG{PIPE} = 'IGNORE';
380 my $oldAutoCommit = $FS::UID::AutoCommit;
381 local $FS::UID::AutoCommit = 0;
384 my $prepay_identifier = '';
385 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
387 if ( $self->payby eq 'PREPAY' ) {
389 $self->payby(''); #'BILL');
390 $prepay_identifier = $self->payinfo;
393 warn " looking up prepaid card $prepay_identifier\n"
396 my $error = $self->get_prepay( $prepay_identifier,
397 'amount_ref' => \$amount,
398 'seconds_ref' => \$seconds,
399 'upbytes_ref' => \$upbytes,
400 'downbytes_ref' => \$downbytes,
401 'totalbytes_ref' => \$totalbytes,
404 $dbh->rollback if $oldAutoCommit;
405 #return "error applying prepaid card (transaction rolled back): $error";
409 $payby = 'PREP' if $amount;
411 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
414 $self->payby(''); #'BILL');
415 $amount = $self->paid;
420 foreach my $l (qw(bill_location ship_location)) {
422 my $loc = delete $self->hashref->{$l} or next;
424 if ( !$loc->locationnum ) {
425 # warn the location that we're going to insert it with no custnum
426 $loc->set(custnum_pending => 1);
427 warn " inserting $l\n"
429 my $error = $loc->insert;
431 $dbh->rollback if $oldAutoCommit;
432 my $label = $l eq 'ship_location' ? 'service' : 'billing';
433 return "$error (in $label location)";
436 } elsif ( $loc->prospectnum ) {
438 $loc->prospectnum('');
439 $loc->set(custnum_pending => 1);
440 my $error = $loc->replace;
442 $dbh->rollback if $oldAutoCommit;
443 my $label = $l eq 'ship_location' ? 'service' : 'billing';
444 return "$error (moving $label location)";
447 } elsif ( ($loc->custnum || 0) > 0 ) {
448 # then it somehow belongs to another customer--shouldn't happen
449 $dbh->rollback if $oldAutoCommit;
450 return "$l belongs to customer ".$loc->custnum;
452 # else it already belongs to this customer
453 # (happens when ship_location is identical to bill_location)
455 $self->set($l.'num', $loc->locationnum);
457 if ( $self->get($l.'num') eq '' ) {
458 $dbh->rollback if $oldAutoCommit;
463 warn " inserting $self\n"
466 $self->signupdate(time) unless $self->signupdate;
468 $self->auto_agent_custid()
469 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
471 my $error = $self->SUPER::insert;
473 $dbh->rollback if $oldAutoCommit;
474 #return "inserting cust_main record (transaction rolled back): $error";
478 # now set cust_location.custnum
479 foreach my $l (qw(bill_location ship_location)) {
480 warn " setting $l.custnum\n"
482 my $loc = $self->$l or next;
483 unless ( $loc->custnum ) {
484 $loc->set(custnum => $self->custnum);
485 $error ||= $loc->replace;
489 $dbh->rollback if $oldAutoCommit;
490 return "error setting $l custnum: $error";
494 warn " setting customer tags\n"
497 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
498 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
499 'custnum' => $self->custnum };
500 my $error = $cust_tag->insert;
502 $dbh->rollback if $oldAutoCommit;
507 my $prospectnum = delete $options{'prospectnum'};
508 if ( $prospectnum ) {
510 warn " moving contacts and locations from prospect $prospectnum\n"
514 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
515 unless ( $prospect_main ) {
516 $dbh->rollback if $oldAutoCommit;
517 return "Unknown prospectnum $prospectnum";
519 $prospect_main->custnum($self->custnum);
520 $prospect_main->disabled('Y');
521 my $error = $prospect_main->replace;
523 $dbh->rollback if $oldAutoCommit;
527 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
528 my $cust_contact = new FS::cust_contact {
529 'custnum' => $self->custnum,
530 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
532 my $error = $cust_contact->insert
533 || $prospect_contact->delete;
535 $dbh->rollback if $oldAutoCommit;
540 my @cust_location = $prospect_main->cust_location;
541 my @qual = $prospect_main->qual;
543 foreach my $r ( @cust_location, @qual ) {
545 $r->custnum($self->custnum);
546 my $error = $r->replace;
548 $dbh->rollback if $oldAutoCommit;
555 warn " setting contacts\n"
558 if ( my $contact = delete $options{'contact'} ) {
560 foreach my $c ( @$contact ) {
561 $c->custnum($self->custnum);
562 my $error = $c->insert;
564 $dbh->rollback if $oldAutoCommit;
570 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
572 my $error = $self->process_o2m( 'table' => 'contact',
573 'fields' => FS::contact->cgi_contact_fields,
574 'params' => $contact_params,
577 $dbh->rollback if $oldAutoCommit;
582 if ( $invoicing_list ) {
583 warn "FS::cust_main::insert setting invoice destinations via invoicing_list\n"
586 # okay, for now we'll still allow setting the contact this way
587 $invoicing_list = join(',', @$invoicing_list) if ref $invoicing_list;
588 my $contact = FS::contact->new({
589 'custnum' => $self->get('custnum'),
590 'last' => $self->get('last'),
591 'first' => $self->get('first'),
592 'emailaddress' => $invoicing_list,
593 'invoice_dest' => 'Y',
595 my $error = $contact->insert;
597 $dbh->rollback if $oldAutoCommit;
603 warn " setting cust_payby\n"
606 if ( $options{cust_payby} ) {
608 foreach my $cust_payby ( @{ $options{cust_payby} } ) {
609 $cust_payby->custnum($self->custnum);
610 my $error = $cust_payby->insert;
612 $dbh->rollback if $oldAutoCommit;
617 } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
619 my $error = $self->process_o2m(
620 'table' => 'cust_payby',
621 'fields' => FS::cust_payby->cgi_cust_payby_fields,
622 'params' => $cust_payby_params,
623 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
626 $dbh->rollback if $oldAutoCommit;
632 warn " setting cust_main_exemption\n"
635 my $tax_exemption = delete $options{'tax_exemption'};
636 if ( $tax_exemption ) {
638 $tax_exemption = { map { $_ => '' } @$tax_exemption }
639 if ref($tax_exemption) eq 'ARRAY';
641 foreach my $taxname ( keys %$tax_exemption ) {
642 my $cust_main_exemption = new FS::cust_main_exemption {
643 'custnum' => $self->custnum,
644 'taxname' => $taxname,
645 'exempt_number' => $tax_exemption->{$taxname},
647 my $error = $cust_main_exemption->insert;
649 $dbh->rollback if $oldAutoCommit;
650 return "inserting cust_main_exemption (transaction rolled back): $error";
655 warn " ordering packages\n"
658 $error = $self->order_pkgs( $cust_pkgs,
660 'seconds_ref' => \$seconds,
661 'upbytes_ref' => \$upbytes,
662 'downbytes_ref' => \$downbytes,
663 'totalbytes_ref' => \$totalbytes,
666 $dbh->rollback if $oldAutoCommit;
671 $dbh->rollback if $oldAutoCommit;
672 return "No svc_acct record to apply pre-paid time";
674 if ( $upbytes || $downbytes || $totalbytes ) {
675 $dbh->rollback if $oldAutoCommit;
676 return "No svc_acct record to apply pre-paid data";
680 warn " inserting initial $payby payment of $amount\n"
682 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
684 $dbh->rollback if $oldAutoCommit;
685 return "inserting payment (transaction rolled back): $error";
689 unless ( $import || $skip_fuzzyfiles ) {
690 warn " queueing fuzzyfiles update\n"
692 $error = $self->queue_fuzzyfiles_update;
694 $dbh->rollback if $oldAutoCommit;
695 return "updating fuzzy search cache: $error";
699 # FS::geocode_Mixin::after_insert or something?
700 if ( $conf->config('tax_district_method') and !$import ) {
701 # if anything non-empty, try to look it up
702 my $queue = new FS::queue {
703 'job' => 'FS::geocode_Mixin::process_district_update',
704 'custnum' => $self->custnum,
706 my $error = $queue->insert( ref($self), $self->custnum );
708 $dbh->rollback if $oldAutoCommit;
709 return "queueing tax district update: $error";
714 warn " exporting\n" if $DEBUG > 1;
716 my $export_args = $options{'export_args'} || [];
719 map qsearch( 'part_export', {exportnum=>$_} ),
720 $conf->config('cust_main-exports'); #, $agentnum
722 foreach my $part_export ( @part_export ) {
723 my $error = $part_export->export_insert($self, @$export_args);
725 $dbh->rollback if $oldAutoCommit;
726 return "exporting to ". $part_export->exporttype.
727 " (transaction rolled back): $error";
731 #foreach my $depend_jobnum ( @$depend_jobnums ) {
732 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
734 # foreach my $jobnum ( @jobnums ) {
735 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
736 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
738 # my $error = $queue->depend_insert($depend_jobnum);
740 # $dbh->rollback if $oldAutoCommit;
741 # return "error queuing job dependancy: $error";
748 #if ( exists $options{'jobnums'} ) {
749 # push @{ $options{'jobnums'} }, @jobnums;
752 warn " insert complete; committing transaction\n"
755 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
760 use File::CounterFile;
761 sub auto_agent_custid {
764 my $format = $conf->config('cust_main-auto_agent_custid');
766 if ( $format eq '1YMMXXXXXXXX' ) {
768 my $counter = new File::CounterFile 'cust_main.agent_custid';
771 my $ym = 100000000000 + time2str('%y%m00000000', time);
772 if ( $ym > $counter->value ) {
773 $counter->{'value'} = $agent_custid = $ym;
774 $counter->{'updated'} = 1;
776 $agent_custid = $counter->inc;
782 die "Unknown cust_main-auto_agent_custid format: $format";
785 $self->agent_custid($agent_custid);
789 =item PACKAGE METHODS
791 Documentation on customer package methods has been moved to
792 L<FS::cust_main::Packages>.
794 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
796 Recharges this (existing) customer with the specified prepaid card (see
797 L<FS::prepay_credit>), specified either by I<identifier> or as an
798 FS::prepay_credit object. If there is an error, returns the error, otherwise
801 Optionally, five scalar references can be passed as well. They will have their
802 values filled in with the amount, number of seconds, and number of upload,
803 download, and total bytes applied by this prepaid card.
807 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
808 #the only place that uses these args
809 sub recharge_prepay {
810 my( $self, $prepay_credit, $amountref, $secondsref,
811 $upbytesref, $downbytesref, $totalbytesref ) = @_;
813 local $SIG{HUP} = 'IGNORE';
814 local $SIG{INT} = 'IGNORE';
815 local $SIG{QUIT} = 'IGNORE';
816 local $SIG{TERM} = 'IGNORE';
817 local $SIG{TSTP} = 'IGNORE';
818 local $SIG{PIPE} = 'IGNORE';
820 my $oldAutoCommit = $FS::UID::AutoCommit;
821 local $FS::UID::AutoCommit = 0;
824 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
826 my $error = $self->get_prepay( $prepay_credit,
827 'amount_ref' => \$amount,
828 'seconds_ref' => \$seconds,
829 'upbytes_ref' => \$upbytes,
830 'downbytes_ref' => \$downbytes,
831 'totalbytes_ref' => \$totalbytes,
833 || $self->increment_seconds($seconds)
834 || $self->increment_upbytes($upbytes)
835 || $self->increment_downbytes($downbytes)
836 || $self->increment_totalbytes($totalbytes)
837 || $self->insert_cust_pay_prepay( $amount,
839 ? $prepay_credit->identifier
844 $dbh->rollback if $oldAutoCommit;
848 if ( defined($amountref) ) { $$amountref = $amount; }
849 if ( defined($secondsref) ) { $$secondsref = $seconds; }
850 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
851 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
852 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
854 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
859 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
861 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
862 specified either by I<identifier> or as an FS::prepay_credit object.
864 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
865 incremented by the values of the prepaid card.
867 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
868 check or set this customer's I<agentnum>.
870 If there is an error, returns the error, otherwise returns false.
876 my( $self, $prepay_credit, %opt ) = @_;
878 local $SIG{HUP} = 'IGNORE';
879 local $SIG{INT} = 'IGNORE';
880 local $SIG{QUIT} = 'IGNORE';
881 local $SIG{TERM} = 'IGNORE';
882 local $SIG{TSTP} = 'IGNORE';
883 local $SIG{PIPE} = 'IGNORE';
885 my $oldAutoCommit = $FS::UID::AutoCommit;
886 local $FS::UID::AutoCommit = 0;
889 unless ( ref($prepay_credit) ) {
891 my $identifier = $prepay_credit;
893 $prepay_credit = qsearchs(
895 { 'identifier' => $identifier },
900 unless ( $prepay_credit ) {
901 $dbh->rollback if $oldAutoCommit;
902 return "Invalid prepaid card: ". $identifier;
907 if ( $prepay_credit->agentnum ) {
908 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
909 $dbh->rollback if $oldAutoCommit;
910 return "prepaid card not valid for agent ". $self->agentnum;
912 $self->agentnum($prepay_credit->agentnum);
915 my $error = $prepay_credit->delete;
917 $dbh->rollback if $oldAutoCommit;
918 return "removing prepay_credit (transaction rolled back): $error";
921 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
922 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
924 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
929 =item increment_upbytes SECONDS
931 Updates this customer's single or primary account (see L<FS::svc_acct>) by
932 the specified number of upbytes. If there is an error, returns the error,
933 otherwise returns false.
937 sub increment_upbytes {
938 _increment_column( shift, 'upbytes', @_);
941 =item increment_downbytes SECONDS
943 Updates this customer's single or primary account (see L<FS::svc_acct>) by
944 the specified number of downbytes. If there is an error, returns the error,
945 otherwise returns false.
949 sub increment_downbytes {
950 _increment_column( shift, 'downbytes', @_);
953 =item increment_totalbytes SECONDS
955 Updates this customer's single or primary account (see L<FS::svc_acct>) by
956 the specified number of totalbytes. If there is an error, returns the error,
957 otherwise returns false.
961 sub increment_totalbytes {
962 _increment_column( shift, 'totalbytes', @_);
965 =item increment_seconds SECONDS
967 Updates this customer's single or primary account (see L<FS::svc_acct>) by
968 the specified number of seconds. If there is an error, returns the error,
969 otherwise returns false.
973 sub increment_seconds {
974 _increment_column( shift, 'seconds', @_);
977 =item _increment_column AMOUNT
979 Updates this customer's single or primary account (see L<FS::svc_acct>) by
980 the specified number of seconds or bytes. If there is an error, returns
981 the error, otherwise returns false.
985 sub _increment_column {
986 my( $self, $column, $amount ) = @_;
987 warn "$me increment_column called: $column, $amount\n"
990 return '' unless $amount;
992 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
993 $self->ncancelled_pkgs;
996 return 'No packages with primary or single services found'.
997 ' to apply pre-paid time';
998 } elsif ( scalar(@cust_pkg) > 1 ) {
999 #maybe have a way to specify the package/account?
1000 return 'Multiple packages found to apply pre-paid time';
1003 my $cust_pkg = $cust_pkg[0];
1004 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1008 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1010 if ( ! @cust_svc ) {
1011 return 'No account found to apply pre-paid time';
1012 } elsif ( scalar(@cust_svc) > 1 ) {
1013 return 'Multiple accounts found to apply pre-paid time';
1016 my $svc_acct = $cust_svc[0]->svc_x;
1017 warn " found service svcnum ". $svc_acct->pkgnum.
1018 ' ('. $svc_acct->email. ")\n"
1021 $column = "increment_$column";
1022 $svc_acct->$column($amount);
1026 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1028 Inserts a prepayment in the specified amount for this customer. An optional
1029 second argument can specify the prepayment identifier for tracking purposes.
1030 If there is an error, returns the error, otherwise returns false.
1034 sub insert_cust_pay_prepay {
1035 shift->insert_cust_pay('PREP', @_);
1038 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1040 Inserts a cash payment in the specified amount for this customer. An optional
1041 second argument can specify the payment identifier for tracking purposes.
1042 If there is an error, returns the error, otherwise returns false.
1046 sub insert_cust_pay_cash {
1047 shift->insert_cust_pay('CASH', @_);
1050 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1052 Inserts a Western Union payment in the specified amount for this customer. An
1053 optional second argument can specify the prepayment identifier for tracking
1054 purposes. If there is an error, returns the error, otherwise returns false.
1058 sub insert_cust_pay_west {
1059 shift->insert_cust_pay('WEST', @_);
1062 sub insert_cust_pay {
1063 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1064 my $payinfo = scalar(@_) ? shift : '';
1066 my $cust_pay = new FS::cust_pay {
1067 'custnum' => $self->custnum,
1068 'paid' => sprintf('%.2f', $amount),
1069 #'_date' => #date the prepaid card was purchased???
1071 'payinfo' => $payinfo,
1077 =item delete [ OPTION => VALUE ... ]
1079 This deletes the customer. If there is an error, returns the error, otherwise
1082 This will completely remove all traces of the customer record. This is not
1083 what you want when a customer cancels service; for that, cancel all of the
1084 customer's packages (see L</cancel>).
1086 If the customer has any uncancelled packages, you need to pass a new (valid)
1087 customer number for those packages to be transferred to, as the "new_customer"
1088 option. Cancelled packages will be deleted. Did I mention that this is NOT
1089 what you want when a customer cancels service and that you really should be
1090 looking at L<FS::cust_pkg/cancel>?
1092 You can't delete a customer with invoices (see L<FS::cust_bill>),
1093 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1094 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1095 set the "delete_financials" option to a true value.
1100 my( $self, %opt ) = @_;
1102 local $SIG{HUP} = 'IGNORE';
1103 local $SIG{INT} = 'IGNORE';
1104 local $SIG{QUIT} = 'IGNORE';
1105 local $SIG{TERM} = 'IGNORE';
1106 local $SIG{TSTP} = 'IGNORE';
1107 local $SIG{PIPE} = 'IGNORE';
1109 my $oldAutoCommit = $FS::UID::AutoCommit;
1110 local $FS::UID::AutoCommit = 0;
1113 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1114 $dbh->rollback if $oldAutoCommit;
1115 return "Can't delete a master agent customer";
1118 #use FS::access_user
1119 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1120 $dbh->rollback if $oldAutoCommit;
1121 return "Can't delete a master employee customer";
1124 tie my %financial_tables, 'Tie::IxHash',
1125 'cust_bill' => 'invoices',
1126 'cust_statement' => 'statements',
1127 'cust_credit' => 'credits',
1128 'cust_pay' => 'payments',
1129 'cust_refund' => 'refunds',
1132 foreach my $table ( keys %financial_tables ) {
1134 my @records = $self->$table();
1136 if ( @records && ! $opt{'delete_financials'} ) {
1137 $dbh->rollback if $oldAutoCommit;
1138 return "Can't delete a customer with ". $financial_tables{$table};
1141 foreach my $record ( @records ) {
1142 my $error = $record->delete;
1144 $dbh->rollback if $oldAutoCommit;
1145 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1151 my @cust_pkg = $self->ncancelled_pkgs;
1153 my $new_custnum = $opt{'new_custnum'};
1154 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1155 $dbh->rollback if $oldAutoCommit;
1156 return "Invalid new customer number: $new_custnum";
1158 foreach my $cust_pkg ( @cust_pkg ) {
1159 my %hash = $cust_pkg->hash;
1160 $hash{'custnum'} = $new_custnum;
1161 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1162 my $error = $new_cust_pkg->replace($cust_pkg,
1163 options => { $cust_pkg->options },
1166 $dbh->rollback if $oldAutoCommit;
1171 my @cancelled_cust_pkg = $self->all_pkgs;
1172 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1173 my $error = $cust_pkg->delete;
1175 $dbh->rollback if $oldAutoCommit;
1180 #cust_tax_adjustment in financials?
1181 #cust_pay_pending? ouch
1182 foreach my $table (qw(
1183 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1184 cust_payby cust_location cust_main_note cust_tax_adjustment
1185 cust_pay_void cust_pay_batch queue cust_tax_exempt
1187 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1188 my $error = $record->delete;
1190 $dbh->rollback if $oldAutoCommit;
1196 my $sth = $dbh->prepare(
1197 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1199 my $errstr = $dbh->errstr;
1200 $dbh->rollback if $oldAutoCommit;
1203 $sth->execute($self->custnum) or do {
1204 my $errstr = $sth->errstr;
1205 $dbh->rollback if $oldAutoCommit;
1211 my $ticket_dbh = '';
1212 if ($conf->config('ticket_system') eq 'RT_Internal') {
1214 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1215 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1216 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1217 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1220 if ( $ticket_dbh ) {
1222 my $ticket_sth = $ticket_dbh->prepare(
1223 'DELETE FROM Links WHERE Target = ?'
1225 my $errstr = $ticket_dbh->errstr;
1226 $dbh->rollback if $oldAutoCommit;
1229 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1231 my $errstr = $ticket_sth->errstr;
1232 $dbh->rollback if $oldAutoCommit;
1236 #check and see if the customer is the only link on the ticket, and
1237 #if so, set the ticket to deleted status in RT?
1238 #maybe someday, for now this will at least fix tickets not displaying
1242 #delete the customer record
1244 my $error = $self->SUPER::delete;
1246 $dbh->rollback if $oldAutoCommit;
1250 # cust_main exports!
1252 #my $export_args = $options{'export_args'} || [];
1255 map qsearch( 'part_export', {exportnum=>$_} ),
1256 $conf->config('cust_main-exports'); #, $agentnum
1258 foreach my $part_export ( @part_export ) {
1259 my $error = $part_export->export_delete( $self ); #, @$export_args);
1261 $dbh->rollback if $oldAutoCommit;
1262 return "exporting to ". $part_export->exporttype.
1263 " (transaction rolled back): $error";
1267 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1272 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1274 Replaces the OLD_RECORD with this one in the database. If there is an error,
1275 returns the error, otherwise returns false.
1277 To change the customer's address, set the pseudo-fields C<bill_location> and
1278 C<ship_location>. The address will still only change if at least one of the
1279 address fields differs from the existing values.
1281 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1282 set as the contact email address for a default contact with the same name as
1285 Currently available options are: I<tax_exemption>.
1287 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1288 of tax names and exemption numbers. FS::cust_main_exemption records will be
1289 deleted and inserted as appropriate.
1296 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1298 : $self->replace_old;
1302 warn "$me replace called\n"
1305 my $curuser = $FS::CurrentUser::CurrentUser;
1306 return "You are not permitted to create complimentary accounts."
1307 if $self->complimentary eq 'Y'
1308 && $self->complimentary ne $old->complimentary
1309 && ! $curuser->access_right('Complimentary customer');
1311 local($ignore_expired_card) = 1
1312 if $old->payby =~ /^(CARD|DCRD)$/
1313 && $self->payby =~ /^(CARD|DCRD)$/
1314 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1316 local($ignore_banned_card) = 1
1317 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1318 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1319 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1321 return "Invoicing locale is required"
1324 && $conf->exists('cust_main-require_locale');
1326 local $SIG{HUP} = 'IGNORE';
1327 local $SIG{INT} = 'IGNORE';
1328 local $SIG{QUIT} = 'IGNORE';
1329 local $SIG{TERM} = 'IGNORE';
1330 local $SIG{TSTP} = 'IGNORE';
1331 local $SIG{PIPE} = 'IGNORE';
1333 my $oldAutoCommit = $FS::UID::AutoCommit;
1334 local $FS::UID::AutoCommit = 0;
1337 for my $l (qw(bill_location ship_location)) {
1338 #my $old_loc = $old->$l;
1339 my $new_loc = $self->$l or next;
1341 # find the existing location if there is one
1342 $new_loc->set('custnum' => $self->custnum);
1343 my $error = $new_loc->find_or_insert;
1345 $dbh->rollback if $oldAutoCommit;
1348 $self->set($l.'num', $new_loc->locationnum);
1351 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1352 my $invoicing_list = shift @param;
1354 foreach (@$invoicing_list) {
1356 $self->set('postal_invoice', 'Y');
1358 $email .= ',' if length($email);
1362 my @contacts = map { $_->contact } $self->cust_contact;
1363 # if possible, use a contact that matches the customer's name
1364 my ($contact) = grep { $_->first eq $old->get('first') and
1365 $_->last eq $old->get('last') }
1367 $contact ||= FS::contact->new({
1368 'custnum' => $self->custnum,
1369 'locationnum' => $self->get('bill_locationnum'),
1371 $contact->set('last', $self->get('last'));
1372 $contact->set('first', $self->get('first'));
1373 $contact->set('emailaddress', $email);
1374 $contact->set('invoice_dest', 'Y');
1377 if ( $contact->contactnum ) {
1378 $error = $contact->replace;
1379 } elsif ( length($email) ) { # don't create a new contact if email is empty
1380 $error = $contact->insert;
1384 $dbh->rollback if $oldAutoCommit;
1390 # replace the customer record
1391 my $error = $self->SUPER::replace($old);
1394 $dbh->rollback if $oldAutoCommit;
1398 # now move packages to the new service location
1399 $self->set('ship_location', ''); #flush cache
1400 if ( $old->ship_locationnum and # should only be null during upgrade...
1401 $old->ship_locationnum != $self->ship_locationnum ) {
1402 $error = $old->ship_location->move_to($self->ship_location);
1404 $dbh->rollback if $oldAutoCommit;
1408 # don't move packages based on the billing location, but
1409 # disable it if it's no longer in use
1410 if ( $old->bill_locationnum and
1411 $old->bill_locationnum != $self->bill_locationnum ) {
1412 $error = $old->bill_location->disable_if_unused;
1414 $dbh->rollback if $oldAutoCommit;
1419 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1421 #this could be more efficient than deleting and re-inserting, if it matters
1422 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1423 my $error = $cust_tag->delete;
1425 $dbh->rollback if $oldAutoCommit;
1429 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1430 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1431 'custnum' => $self->custnum };
1432 my $error = $cust_tag->insert;
1434 $dbh->rollback if $oldAutoCommit;
1441 my %options = @param;
1443 my $tax_exemption = delete $options{'tax_exemption'};
1444 if ( $tax_exemption ) {
1446 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1447 if ref($tax_exemption) eq 'ARRAY';
1449 my %cust_main_exemption =
1450 map { $_->taxname => $_ }
1451 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1453 foreach my $taxname ( keys %$tax_exemption ) {
1455 if ( $cust_main_exemption{$taxname} &&
1456 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1459 delete $cust_main_exemption{$taxname};
1463 my $cust_main_exemption = new FS::cust_main_exemption {
1464 'custnum' => $self->custnum,
1465 'taxname' => $taxname,
1466 'exempt_number' => $tax_exemption->{$taxname},
1468 my $error = $cust_main_exemption->insert;
1470 $dbh->rollback if $oldAutoCommit;
1471 return "inserting cust_main_exemption (transaction rolled back): $error";
1475 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1476 my $error = $cust_main_exemption->delete;
1478 $dbh->rollback if $oldAutoCommit;
1479 return "deleting cust_main_exemption (transaction rolled back): $error";
1485 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1487 my $error = $self->process_o2m(
1488 'table' => 'cust_payby',
1489 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1490 'params' => $cust_payby_params,
1491 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1494 $dbh->rollback if $oldAutoCommit;
1500 unless ( $import || $skip_fuzzyfiles ) {
1501 $error = $self->queue_fuzzyfiles_update;
1503 $dbh->rollback if $oldAutoCommit;
1504 return "updating fuzzy search cache: $error";
1508 # tax district update in cust_location
1510 # cust_main exports!
1512 my $export_args = $options{'export_args'} || [];
1515 map qsearch( 'part_export', {exportnum=>$_} ),
1516 $conf->config('cust_main-exports'); #, $agentnum
1518 foreach my $part_export ( @part_export ) {
1519 my $error = $part_export->export_replace( $self, $old, @$export_args);
1521 $dbh->rollback if $oldAutoCommit;
1522 return "exporting to ". $part_export->exporttype.
1523 " (transaction rolled back): $error";
1527 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1532 =item queue_fuzzyfiles_update
1534 Used by insert & replace to update the fuzzy search cache
1538 use FS::cust_main::Search;
1539 sub queue_fuzzyfiles_update {
1542 local $SIG{HUP} = 'IGNORE';
1543 local $SIG{INT} = 'IGNORE';
1544 local $SIG{QUIT} = 'IGNORE';
1545 local $SIG{TERM} = 'IGNORE';
1546 local $SIG{TSTP} = 'IGNORE';
1547 local $SIG{PIPE} = 'IGNORE';
1549 my $oldAutoCommit = $FS::UID::AutoCommit;
1550 local $FS::UID::AutoCommit = 0;
1553 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1554 my $queue = new FS::queue {
1555 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1557 my @args = "cust_main.$field", $self->get($field);
1558 my $error = $queue->insert( @args );
1560 $dbh->rollback if $oldAutoCommit;
1561 return "queueing job (transaction rolled back): $error";
1566 push @locations, $self->bill_location if $self->bill_locationnum;
1567 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1568 foreach my $location (@locations) {
1569 my $queue = new FS::queue {
1570 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1572 my @args = 'cust_location.address1', $location->address1;
1573 my $error = $queue->insert( @args );
1575 $dbh->rollback if $oldAutoCommit;
1576 return "queueing job (transaction rolled back): $error";
1580 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1587 Checks all fields to make sure this is a valid customer record. If there is
1588 an error, returns the error, otherwise returns false. Called by the insert
1589 and replace methods.
1596 warn "$me check BEFORE: \n". $self->_dump
1600 $self->ut_numbern('custnum')
1601 || $self->ut_number('agentnum')
1602 || $self->ut_textn('agent_custid')
1603 || $self->ut_number('refnum')
1604 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1605 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1606 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1607 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1608 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1609 || $self->ut_textn('custbatch')
1610 || $self->ut_name('last')
1611 || $self->ut_name('first')
1612 || $self->ut_snumbern('signupdate')
1613 || $self->ut_snumbern('birthdate')
1614 || $self->ut_namen('spouse_last')
1615 || $self->ut_namen('spouse_first')
1616 || $self->ut_snumbern('spouse_birthdate')
1617 || $self->ut_snumbern('anniversary_date')
1618 || $self->ut_textn('company')
1619 || $self->ut_textn('ship_company')
1620 || $self->ut_anything('comments')
1621 || $self->ut_numbern('referral_custnum')
1622 || $self->ut_textn('stateid')
1623 || $self->ut_textn('stateid_state')
1624 || $self->ut_textn('invoice_terms')
1625 || $self->ut_floatn('cdr_termination_percentage')
1626 || $self->ut_floatn('credit_limit')
1627 || $self->ut_numbern('billday')
1628 || $self->ut_numbern('prorate_day')
1629 || $self->ut_flag('edit_subject')
1630 || $self->ut_flag('calling_list_exempt')
1631 || $self->ut_flag('invoice_noemail')
1632 || $self->ut_flag('message_noemail')
1633 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1634 || $self->ut_currencyn('currency')
1635 || $self->ut_alphan('po_number')
1636 || $self->ut_enum('complimentary', [ '', 'Y' ])
1637 || $self->ut_flag('invoice_ship_address')
1638 || $self->ut_flag('invoice_dest')
1641 foreach (qw(company ship_company)) {
1642 my $company = $self->get($_);
1643 $company =~ s/^\s+//;
1644 $company =~ s/\s+$//;
1645 $company =~ s/\s+/ /g;
1646 $self->set($_, $company);
1649 #barf. need message catalogs. i18n. etc.
1650 $error .= "Please select an advertising source."
1651 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1652 return $error if $error;
1654 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1655 or return "Unknown agent";
1657 if ( $self->currency ) {
1658 my $agent_currency = qsearchs( 'agent_currency', {
1659 'agentnum' => $agent->agentnum,
1660 'currency' => $self->currency,
1662 or return "Agent ". $agent->agent.
1663 " not permitted to offer ". $self->currency. " invoicing";
1666 return "Unknown refnum"
1667 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1669 return "Unknown referring custnum: ". $self->referral_custnum
1670 unless ! $self->referral_custnum
1671 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1673 if ( $self->ss eq '' ) {
1678 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1679 or return "Illegal social security number: ". $self->ss;
1680 $self->ss("$1-$2-$3");
1683 #turn off invoice_ship_address if ship & bill are the same
1684 if ($self->bill_locationnum eq $self->ship_locationnum) {
1685 $self->invoice_ship_address('');
1688 # cust_main_county verification now handled by cust_location check
1691 $self->ut_phonen('daytime', $self->country)
1692 || $self->ut_phonen('night', $self->country)
1693 || $self->ut_phonen('fax', $self->country)
1694 || $self->ut_phonen('mobile', $self->country)
1696 return $error if $error;
1698 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1700 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1703 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1705 : FS::Msgcat::_gettext('daytime');
1706 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1708 : FS::Msgcat::_gettext('night');
1710 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1712 : FS::Msgcat::_gettext('mobile');
1714 return "$daytime_label, $night_label or $mobile_label is required"
1718 ### start of stuff moved to cust_payby
1719 # then mostly kept here to support upgrades (can remove in 5.x)
1720 # but modified to allow everything to be empty
1722 if ( $self->payby ) {
1723 FS::payby->can_payby($self->table, $self->payby)
1724 or return "Illegal payby: ". $self->payby;
1729 $error = $self->ut_numbern('paystart_month')
1730 || $self->ut_numbern('paystart_year')
1731 || $self->ut_numbern('payissue')
1732 || $self->ut_textn('paytype')
1734 return $error if $error;
1736 if ( $self->payip eq '' ) {
1739 $error = $self->ut_ip('payip');
1740 return $error if $error;
1743 # If it is encrypted and the private key is not availaible then we can't
1744 # check the credit card.
1745 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1747 # Need some kind of global flag to accept invalid cards, for testing
1749 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1750 $self->payby =~ /^(CARD|DCRD)$/ ) {
1752 my $payinfo = $self->payinfo;
1753 $payinfo =~ s/\D//g;
1754 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1755 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1757 $self->payinfo($payinfo);
1759 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1761 return gettext('unknown_card_type')
1762 if $self->payinfo !~ /^99\d{14}$/ #token
1763 && cardtype($self->payinfo) eq "Unknown";
1765 unless ( $ignore_banned_card ) {
1766 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1768 if ( $ban->bantype eq 'warn' ) {
1769 #or others depending on value of $ban->reason ?
1770 return '_duplicate_card'.
1771 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1772 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1773 ' (ban# '. $ban->bannum. ')'
1774 unless $self->override_ban_warn;
1776 return 'Banned credit card: banned on '.
1777 time2str('%a %h %o at %r', $ban->_date).
1778 ' by '. $ban->otaker.
1779 ' (ban# '. $ban->bannum. ')';
1784 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1785 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1786 $self->paycvv =~ /^(\d{4})$/
1787 or return "CVV2 (CID) for American Express cards is four digits.";
1790 $self->paycvv =~ /^(\d{3})$/
1791 or return "CVV2 (CVC2/CID) is three digits.";
1798 my $cardtype = cardtype($payinfo);
1799 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1801 return "Start date or issue number is required for $cardtype cards"
1802 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1804 return "Start month must be between 1 and 12"
1805 if $self->paystart_month
1806 and $self->paystart_month < 1 || $self->paystart_month > 12;
1808 return "Start year must be 1990 or later"
1809 if $self->paystart_year
1810 and $self->paystart_year < 1990;
1812 return "Issue number must be beween 1 and 99"
1814 and $self->payissue < 1 || $self->payissue > 99;
1817 $self->paystart_month('');
1818 $self->paystart_year('');
1819 $self->payissue('');
1822 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1823 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1825 my $payinfo = $self->payinfo;
1826 $payinfo =~ s/[^\d\@\.]//g;
1827 if ( $conf->config('echeck-country') eq 'CA' ) {
1828 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1829 or return 'invalid echeck account@branch.bank';
1830 $payinfo = "$1\@$2.$3";
1831 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1832 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1833 $payinfo = "$1\@$2";
1835 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1836 $payinfo = "$1\@$2";
1838 $self->payinfo($payinfo);
1841 unless ( $ignore_banned_card ) {
1842 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1844 if ( $ban->bantype eq 'warn' ) {
1845 #or others depending on value of $ban->reason ?
1846 return '_duplicate_ach' unless $self->override_ban_warn;
1848 return 'Banned ACH account: banned on '.
1849 time2str('%a %h %o at %r', $ban->_date).
1850 ' by '. $ban->otaker.
1851 ' (ban# '. $ban->bannum. ')';
1856 } elsif ( $self->payby eq 'LECB' ) {
1858 my $payinfo = $self->payinfo;
1859 $payinfo =~ s/\D//g;
1860 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1862 $self->payinfo($payinfo);
1865 } elsif ( $self->payby eq 'BILL' ) {
1867 $error = $self->ut_textn('payinfo');
1868 return "Illegal P.O. number: ". $self->payinfo if $error;
1871 } elsif ( $self->payby eq 'COMP' ) {
1873 my $curuser = $FS::CurrentUser::CurrentUser;
1874 if ( ! $self->custnum
1875 && ! $curuser->access_right('Complimentary customer')
1878 return "You are not permitted to create complimentary accounts."
1881 $error = $self->ut_textn('payinfo');
1882 return "Illegal comp account issuer: ". $self->payinfo if $error;
1885 } elsif ( $self->payby eq 'PREPAY' ) {
1887 my $payinfo = $self->payinfo;
1888 $payinfo =~ s/\W//g; #anything else would just confuse things
1889 $self->payinfo($payinfo);
1890 $error = $self->ut_alpha('payinfo');
1891 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1892 return "Unknown prepayment identifier"
1893 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1898 return "You are not permitted to create complimentary accounts."
1900 && $self->complimentary eq 'Y'
1901 && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer');
1903 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1904 return "Expiration date required"
1905 # shouldn't payinfo_check do this?
1906 unless ! $self->payby
1907 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1911 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1912 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1913 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1914 ( $m, $y ) = ( $2, "19$1" );
1915 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1916 ( $m, $y ) = ( $3, "20$2" );
1918 return "Illegal expiration date: ". $self->paydate;
1920 $m = sprintf('%02d',$m);
1921 $self->paydate("$y-$m-01");
1922 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1923 return gettext('expired_card')
1925 && !$ignore_expired_card
1926 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1929 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1930 ( ! $conf->exists('require_cardname')
1931 || $self->payby !~ /^(CARD|DCRD)$/ )
1933 $self->payname( $self->first. " ". $self->getfield('last') );
1936 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
1937 $self->payname =~ /^([\w \,\.\-\']*)$/
1938 or return gettext('illegal_name'). " payname: ". $self->payname;
1941 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
1942 or return gettext('illegal_name'). " payname: ". $self->payname;
1948 ### end of stuff moved to cust_payby
1950 return "Please select an invoicing locale"
1953 && $conf->exists('cust_main-require_locale');
1955 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1956 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1960 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1962 warn "$me check AFTER: \n". $self->_dump
1965 $self->SUPER::check;
1970 Additional checks for replace only.
1975 my ($new,$old) = @_;
1976 #preserve old value if global config is set
1977 if ($old && $conf->exists('invoice-ship_address')) {
1978 $new->invoice_ship_address($old->invoice_ship_address);
1985 Returns a list of fields which have ship_ duplicates.
1990 qw( last first company
1992 address1 address2 city county state zip country
1994 daytime night fax mobile
1998 =item has_ship_address
2000 Returns true if this customer record has a separate shipping address.
2004 sub has_ship_address {
2006 $self->bill_locationnum != $self->ship_locationnum;
2011 Returns a list of key/value pairs, with the following keys: address1,
2012 adddress2, city, county, state, zip, country, district, and geocode. The
2013 shipping address is used if present.
2019 $self->ship_location->location_hash;
2024 Returns all locations (see L<FS::cust_location>) for this customer.
2030 qsearch('cust_location', { 'custnum' => $self->custnum,
2031 'prospectnum' => '' } );
2036 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2042 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2047 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2054 'table' => 'cust_payby',
2055 'hashref' => { 'custnum' => $self->custnum },
2056 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2060 sub has_cust_payby_auto {
2063 'table' => 'cust_payby',
2064 'hashref' => { 'custnum' => $self->custnum, },
2065 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2066 'order_by' => 'LIMIT 1',
2073 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2074 and L<FS::cust_pkg>) for this customer, except those on hold.
2076 Returns a list: an empty list on success or a list of errors.
2082 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2087 Unsuspends all suspended packages in the on-hold state (those without setup
2088 dates) for this customer.
2094 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2099 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2101 Returns a list: an empty list on success or a list of errors.
2107 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2110 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2112 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2113 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2114 of a list of pkgparts; the hashref has the following keys:
2118 =item pkgparts - listref of pkgparts
2120 =item (other options are passed to the suspend method)
2125 Returns a list: an empty list on success or a list of errors.
2129 sub suspend_if_pkgpart {
2131 my (@pkgparts, %opt);
2132 if (ref($_[0]) eq 'HASH'){
2133 @pkgparts = @{$_[0]{pkgparts}};
2138 grep { $_->suspend(%opt) }
2139 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2140 $self->unsuspended_pkgs;
2143 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2145 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2146 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2147 instead of a list of pkgparts; the hashref has the following keys:
2151 =item pkgparts - listref of pkgparts
2153 =item (other options are passed to the suspend method)
2157 Returns a list: an empty list on success or a list of errors.
2161 sub suspend_unless_pkgpart {
2163 my (@pkgparts, %opt);
2164 if (ref($_[0]) eq 'HASH'){
2165 @pkgparts = @{$_[0]{pkgparts}};
2170 grep { $_->suspend(%opt) }
2171 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2172 $self->unsuspended_pkgs;
2175 =item cancel [ OPTION => VALUE ... ]
2177 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2179 Available options are:
2183 =item quiet - can be set true to supress email cancellation notices.
2185 =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.
2187 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2189 =item nobill - can be set true to skip billing if it might otherwise be done.
2193 Always returns a list: an empty list on success or a list of errors.
2197 # nb that dates are not specified as valid options to this method
2200 my( $self, %opt ) = @_;
2202 warn "$me cancel called on customer ". $self->custnum. " with options ".
2203 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2206 return ( 'access denied' )
2207 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2209 if ( $opt{'ban'} ) {
2211 foreach my $cust_payby ( $self->cust_payby ) {
2213 #well, if they didn't get decrypted on search, then we don't have to
2214 # try again... queue a job for the server that does have decryption
2215 # capability if we're in a paranoid multi-server implementation?
2216 return ( "Can't (yet) ban encrypted credit cards" )
2217 if $cust_payby->is_encrypted($cust_payby->payinfo);
2219 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2220 my $error = $ban->insert;
2221 return ( $error ) if $error;
2227 my @pkgs = $self->ncancelled_pkgs;
2229 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2231 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2232 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2236 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2237 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2240 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2243 sub _banned_pay_hashref {
2254 'payby' => $payby2ban{$self->payby},
2255 'payinfo' => $self->payinfo,
2256 #don't ever *search* on reason! #'reason' =>
2262 Returns all notes (see L<FS::cust_main_note>) for this customer.
2267 my($self,$orderby_classnum) = (shift,shift);
2268 my $orderby = "sticky DESC, _date DESC";
2269 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2270 qsearch( 'cust_main_note',
2271 { 'custnum' => $self->custnum },
2273 "ORDER BY $orderby",
2279 Returns the agent (see L<FS::agent>) for this customer.
2283 Returns the agent name (see L<FS::agent>) for this customer.
2289 $self->agent->agent;
2294 Returns any tags associated with this customer, as FS::cust_tag objects,
2295 or an empty list if there are no tags.
2299 Returns any tags associated with this customer, as FS::part_tag objects,
2300 or an empty list if there are no tags.
2306 map $_->part_tag, $self->cust_tag;
2312 Returns the customer class, as an FS::cust_class object, or the empty string
2313 if there is no customer class.
2317 Returns the customer category name, or the empty string if there is no customer
2324 my $cust_class = $self->cust_class;
2326 ? $cust_class->categoryname
2332 Returns the customer class name, or the empty string if there is no customer
2339 my $cust_class = $self->cust_class;
2341 ? $cust_class->classname
2347 Returns the external tax status, as an FS::tax_status object, or the empty
2348 string if there is no tax status.
2354 if ( $self->taxstatusnum ) {
2355 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2363 Returns the tax status code if there is one.
2369 my $tax_status = $self->tax_status;
2371 ? $tax_status->taxstatus
2375 =item BILLING METHODS
2377 Documentation on billing methods has been moved to
2378 L<FS::cust_main::Billing>.
2380 =item REALTIME BILLING METHODS
2382 Documentation on realtime billing methods has been moved to
2383 L<FS::cust_main::Billing_Realtime>.
2387 Removes the I<paycvv> field from the database directly.
2389 If there is an error, returns the error, otherwise returns false.
2395 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2396 or return dbh->errstr;
2397 $sth->execute($self->custnum)
2398 or return $sth->errstr;
2405 Returns the total owed for this customer on all invoices
2406 (see L<FS::cust_bill/owed>).
2412 $self->total_owed_date(2145859200); #12/31/2037
2415 =item total_owed_date TIME
2417 Returns the total owed for this customer on all invoices with date earlier than
2418 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2419 see L<Time::Local> and L<Date::Parse> for conversion functions.
2423 sub total_owed_date {
2427 my $custnum = $self->custnum;
2429 my $owed_sql = FS::cust_bill->owed_sql;
2432 SELECT SUM($owed_sql) FROM cust_bill
2433 WHERE custnum = $custnum
2437 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2441 =item total_owed_pkgnum PKGNUM
2443 Returns the total owed on all invoices for this customer's specific package
2444 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2448 sub total_owed_pkgnum {
2449 my( $self, $pkgnum ) = @_;
2450 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2453 =item total_owed_date_pkgnum TIME PKGNUM
2455 Returns the total owed for this customer's specific package when using
2456 experimental package balances on all invoices with date earlier than
2457 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2458 see L<Time::Local> and L<Date::Parse> for conversion functions.
2462 sub total_owed_date_pkgnum {
2463 my( $self, $time, $pkgnum ) = @_;
2466 foreach my $cust_bill (
2467 grep { $_->_date <= $time }
2468 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2470 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2472 sprintf( "%.2f", $total_bill );
2478 Returns the total amount of all payments.
2485 $total += $_->paid foreach $self->cust_pay;
2486 sprintf( "%.2f", $total );
2489 =item total_unapplied_credits
2491 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2492 customer. See L<FS::cust_credit/credited>.
2494 =item total_credited
2496 Old name for total_unapplied_credits. Don't use.
2500 sub total_credited {
2501 #carp "total_credited deprecated, use total_unapplied_credits";
2502 shift->total_unapplied_credits(@_);
2505 sub total_unapplied_credits {
2508 my $custnum = $self->custnum;
2510 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2513 SELECT SUM($unapplied_sql) FROM cust_credit
2514 WHERE custnum = $custnum
2517 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2521 =item total_unapplied_credits_pkgnum PKGNUM
2523 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2524 customer. See L<FS::cust_credit/credited>.
2528 sub total_unapplied_credits_pkgnum {
2529 my( $self, $pkgnum ) = @_;
2530 my $total_credit = 0;
2531 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2532 sprintf( "%.2f", $total_credit );
2536 =item total_unapplied_payments
2538 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2539 See L<FS::cust_pay/unapplied>.
2543 sub total_unapplied_payments {
2546 my $custnum = $self->custnum;
2548 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2551 SELECT SUM($unapplied_sql) FROM cust_pay
2552 WHERE custnum = $custnum
2555 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2559 =item total_unapplied_payments_pkgnum PKGNUM
2561 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2562 specific package when using experimental package balances. See
2563 L<FS::cust_pay/unapplied>.
2567 sub total_unapplied_payments_pkgnum {
2568 my( $self, $pkgnum ) = @_;
2569 my $total_unapplied = 0;
2570 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2571 sprintf( "%.2f", $total_unapplied );
2575 =item total_unapplied_refunds
2577 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2578 customer. See L<FS::cust_refund/unapplied>.
2582 sub total_unapplied_refunds {
2584 my $custnum = $self->custnum;
2586 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2589 SELECT SUM($unapplied_sql) FROM cust_refund
2590 WHERE custnum = $custnum
2593 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2599 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2600 total_unapplied_credits minus total_unapplied_payments).
2606 $self->balance_date_range;
2609 =item balance_date TIME
2611 Returns the balance for this customer, only considering invoices with date
2612 earlier than TIME (total_owed_date minus total_credited minus
2613 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2614 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2621 $self->balance_date_range(shift);
2624 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2626 Returns the balance for this customer, optionally considering invoices with
2627 date earlier than START_TIME, and not later than END_TIME
2628 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2630 Times are specified as SQL fragments or numeric
2631 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2632 L<Date::Parse> for conversion functions. The empty string can be passed
2633 to disable that time constraint completely.
2635 Accepts the same options as L<balance_date_sql>:
2639 =item unapplied_date
2641 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)
2645 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2646 time will be ignored. Note that START_TIME and END_TIME only limit the date
2647 range for invoices and I<unapplied> payments, credits, and refunds.
2653 sub balance_date_range {
2655 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2656 ') FROM cust_main WHERE custnum='. $self->custnum;
2657 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2660 =item balance_pkgnum PKGNUM
2662 Returns the balance for this customer's specific package when using
2663 experimental package balances (total_owed plus total_unrefunded, minus
2664 total_unapplied_credits minus total_unapplied_payments)
2668 sub balance_pkgnum {
2669 my( $self, $pkgnum ) = @_;
2672 $self->total_owed_pkgnum($pkgnum)
2673 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2674 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2675 - $self->total_unapplied_credits_pkgnum($pkgnum)
2676 - $self->total_unapplied_payments_pkgnum($pkgnum)
2682 Returns a hash of useful information for making a payment.
2692 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2693 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2694 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2698 For credit card transactions:
2710 For electronic check transactions:
2725 $return{balance} = $self->balance;
2727 $return{payname} = $self->payname
2728 || ( $self->first. ' '. $self->get('last') );
2730 $return{$_} = $self->bill_location->$_
2731 for qw(address1 address2 city state zip);
2733 $return{payby} = $self->payby;
2734 $return{stateid_state} = $self->stateid_state;
2736 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2737 $return{card_type} = cardtype($self->payinfo);
2738 $return{payinfo} = $self->paymask;
2740 @return{'month', 'year'} = $self->paydate_monthyear;
2744 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2745 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2746 $return{payinfo1} = $payinfo1;
2747 $return{payinfo2} = $payinfo2;
2748 $return{paytype} = $self->paytype;
2749 $return{paystate} = $self->paystate;
2753 #doubleclick protection
2755 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2761 =item paydate_monthyear
2763 Returns a two-element list consisting of the month and year of this customer's
2764 paydate (credit card expiration date for CARD customers)
2768 sub paydate_monthyear {
2770 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2772 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2781 Returns the exact time in seconds corresponding to the payment method
2782 expiration date. For CARD/DCRD customers this is the end of the month;
2783 for others (COMP is the only other payby that uses paydate) it's the start.
2784 Returns 0 if the paydate is empty or set to the far future.
2790 my ($month, $year) = $self->paydate_monthyear;
2791 return 0 if !$year or $year >= 2037;
2792 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2794 if ( $month == 13 ) {
2798 return timelocal(0,0,0,1,$month-1,$year) - 1;
2801 return timelocal(0,0,0,1,$month-1,$year);
2805 =item paydate_epoch_sql
2807 Class method. Returns an SQL expression to obtain the payment expiration date
2808 as a number of seconds.
2812 # Special expiration date behavior for non-CARD/DCRD customers has been
2813 # carefully preserved. Do we really use that?
2814 sub paydate_epoch_sql {
2816 my $table = shift || 'cust_main';
2817 my ($case1, $case2);
2818 if ( driver_name eq 'Pg' ) {
2819 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2820 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2822 elsif ( lc(driver_name) eq 'mysql' ) {
2823 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2824 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2827 return "CASE WHEN $table.payby IN('CARD','DCRD')
2833 =item tax_exemption TAXNAME
2838 my( $self, $taxname ) = @_;
2840 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2841 'taxname' => $taxname,
2846 =item cust_main_exemption
2848 =item invoicing_list
2850 Returns a list of email addresses (with svcnum entries expanded), and the word
2851 'POST' if the customer receives postal invoices.
2855 sub invoicing_list {
2856 my( $self, $arrayref ) = @_;
2859 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2862 my @emails = $self->invoicing_list_emailonly;
2863 push @emails, 'POST' if $self->get('postal_invoice');
2868 =item check_invoicing_list ARRAYREF
2870 Checks these arguements as valid input for the invoicing_list method. If there
2871 is an error, returns the error, otherwise returns false.
2875 sub check_invoicing_list {
2876 my( $self, $arrayref ) = @_;
2878 foreach my $address ( @$arrayref ) {
2880 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2881 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2884 my $cust_main_invoice = new FS::cust_main_invoice ( {
2885 'custnum' => $self->custnum,
2888 my $error = $self->custnum
2889 ? $cust_main_invoice->check
2890 : $cust_main_invoice->checkdest
2892 return $error if $error;
2896 return "Email address required"
2897 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2898 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2905 Returns the email addresses of all accounts provisioned for this customer.
2912 foreach my $cust_pkg ( $self->all_pkgs ) {
2913 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2915 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2916 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2918 $list{$_}=1 foreach map { $_->email } @svc_acct;
2923 =item invoicing_list_addpost
2925 Adds postal invoicing to this customer. If this customer is already configured
2926 to receive postal invoices, does nothing.
2930 sub invoicing_list_addpost {
2932 if ( $self->get('postal_invoice') eq '' ) {
2933 $self->set('postal_invoice', 'Y');
2934 my $error = $self->replace;
2935 warn $error if $error; # should fail harder, but this is traditional
2939 =item invoicing_list_emailonly
2941 Returns the list of email invoice recipients (invoicing_list without non-email
2942 destinations such as POST and FAX).
2946 sub invoicing_list_emailonly {
2948 warn "$me invoicing_list_emailonly called"
2950 return () if !$self->custnum; # not yet inserted
2951 return map { $_->emailaddress }
2953 table => 'cust_contact',
2954 select => 'emailaddress',
2955 addl_from => ' JOIN contact USING (contactnum) '.
2956 ' JOIN contact_email USING (contactnum)',
2957 hashref => { 'custnum' => $self->custnum, },
2958 extra_sql => q( AND invoice_dest = 'Y'),
2962 =item invoicing_list_emailonly_scalar
2964 Returns the list of email invoice recipients (invoicing_list without non-email
2965 destinations such as POST and FAX) as a comma-separated scalar.
2969 sub invoicing_list_emailonly_scalar {
2971 warn "$me invoicing_list_emailonly_scalar called"
2973 join(', ', $self->invoicing_list_emailonly);
2976 =item referral_custnum_cust_main
2978 Returns the customer who referred this customer (or the empty string, if
2979 this customer was not referred).
2981 Note the difference with referral_cust_main method: This method,
2982 referral_custnum_cust_main returns the single customer (if any) who referred
2983 this customer, while referral_cust_main returns an array of customers referred
2988 sub referral_custnum_cust_main {
2990 return '' unless $self->referral_custnum;
2991 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2994 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2996 Returns an array of customers referred by this customer (referral_custnum set
2997 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2998 customers referred by customers referred by this customer and so on, inclusive.
2999 The default behavior is DEPTH 1 (no recursion).
3001 Note the difference with referral_custnum_cust_main method: This method,
3002 referral_cust_main, returns an array of customers referred BY this customer,
3003 while referral_custnum_cust_main returns the single customer (if any) who
3004 referred this customer.
3008 sub referral_cust_main {
3010 my $depth = @_ ? shift : 1;
3011 my $exclude = @_ ? shift : {};
3014 map { $exclude->{$_->custnum}++; $_; }
3015 grep { ! $exclude->{ $_->custnum } }
3016 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3020 map { $_->referral_cust_main($depth-1, $exclude) }
3027 =item referral_cust_main_ncancelled
3029 Same as referral_cust_main, except only returns customers with uncancelled
3034 sub referral_cust_main_ncancelled {
3036 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3039 =item referral_cust_pkg [ DEPTH ]
3041 Like referral_cust_main, except returns a flat list of all unsuspended (and
3042 uncancelled) packages for each customer. The number of items in this list may
3043 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3047 sub referral_cust_pkg {
3049 my $depth = @_ ? shift : 1;
3051 map { $_->unsuspended_pkgs }
3052 grep { $_->unsuspended_pkgs }
3053 $self->referral_cust_main($depth);
3056 =item referring_cust_main
3058 Returns the single cust_main record for the customer who referred this customer
3059 (referral_custnum), or false.
3063 sub referring_cust_main {
3065 return '' unless $self->referral_custnum;
3066 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3069 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3071 Applies a credit to this customer. If there is an error, returns the error,
3072 otherwise returns false.
3074 REASON can be a text string, an FS::reason object, or a scalar reference to
3075 a reasonnum. If a text string, it will be automatically inserted as a new
3076 reason, and a 'reason_type' option must be passed to indicate the
3077 FS::reason_type for the new reason.
3079 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3080 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3081 I<commission_pkgnum>.
3083 Any other options are passed to FS::cust_credit::insert.
3088 my( $self, $amount, $reason, %options ) = @_;
3090 my $cust_credit = new FS::cust_credit {
3091 'custnum' => $self->custnum,
3092 'amount' => $amount,
3095 if ( ref($reason) ) {
3097 if ( ref($reason) eq 'SCALAR' ) {
3098 $cust_credit->reasonnum( $$reason );
3100 $cust_credit->reasonnum( $reason->reasonnum );
3104 $cust_credit->set('reason', $reason)
3107 $cust_credit->$_( delete $options{$_} )
3108 foreach grep exists($options{$_}),
3109 qw( addlinfo eventnum ),
3110 map "commission_$_", qw( agentnum salesnum pkgnum );
3112 $cust_credit->insert(%options);
3116 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3118 Creates a one-time charge for this customer. If there is an error, returns
3119 the error, otherwise returns false.
3121 New-style, with a hashref of options:
3123 my $error = $cust_main->charge(
3127 'start_date' => str2time('7/4/2009'),
3128 'pkg' => 'Description',
3129 'comment' => 'Comment',
3130 'additional' => [], #extra invoice detail
3131 'classnum' => 1, #pkg_class
3133 'setuptax' => '', # or 'Y' for tax exempt
3135 'locationnum'=> 1234, # optional
3138 'taxclass' => 'Tax class',
3141 'taxproduct' => 2, #part_pkg_taxproduct
3142 'override' => {}, #XXX describe
3144 #will be filled in with the new object
3145 'cust_pkg_ref' => \$cust_pkg,
3147 #generate an invoice immediately
3149 'invoice_terms' => '', #with these terms
3155 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3159 #super false laziness w/quotation::charge
3162 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3163 my ( $pkg, $comment, $additional );
3164 my ( $setuptax, $taxclass ); #internal taxes
3165 my ( $taxproduct, $override ); #vendor (CCH) taxes
3167 my $separate_bill = '';
3168 my $cust_pkg_ref = '';
3169 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3171 if ( ref( $_[0] ) ) {
3172 $amount = $_[0]->{amount};
3173 $setup_cost = $_[0]->{setup_cost};
3174 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3175 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3176 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3177 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3178 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3179 : '$'. sprintf("%.2f",$amount);
3180 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3181 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3182 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3183 $additional = $_[0]->{additional} || [];
3184 $taxproduct = $_[0]->{taxproductnum};
3185 $override = { '' => $_[0]->{tax_override} };
3186 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3187 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3188 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3189 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3190 $separate_bill = $_[0]->{separate_bill} || '';
3196 $pkg = @_ ? shift : 'One-time charge';
3197 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3199 $taxclass = @_ ? shift : '';
3203 local $SIG{HUP} = 'IGNORE';
3204 local $SIG{INT} = 'IGNORE';
3205 local $SIG{QUIT} = 'IGNORE';
3206 local $SIG{TERM} = 'IGNORE';
3207 local $SIG{TSTP} = 'IGNORE';
3208 local $SIG{PIPE} = 'IGNORE';
3210 my $oldAutoCommit = $FS::UID::AutoCommit;
3211 local $FS::UID::AutoCommit = 0;
3214 my $part_pkg = new FS::part_pkg ( {
3216 'comment' => $comment,
3220 'classnum' => ( $classnum ? $classnum : '' ),
3221 'setuptax' => $setuptax,
3222 'taxclass' => $taxclass,
3223 'taxproductnum' => $taxproduct,
3224 'setup_cost' => $setup_cost,
3227 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3228 ( 0 .. @$additional - 1 )
3230 'additional_count' => scalar(@$additional),
3231 'setup_fee' => $amount,
3234 my $error = $part_pkg->insert( options => \%options,
3235 tax_overrides => $override,
3238 $dbh->rollback if $oldAutoCommit;
3242 my $pkgpart = $part_pkg->pkgpart;
3243 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3244 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3245 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3246 $error = $type_pkgs->insert;
3248 $dbh->rollback if $oldAutoCommit;
3253 my $cust_pkg = new FS::cust_pkg ( {
3254 'custnum' => $self->custnum,
3255 'pkgpart' => $pkgpart,
3256 'quantity' => $quantity,
3257 'start_date' => $start_date,
3258 'no_auto' => $no_auto,
3259 'separate_bill' => $separate_bill,
3260 'locationnum'=> $locationnum,
3263 $error = $cust_pkg->insert;
3265 $dbh->rollback if $oldAutoCommit;
3267 } elsif ( $cust_pkg_ref ) {
3268 ${$cust_pkg_ref} = $cust_pkg;
3272 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3273 'pkg_list' => [ $cust_pkg ],
3276 $dbh->rollback if $oldAutoCommit;
3281 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3286 #=item charge_postal_fee
3288 #Applies a one time charge this customer. If there is an error,
3289 #returns the error, returns the cust_pkg charge object or false
3290 #if there was no charge.
3294 # This should be a customer event. For that to work requires that bill
3295 # also be a customer event.
3297 sub charge_postal_fee {
3300 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3301 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3303 my $cust_pkg = new FS::cust_pkg ( {
3304 'custnum' => $self->custnum,
3305 'pkgpart' => $pkgpart,
3309 my $error = $cust_pkg->insert;
3310 $error ? $error : $cust_pkg;
3313 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3315 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3317 Optionally, a list or hashref of additional arguments to the qsearch call can
3324 my $opt = ref($_[0]) ? shift : { @_ };
3326 #return $self->num_cust_bill unless wantarray || keys %$opt;
3328 $opt->{'table'} = 'cust_bill';
3329 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3330 $opt->{'hashref'}{'custnum'} = $self->custnum;
3331 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3333 map { $_ } #behavior of sort undefined in scalar context
3334 sort { $a->_date <=> $b->_date }
3338 =item open_cust_bill
3340 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3345 sub open_cust_bill {
3349 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3355 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3357 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3361 sub legacy_cust_bill {
3364 #return $self->num_legacy_cust_bill unless wantarray;
3366 map { $_ } #behavior of sort undefined in scalar context
3367 sort { $a->_date <=> $b->_date }
3368 qsearch({ 'table' => 'legacy_cust_bill',
3369 'hashref' => { 'custnum' => $self->custnum, },
3370 'order_by' => 'ORDER BY _date ASC',
3374 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3376 Returns all the statements (see L<FS::cust_statement>) for this customer.
3378 Optionally, a list or hashref of additional arguments to the qsearch call can
3383 =item cust_bill_void
3385 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3389 sub cust_bill_void {
3392 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3393 sort { $a->_date <=> $b->_date }
3394 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3397 sub cust_statement {
3399 my $opt = ref($_[0]) ? shift : { @_ };
3401 #return $self->num_cust_statement unless wantarray || keys %$opt;
3403 $opt->{'table'} = 'cust_statement';
3404 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3405 $opt->{'hashref'}{'custnum'} = $self->custnum;
3406 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3408 map { $_ } #behavior of sort undefined in scalar context
3409 sort { $a->_date <=> $b->_date }
3413 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3415 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3417 Optionally, a list or hashref of additional arguments to the qsearch call can
3418 be passed following the SVCDB.
3425 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3426 warn "$me svc_x requires a svcdb";
3429 my $opt = ref($_[0]) ? shift : { @_ };
3431 $opt->{'table'} = $svcdb;
3432 $opt->{'addl_from'} =
3433 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3434 ($opt->{'addl_from'} || '');
3436 my $custnum = $self->custnum;
3437 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3438 my $where = "cust_pkg.custnum = $custnum";
3440 my $extra_sql = $opt->{'extra_sql'} || '';
3441 if ( keys %{ $opt->{'hashref'} } ) {
3442 $extra_sql = " AND $where $extra_sql";
3445 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3446 $extra_sql = "WHERE $where AND $1";
3449 $extra_sql = "WHERE $where $extra_sql";
3452 $opt->{'extra_sql'} = $extra_sql;
3457 # required for use as an eventtable;
3460 $self->svc_x('svc_acct', @_);
3465 Returns all the credits (see L<FS::cust_credit>) for this customer.
3471 map { $_ } #return $self->num_cust_credit unless wantarray;
3472 sort { $a->_date <=> $b->_date }
3473 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3476 =item cust_credit_pkgnum
3478 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3479 package when using experimental package balances.
3483 sub cust_credit_pkgnum {
3484 my( $self, $pkgnum ) = @_;
3485 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3486 sort { $a->_date <=> $b->_date }
3487 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3488 'pkgnum' => $pkgnum,
3493 =item cust_credit_void
3495 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3499 sub cust_credit_void {
3502 sort { $a->_date <=> $b->_date }
3503 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3508 Returns all the payments (see L<FS::cust_pay>) for this customer.
3514 my $opt = ref($_[0]) ? shift : { @_ };
3516 return $self->num_cust_pay unless wantarray || keys %$opt;
3518 $opt->{'table'} = 'cust_pay';
3519 $opt->{'hashref'}{'custnum'} = $self->custnum;
3521 map { $_ } #behavior of sort undefined in scalar context
3522 sort { $a->_date <=> $b->_date }
3529 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3530 called automatically when the cust_pay method is used in a scalar context.
3536 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3537 my $sth = dbh->prepare($sql) or die dbh->errstr;
3538 $sth->execute($self->custnum) or die $sth->errstr;
3539 $sth->fetchrow_arrayref->[0];
3542 =item unapplied_cust_pay
3544 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3548 sub unapplied_cust_pay {
3552 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3558 =item cust_pay_pkgnum
3560 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3561 package when using experimental package balances.
3565 sub cust_pay_pkgnum {
3566 my( $self, $pkgnum ) = @_;
3567 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3568 sort { $a->_date <=> $b->_date }
3569 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3570 'pkgnum' => $pkgnum,
3577 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3583 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3584 sort { $a->_date <=> $b->_date }
3585 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3588 =item cust_pay_pending
3590 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3591 (without status "done").
3595 sub cust_pay_pending {
3597 return $self->num_cust_pay_pending unless wantarray;
3598 sort { $a->_date <=> $b->_date }
3599 qsearch( 'cust_pay_pending', {
3600 'custnum' => $self->custnum,
3601 'status' => { op=>'!=', value=>'done' },
3606 =item cust_pay_pending_attempt
3608 Returns all payment attempts / declined payments for this customer, as pending
3609 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3610 a corresponding payment (see L<FS::cust_pay>).
3614 sub cust_pay_pending_attempt {
3616 return $self->num_cust_pay_pending_attempt unless wantarray;
3617 sort { $a->_date <=> $b->_date }
3618 qsearch( 'cust_pay_pending', {
3619 'custnum' => $self->custnum,
3626 =item num_cust_pay_pending
3628 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3629 customer (without status "done"). Also called automatically when the
3630 cust_pay_pending method is used in a scalar context.
3634 sub num_cust_pay_pending {
3637 " SELECT COUNT(*) FROM cust_pay_pending ".
3638 " WHERE custnum = ? AND status != 'done' ",
3643 =item num_cust_pay_pending_attempt
3645 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3646 customer, with status "done" but without a corresp. Also called automatically when the
3647 cust_pay_pending method is used in a scalar context.
3651 sub num_cust_pay_pending_attempt {
3654 " SELECT COUNT(*) FROM cust_pay_pending ".
3655 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3662 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3668 map { $_ } #return $self->num_cust_refund unless wantarray;
3669 sort { $a->_date <=> $b->_date }
3670 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3673 =item display_custnum
3675 Returns the displayed customer number for this customer: agent_custid if
3676 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3680 sub display_custnum {
3683 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3684 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3685 if ( $special eq 'CoStAg' ) {
3686 $prefix = uc( join('',
3688 ($self->state =~ /^(..)/),
3689 $prefix || ($self->agent->agent =~ /^(..)/)
3692 elsif ( $special eq 'CoStCl' ) {
3693 $prefix = uc( join('',
3695 ($self->state =~ /^(..)/),
3696 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3699 # add any others here if needed
3702 my $length = $conf->config('cust_main-custnum-display_length');
3703 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3704 return $self->agent_custid;
3705 } elsif ( $prefix ) {
3706 $length = 8 if !defined($length);
3708 sprintf('%0'.$length.'d', $self->custnum)
3709 } elsif ( $length ) {
3710 return sprintf('%0'.$length.'d', $self->custnum);
3712 return $self->custnum;
3718 Returns a name string for this customer, either "Company (Last, First)" or
3725 my $name = $self->contact;
3726 $name = $self->company. " ($name)" if $self->company;
3730 =item service_contact
3732 Returns the L<FS::contact> object for this customer that has the 'Service'
3733 contact class, or undef if there is no such contact. Deprecated; don't use
3738 sub service_contact {
3740 if ( !exists($self->{service_contact}) ) {
3741 my $classnum = $self->scalar_sql(
3742 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3743 ) || 0; #if it's zero, qsearchs will return nothing
3744 my $cust_contact = qsearchs('cust_contact', {
3745 'classnum' => $classnum,
3746 'custnum' => $self->custnum,
3748 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3750 $self->{service_contact};
3755 Returns a name string for this (service/shipping) contact, either
3756 "Company (Last, First)" or "Last, First".
3763 my $name = $self->ship_contact;
3764 $name = $self->company. " ($name)" if $self->company;
3770 Returns a name string for this customer, either "Company" or "First Last".
3776 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3779 =item ship_name_short
3781 Returns a name string for this (service/shipping) contact, either "Company"
3786 sub ship_name_short {
3788 $self->service_contact
3789 ? $self->ship_contact_firstlast
3795 Returns this customer's full (billing) contact name only, "Last, First"
3801 $self->get('last'). ', '. $self->first;
3806 Returns this customer's full (shipping) contact name only, "Last, First"
3812 my $contact = $self->service_contact || $self;
3813 $contact->get('last') . ', ' . $contact->get('first');
3816 =item contact_firstlast
3818 Returns this customers full (billing) contact name only, "First Last".
3822 sub contact_firstlast {
3824 $self->first. ' '. $self->get('last');
3827 =item ship_contact_firstlast
3829 Returns this customer's full (shipping) contact name only, "First Last".
3833 sub ship_contact_firstlast {
3835 my $contact = $self->service_contact || $self;
3836 $contact->get('first') . ' '. $contact->get('last');
3839 #XXX this doesn't work in 3.x+
3842 #Returns this customer's full country name
3848 # code2country($self->country);
3851 sub bill_country_full {
3853 code2country($self->bill_location->country);
3856 sub ship_country_full {
3858 code2country($self->ship_location->country);
3861 =item county_state_county [ PREFIX ]
3863 Returns a string consisting of just the county, state and country.
3867 sub county_state_country {
3870 if ( @_ && $_[0] && $self->has_ship_address ) {
3871 $locationnum = $self->ship_locationnum;
3873 $locationnum = $self->bill_locationnum;
3875 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3876 $cust_location->county_state_country;
3879 =item geocode DATA_VENDOR
3881 Returns a value for the customer location as encoded by DATA_VENDOR.
3882 Currently this only makes sense for "CCH" as DATA_VENDOR.
3890 Returns a status string for this customer, currently:
3896 No packages have ever been ordered. Displayed as "No packages".
3900 Recurring packages all are new (not yet billed).
3904 One or more recurring packages is active.
3908 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3912 All non-cancelled recurring packages are suspended.
3916 All recurring packages are cancelled.
3920 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3921 cust_main-status_module configuration option.
3925 sub status { shift->cust_status(@_); }
3929 for my $status ( FS::cust_main->statuses() ) {
3930 my $method = $status.'_sql';
3931 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3932 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3933 $sth->execute( ($self->custnum) x $numnum )
3934 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3935 return $status if $sth->fetchrow_arrayref->[0];
3939 =item is_status_delay_cancel
3941 Returns true if customer status is 'suspended'
3942 and all suspended cust_pkg return true for
3943 cust_pkg->is_status_delay_cancel.
3945 This is not a real status, this only meant for hacking display
3946 values, because otherwise treating the customer as suspended is
3947 really the whole point of the delay_cancel option.
3951 sub is_status_delay_cancel {
3953 return 0 unless $self->status eq 'suspended';
3954 foreach my $cust_pkg ($self->ncancelled_pkgs) {
3955 return 0 unless $cust_pkg->is_status_delay_cancel;
3960 =item ucfirst_cust_status
3962 =item ucfirst_status
3964 Deprecated, use the cust_status_label method instead.
3966 Returns the status with the first character capitalized.
3970 sub ucfirst_status {
3971 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3972 local($ucfirst_nowarn) = 1;
3973 shift->ucfirst_cust_status(@_);
3976 sub ucfirst_cust_status {
3977 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3979 ucfirst($self->cust_status);
3982 =item cust_status_label
3986 Returns the display label for this status.
3990 sub status_label { shift->cust_status_label(@_); }
3992 sub cust_status_label {
3994 __PACKAGE__->statuslabels->{$self->cust_status};
3999 Returns a hex triplet color string for this customer's status.
4003 sub statuscolor { shift->cust_statuscolor(@_); }
4005 sub cust_statuscolor {
4007 __PACKAGE__->statuscolors->{$self->cust_status};
4010 =item tickets [ STATUS ]
4012 Returns an array of hashes representing the customer's RT tickets.
4014 An optional status (or arrayref or hashref of statuses) may be specified.
4020 my $status = ( @_ && $_[0] ) ? shift : '';
4022 my $num = $conf->config('cust_main-max_tickets') || 10;
4025 if ( $conf->config('ticket_system') ) {
4026 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4028 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4037 foreach my $priority (
4038 $conf->config('ticket_system-custom_priority_field-values'), ''
4040 last if scalar(@tickets) >= $num;
4042 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4043 $num - scalar(@tickets),
4054 =item appointments [ STATUS ]
4056 Returns an array of hashes representing the customer's RT tickets which
4063 my $status = ( @_ && $_[0] ) ? shift : '';
4065 return () unless $conf->config('ticket_system');
4067 my $queueid = $conf->config('ticket_system-appointment-queueid');
4069 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4078 # Return services representing svc_accts in customer support packages
4079 sub support_services {
4081 my %packages = map { $_ => 1 } $conf->config('support_packages');
4083 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4084 grep { $_->part_svc->svcdb eq 'svc_acct' }
4085 map { $_->cust_svc }
4086 grep { exists $packages{ $_->pkgpart } }
4087 $self->ncancelled_pkgs;
4091 # Return a list of latitude/longitude for one of the services (if any)
4092 sub service_coordinates {
4096 grep { $_->latitude && $_->longitude }
4098 map { $_->cust_svc }
4099 $self->ncancelled_pkgs;
4101 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4106 Returns a masked version of the named field
4111 my ($self,$field) = @_;
4115 'x'x(length($self->getfield($field))-4).
4116 substr($self->getfield($field), (length($self->getfield($field))-4));
4120 =item payment_history
4122 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4123 cust_credit and cust_refund objects. Each hashref has the following fields:
4125 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4127 I<date> - value of _date field, unix timestamp
4129 I<date_pretty> - user-friendly date
4131 I<description> - user-friendly description of item
4133 I<amount> - impact of item on user's balance
4134 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4135 Not to be confused with the native 'amount' field in cust_credit, see below.
4137 I<amount_pretty> - includes money char
4139 I<balance> - customer balance, chronologically as of this item
4141 I<balance_pretty> - includes money char
4143 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4145 I<paid> - amount paid for cust_pay records, undef for other types
4147 I<credit> - amount credited for cust_credit records, undef for other types.
4148 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4150 I<refund> - amount refunded for cust_refund records, undef for other types
4152 The four table-specific keys always have positive values, whether they reflect charges or payments.
4154 The following options may be passed to this method:
4156 I<line_items> - if true, returns charges ('Line item') rather than invoices
4158 I<start_date> - unix timestamp, only include records on or after.
4159 If specified, an item of type 'Previous' will also be included.
4160 It does not have table-specific fields.
4162 I<end_date> - unix timestamp, only include records before
4164 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4166 I<conf> - optional already-loaded FS::Conf object.
4170 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4171 # and also for sending customer statements, which should both be kept customer-friendly.
4172 # If you add anything that shouldn't be passed on through the API or exposed
4173 # to customers, add a new option to include it, don't include it by default
4174 sub payment_history {
4176 my $opt = ref($_[0]) ? $_[0] : { @_ };
4178 my $conf = $$opt{'conf'} || new FS::Conf;
4179 my $money_char = $conf->config("money_char") || '$',
4181 #first load entire history,
4182 #need previous to calculate previous balance
4183 #loading after end_date shouldn't hurt too much?
4185 if ( $$opt{'line_items'} ) {
4187 foreach my $cust_bill ( $self->cust_bill ) {
4190 'type' => 'Line item',
4191 'description' => $_->desc( $self->locale ).
4192 ( $_->sdate && $_->edate
4193 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4194 ' To '. time2str('%d-%b-%Y', $_->edate)
4197 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4198 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4199 'date' => $cust_bill->_date,
4200 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4202 foreach $cust_bill->cust_bill_pkg;
4209 'type' => 'Invoice',
4210 'description' => 'Invoice #'. $_->display_invnum,
4211 'amount' => sprintf('%.2f', $_->charged ),
4212 'charged' => sprintf('%.2f', $_->charged ),
4213 'date' => $_->_date,
4214 'date_pretty' => $self->time2str_local('short', $_->_date ),
4216 foreach $self->cust_bill;
4221 'type' => 'Payment',
4222 'description' => 'Payment', #XXX type
4223 'amount' => sprintf('%.2f', 0 - $_->paid ),
4224 'paid' => sprintf('%.2f', $_->paid ),
4225 'date' => $_->_date,
4226 'date_pretty' => $self->time2str_local('short', $_->_date ),
4228 foreach $self->cust_pay;
4232 'description' => 'Credit', #more info?
4233 'amount' => sprintf('%.2f', 0 -$_->amount ),
4234 'credit' => sprintf('%.2f', $_->amount ),
4235 'date' => $_->_date,
4236 'date_pretty' => $self->time2str_local('short', $_->_date ),
4238 foreach $self->cust_credit;
4242 'description' => 'Refund', #more info? type, like payment?
4243 'amount' => $_->refund,
4244 'refund' => $_->refund,
4245 'date' => $_->_date,
4246 'date_pretty' => $self->time2str_local('short', $_->_date ),
4248 foreach $self->cust_refund;
4250 #put it all in chronological order
4251 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4253 #calculate balance, filter items outside date range
4257 foreach my $item (@history) {
4258 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4259 $balance += $$item{'amount'};
4260 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4261 $previous += $$item{'amount'};
4264 $$item{'balance'} = sprintf("%.2f",$balance);
4265 foreach my $key ( qw(amount balance) ) {
4266 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4271 # start with previous balance, if there was one
4274 'type' => 'Previous',
4275 'description' => 'Previous balance',
4276 'amount' => sprintf("%.2f",$previous),
4277 'balance' => sprintf("%.2f",$previous),
4278 'date' => $$opt{'start_date'},
4279 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4281 #false laziness with above
4282 foreach my $key ( qw(amount balance) ) {
4283 $$item{$key.'_pretty'} = $$item{$key};
4284 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4286 unshift(@out,$item);
4289 @out = reverse @history if $$opt{'reverse_sort'};
4296 =head1 CLASS METHODS
4302 Class method that returns the list of possible status strings for customers
4303 (see L<the status method|/status>). For example:
4305 @statuses = FS::cust_main->statuses();
4311 keys %{ $self->statuscolors };
4314 =item cust_status_sql
4316 Returns an SQL fragment to determine the status of a cust_main record, as a
4321 sub cust_status_sql {
4323 for my $status ( FS::cust_main->statuses() ) {
4324 my $method = $status.'_sql';
4325 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4334 Returns an SQL expression identifying prospective cust_main records (customers
4335 with no packages ever ordered)
4339 use vars qw($select_count_pkgs);
4340 $select_count_pkgs =
4341 "SELECT COUNT(*) FROM cust_pkg
4342 WHERE cust_pkg.custnum = cust_main.custnum";
4344 sub select_count_pkgs_sql {
4349 " 0 = ( $select_count_pkgs ) ";
4354 Returns an SQL expression identifying ordered cust_main records (customers with
4355 no active packages, but recurring packages not yet setup or one time charges
4361 FS::cust_main->none_active_sql.
4362 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4367 Returns an SQL expression identifying active cust_main records (customers with
4368 active recurring packages).
4373 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4376 =item none_active_sql
4378 Returns an SQL expression identifying cust_main records with no active
4379 recurring packages. This includes customers of status prospect, ordered,
4380 inactive, and suspended.
4384 sub none_active_sql {
4385 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4390 Returns an SQL expression identifying inactive cust_main records (customers with
4391 no active recurring packages, but otherwise unsuspended/uncancelled).
4396 FS::cust_main->none_active_sql.
4397 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4403 Returns an SQL expression identifying suspended cust_main records.
4408 sub suspended_sql { susp_sql(@_); }
4410 FS::cust_main->none_active_sql.
4411 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4417 Returns an SQL expression identifying cancelled cust_main records.
4421 sub cancel_sql { shift->cancelled_sql(@_); }
4424 =item uncancelled_sql
4426 Returns an SQL expression identifying un-cancelled cust_main records.
4430 sub uncancelled_sql { uncancel_sql(@_); }
4431 sub uncancel_sql { "
4432 ( 0 < ( $select_count_pkgs
4433 AND ( cust_pkg.cancel IS NULL
4434 OR cust_pkg.cancel = 0
4437 OR 0 = ( $select_count_pkgs )
4443 Returns an SQL fragment to retreive the balance.
4448 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4449 WHERE cust_bill.custnum = cust_main.custnum )
4450 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4451 WHERE cust_pay.custnum = cust_main.custnum )
4452 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4453 WHERE cust_credit.custnum = cust_main.custnum )
4454 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4455 WHERE cust_refund.custnum = cust_main.custnum )
4458 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4460 Returns an SQL fragment to retreive the balance for this customer, optionally
4461 considering invoices with date earlier than START_TIME, and not
4462 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4463 total_unapplied_payments).
4465 Times are specified as SQL fragments or numeric
4466 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4467 L<Date::Parse> for conversion functions. The empty string can be passed
4468 to disable that time constraint completely.
4470 Available options are:
4474 =item unapplied_date
4476 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)
4481 set to true to remove all customer comparison clauses, for totals
4486 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4491 JOIN clause (typically used with the total option)
4495 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4496 time will be ignored. Note that START_TIME and END_TIME only limit the date
4497 range for invoices and I<unapplied> payments, credits, and refunds.
4503 sub balance_date_sql {
4504 my( $class, $start, $end, %opt ) = @_;
4506 my $cutoff = $opt{'cutoff'};
4508 my $owed = FS::cust_bill->owed_sql($cutoff);
4509 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4510 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4511 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4513 my $j = $opt{'join'} || '';
4515 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4516 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4517 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4518 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4520 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4521 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4522 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4523 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4528 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4530 Returns an SQL fragment to retreive the total unapplied payments for this
4531 customer, only considering payments with date earlier than START_TIME, and
4532 optionally not later than END_TIME.
4534 Times are specified as SQL fragments or numeric
4535 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4536 L<Date::Parse> for conversion functions. The empty string can be passed
4537 to disable that time constraint completely.
4539 Available options are:
4543 sub unapplied_payments_date_sql {
4544 my( $class, $start, $end, %opt ) = @_;
4546 my $cutoff = $opt{'cutoff'};
4548 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4550 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4551 'unapplied_date'=>1 );
4553 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4556 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4558 Helper method for balance_date_sql; name (and usage) subject to change
4559 (suggestions welcome).
4561 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4562 cust_refund, cust_credit or cust_pay).
4564 If TABLE is "cust_bill" or the unapplied_date option is true, only
4565 considers records with date earlier than START_TIME, and optionally not
4566 later than END_TIME .
4570 sub _money_table_where {
4571 my( $class, $table, $start, $end, %opt ) = @_;
4574 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4575 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4576 push @where, "$table._date <= $start" if defined($start) && length($start);
4577 push @where, "$table._date > $end" if defined($end) && length($end);
4579 push @where, @{$opt{'where'}} if $opt{'where'};
4580 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4586 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4587 use FS::cust_main::Search;
4590 FS::cust_main::Search->search(@_);
4599 #=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4601 #Deprecated. Use event notification and message templates
4602 #(L<FS::msg_template>) instead.
4604 #Sends a templated email notification to the customer (see L<Text::Template>).
4606 #OPTIONS is a hash and may include
4608 #I<from> - the email sender (default is invoice_from)
4610 #I<to> - comma-separated scalar or arrayref of recipients
4611 # (default is invoicing_list)
4613 #I<subject> - The subject line of the sent email notification
4614 # (default is "Notice from company_name")
4616 #I<extra_fields> - a hashref of name/value pairs which will be substituted
4619 #The following variables are vavailable in the template.
4621 #I<$first> - the customer first name
4622 #I<$last> - the customer last name
4623 #I<$company> - the customer company
4624 #I<$payby> - a description of the method of payment for the customer
4625 # # would be nice to use FS::payby::shortname
4626 #I<$payinfo> - the account information used to collect for this customer
4627 #I<$expdate> - the expiration of the customer payment in seconds from epoch
4632 # my ($self, $template, %options) = @_;
4634 # return unless $conf->exists($template);
4636 # my $from = $conf->invoice_from_full($self->agentnum)
4637 # if $conf->exists('invoice_from', $self->agentnum);
4638 # $from = $options{from} if exists($options{from});
4640 # my $to = join(',', $self->invoicing_list_emailonly);
4641 # $to = $options{to} if exists($options{to});
4643 # my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4644 # if $conf->exists('company_name', $self->agentnum);
4645 # $subject = $options{subject} if exists($options{subject});
4647 # my $notify_template = new Text::Template (TYPE => 'ARRAY',
4648 # SOURCE => [ map "$_\n",
4649 # $conf->config($template)]
4651 # or die "can't create new Text::Template object: Text::Template::ERROR";
4652 # $notify_template->compile()
4653 # or die "can't compile template: Text::Template::ERROR";
4655 # $FS::notify_template::_template::company_name =
4656 # $conf->config('company_name', $self->agentnum);
4657 # $FS::notify_template::_template::company_address =
4658 # join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4660 # my $paydate = $self->paydate || '2037-12-31';
4661 # $FS::notify_template::_template::first = $self->first;
4662 # $FS::notify_template::_template::last = $self->last;
4663 # $FS::notify_template::_template::company = $self->company;
4664 # $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4665 # my $payby = $self->payby;
4666 # my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4667 # my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4669 # #credit cards expire at the end of the month/year of their exp date
4670 # if ($payby eq 'CARD' || $payby eq 'DCRD') {
4671 # $FS::notify_template::_template::payby = 'credit card';
4672 # ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4673 # $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4675 # }elsif ($payby eq 'COMP') {
4676 # $FS::notify_template::_template::payby = 'complimentary account';
4678 # $FS::notify_template::_template::payby = 'current method';
4680 # $FS::notify_template::_template::expdate = $expire_time;
4682 # for (keys %{$options{extra_fields}}){
4684 # ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4687 # send_email(from => $from,
4689 # subject => $subject,
4690 # body => $notify_template->fill_in( PACKAGE =>
4691 # 'FS::notify_template::_template' ),
4696 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4698 Generates a templated notification to the customer (see L<Text::Template>).
4700 OPTIONS is a hash and may include
4702 I<extra_fields> - a hashref of name/value pairs which will be substituted
4703 into the template. These values may override values mentioned below
4704 and those from the customer record.
4706 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
4708 The following variables are available in the template instead of or in addition
4709 to the fields of the customer record.
4711 I<$payby> - a description of the method of payment for the customer
4712 # would be nice to use FS::payby::shortname
4713 I<$payinfo> - the masked account information used to collect for this customer
4714 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4715 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4719 # a lot like cust_bill::print_latex
4720 sub generate_letter {
4721 my ($self, $template, %options) = @_;
4723 warn "Template $template does not exist" && return
4724 unless $conf->exists($template) || $options{'template_text'};
4726 my $template_source = $options{'template_text'}
4727 ? [ $options{'template_text'} ]
4728 : [ map "$_\n", $conf->config($template) ];
4730 my $letter_template = new Text::Template
4732 SOURCE => $template_source,
4733 DELIMITERS => [ '[@--', '--@]' ],
4735 or die "can't create new Text::Template object: Text::Template::ERROR";
4737 $letter_template->compile()
4738 or die "can't compile template: Text::Template::ERROR";
4740 my %letter_data = map { $_ => $self->$_ } $self->fields;
4741 $letter_data{payinfo} = $self->mask_payinfo;
4743 #my $paydate = $self->paydate || '2037-12-31';
4744 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4746 my $payby = $self->payby;
4747 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4748 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4750 #credit cards expire at the end of the month/year of their exp date
4751 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4752 $letter_data{payby} = 'credit card';
4753 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4754 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4756 }elsif ($payby eq 'COMP') {
4757 $letter_data{payby} = 'complimentary account';
4759 $letter_data{payby} = 'current method';
4761 $letter_data{expdate} = $expire_time;
4763 for (keys %{$options{extra_fields}}){
4764 $letter_data{$_} = $options{extra_fields}->{$_};
4767 unless(exists($letter_data{returnaddress})){
4768 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4769 $self->agent_template)
4771 if ( length($retadd) ) {
4772 $letter_data{returnaddress} = $retadd;
4773 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4774 $letter_data{returnaddress} =
4775 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4779 ( $conf->config('company_name', $self->agentnum),
4780 $conf->config('company_address', $self->agentnum),
4784 $letter_data{returnaddress} = '~';
4788 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4790 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4792 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4794 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4798 ) or die "can't open temp file: $!\n";
4799 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4800 or die "can't write temp file: $!\n";
4802 $letter_data{'logo_file'} = $lh->filename;
4804 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4808 ) or die "can't open temp file: $!\n";
4810 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4812 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4813 return ($1, $letter_data{'logo_file'});
4817 =item print_ps TEMPLATE
4819 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4825 my($file, $lfile) = $self->generate_letter(@_);
4826 my $ps = FS::Misc::generate_ps($file);
4827 unlink($file.'.tex');
4833 =item print TEMPLATE
4835 Prints the filled in template.
4837 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4841 sub queueable_print {
4844 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4845 or die "invalid customer number: " . $opt{custnum};
4847 #do not backport this change to 3.x
4848 # my $error = $self->print( { 'template' => $opt{template} } );
4849 my $error = $self->print( $opt{'template'} );
4850 die $error if $error;
4854 my ($self, $template) = (shift, shift);
4856 [ $self->print_ps($template) ],
4857 'agentnum' => $self->agentnum,
4861 #these three subs should just go away once agent stuff is all config overrides
4863 sub agent_template {
4865 $self->_agent_plandata('agent_templatename');
4868 sub agent_invoice_from {
4870 $self->_agent_plandata('agent_invoice_from');
4873 sub _agent_plandata {
4874 my( $self, $option ) = @_;
4876 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4877 #agent-specific Conf
4879 use FS::part_event::Condition;
4881 my $agentnum = $self->agentnum;
4883 my $regexp = regexp_sql();
4885 my $part_event_option =
4887 'select' => 'part_event_option.*',
4888 'table' => 'part_event_option',
4890 LEFT JOIN part_event USING ( eventpart )
4891 LEFT JOIN part_event_option AS peo_agentnum
4892 ON ( part_event.eventpart = peo_agentnum.eventpart
4893 AND peo_agentnum.optionname = 'agentnum'
4894 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4896 LEFT JOIN part_event_condition
4897 ON ( part_event.eventpart = part_event_condition.eventpart
4898 AND part_event_condition.conditionname = 'cust_bill_age'
4900 LEFT JOIN part_event_condition_option
4901 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4902 AND part_event_condition_option.optionname = 'age'
4905 #'hashref' => { 'optionname' => $option },
4906 #'hashref' => { 'part_event_option.optionname' => $option },
4908 " WHERE part_event_option.optionname = ". dbh->quote($option).
4909 " AND action = 'cust_bill_send_agent' ".
4910 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4911 " AND peo_agentnum.optionname = 'agentnum' ".
4912 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4914 CASE WHEN part_event_condition_option.optionname IS NULL
4916 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4918 , part_event.weight".
4922 unless ( $part_event_option ) {
4923 return $self->agent->invoice_template || ''
4924 if $option eq 'agent_templatename';
4928 $part_event_option->optionvalue;
4932 sub process_o2m_qsearch {
4935 return qsearch($table, @_) unless $table eq 'contact';
4937 my $hashref = shift;
4938 my %hash = %$hashref;
4939 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4940 or die 'guru meditation #4343';
4942 qsearch({ 'table' => 'contact',
4943 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4944 'hashref' => \%hash,
4945 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4946 " cust_contact.custnum = $custnum "
4950 sub process_o2m_qsearchs {
4953 return qsearchs($table, @_) unless $table eq 'contact';
4955 my $hashref = shift;
4956 my %hash = %$hashref;
4957 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4958 or die 'guru meditation #2121';
4960 qsearchs({ 'table' => 'contact',
4961 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4962 'hashref' => \%hash,
4963 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4964 " cust_contact.custnum = $custnum "
4968 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4970 Subroutine (not a method), designed to be called from the queue.
4972 Takes a list of options and values.
4974 Pulls up the customer record via the custnum option and calls bill_and_collect.
4979 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4981 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4982 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4984 #without this errors don't get rolled back
4985 $args{'fatal'} = 1; # runs from job queue, will be caught
4987 $cust_main->bill_and_collect( %args );
4990 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4992 Like queued_bill, but instead of C<bill_and_collect>, just runs the
4993 C<collect> part. This is used in batch tax calculation, where invoice
4994 generation and collection events have to be completely separated.
4998 sub queued_collect {
5000 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5002 $cust_main->collect(%args);
5005 sub process_bill_and_collect {
5008 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5009 or die "custnum '$param->{custnum}' not found!\n";
5010 $param->{'job'} = $job;
5011 $param->{'fatal'} = 1; # runs from job queue, will be caught
5012 $param->{'retry'} = 1;
5014 $cust_main->bill_and_collect( %$param );
5017 #starting to take quite a while for big dbs
5018 # (JRNL: journaled so it only happens once per database)
5019 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5020 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5021 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5022 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5023 # JRNL leading/trailing spaces in first, last, company
5024 # JRNL migrate to cust_payby
5025 # - otaker upgrade? journal and call it good? (double check to make sure
5026 # we're not still setting otaker here)
5028 #only going to get worse with new location stuff...
5030 sub _upgrade_data { #class method
5031 my ($class, %opts) = @_;
5034 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5037 #this seems to be the only expensive one.. why does it take so long?
5038 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5040 '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';
5041 FS::upgrade_journal->set_done('cust_main__signupdate');
5044 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5046 # fix yyyy-m-dd formatted paydates
5047 if ( driver_name =~ /^mysql/i ) {
5049 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5050 } else { # the SQL standard
5052 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5054 FS::upgrade_journal->set_done('cust_main__paydate');
5057 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5059 push @statements, #fix the weird BILL with a cc# in payinfo problem
5061 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5063 FS::upgrade_journal->set_done('cust_main__payinfo');
5068 foreach my $sql ( @statements ) {
5069 my $sth = dbh->prepare($sql) or die dbh->errstr;
5070 $sth->execute or die $sth->errstr;
5071 #warn ( (time - $t). " seconds\n" );
5075 local($ignore_expired_card) = 1;
5076 local($ignore_banned_card) = 1;
5077 local($skip_fuzzyfiles) = 1;
5078 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5080 FS::cust_main::Location->_upgrade_data(%opts);
5082 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5084 foreach my $cust_main ( qsearch({
5085 'table' => 'cust_main',
5087 'extra_sql' => 'WHERE '.
5089 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5090 qw( first last company )
5093 my $error = $cust_main->replace;
5094 die $error if $error;
5097 FS::upgrade_journal->set_done('cust_main__trimspaces');
5101 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
5103 #we don't want to decrypt them, just stuff them as-is into cust_payby
5104 local(@encrypted_fields) = ();
5106 local($FS::cust_payby::ignore_expired_card) = 1;
5107 local($FS::cust_payby::ignore_banned_card) = 1;
5109 my @payfields = qw( payby payinfo paycvv paymask
5110 paydate paystart_month paystart_year payissue
5111 payname paystate paytype payip
5114 my $search = new FS::Cursor {
5115 'table' => 'cust_main',
5116 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
5119 while (my $cust_main = $search->fetch) {
5121 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
5123 my $cust_payby = new FS::cust_payby {
5124 'custnum' => $cust_main->custnum,
5126 map { $_ => $cust_main->$_(); } @payfields
5129 my $error = $cust_payby->insert;
5130 die $error if $error;
5134 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
5136 $cust_main->invoice_attn( $cust_main->payname )
5137 if $cust_main->payby eq 'BILL' && $cust_main->payname;
5138 $cust_main->po_number( $cust_main->payinfo )
5139 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
5141 $cust_main->setfield($_, '') foreach @payfields;
5142 my $error = $cust_main->replace;
5143 die "Error upgradging payment information for custnum ".
5144 $cust_main->custnum. ": $error"
5149 FS::upgrade_journal->set_done('cust_main__cust_payby');
5152 $class->_upgrade_otaker(%opts);
5162 The delete method should possibly take an FS::cust_main object reference
5163 instead of a scalar customer number.
5165 Bill and collect options should probably be passed as references instead of a
5168 There should probably be a configuration file with a list of allowed credit
5171 No multiple currency support (probably a larger project than just this module).
5173 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5175 Birthdates rely on negative epoch values.
5177 The payby for card/check batches is broken. With mixed batching, bad
5180 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5184 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5185 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5186 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.