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 : {};
365 if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
366 warn "cust_main::insert using deprecated invoicing list argument";
367 $invoicing_list = shift;
370 warn "$me insert called with options ".
371 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
374 local $SIG{HUP} = 'IGNORE';
375 local $SIG{INT} = 'IGNORE';
376 local $SIG{QUIT} = 'IGNORE';
377 local $SIG{TERM} = 'IGNORE';
378 local $SIG{TSTP} = 'IGNORE';
379 local $SIG{PIPE} = 'IGNORE';
381 my $oldAutoCommit = $FS::UID::AutoCommit;
382 local $FS::UID::AutoCommit = 0;
385 my $prepay_identifier = '';
386 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
388 if ( $self->payby eq 'PREPAY' ) {
390 $self->payby(''); #'BILL');
391 $prepay_identifier = $self->payinfo;
394 warn " looking up prepaid card $prepay_identifier\n"
397 my $error = $self->get_prepay( $prepay_identifier,
398 'amount_ref' => \$amount,
399 'seconds_ref' => \$seconds,
400 'upbytes_ref' => \$upbytes,
401 'downbytes_ref' => \$downbytes,
402 'totalbytes_ref' => \$totalbytes,
405 $dbh->rollback if $oldAutoCommit;
406 #return "error applying prepaid card (transaction rolled back): $error";
410 $payby = 'PREP' if $amount;
412 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
415 $self->payby(''); #'BILL');
416 $amount = $self->paid;
421 foreach my $l (qw(bill_location ship_location)) {
423 my $loc = delete $self->hashref->{$l} or next;
425 if ( !$loc->locationnum ) {
426 # warn the location that we're going to insert it with no custnum
427 $loc->set(custnum_pending => 1);
428 warn " inserting $l\n"
430 my $error = $loc->insert;
432 $dbh->rollback if $oldAutoCommit;
433 my $label = $l eq 'ship_location' ? 'service' : 'billing';
434 return "$error (in $label location)";
437 } elsif ( $loc->prospectnum ) {
439 $loc->prospectnum('');
440 $loc->set(custnum_pending => 1);
441 my $error = $loc->replace;
443 $dbh->rollback if $oldAutoCommit;
444 my $label = $l eq 'ship_location' ? 'service' : 'billing';
445 return "$error (moving $label location)";
448 } elsif ( ($loc->custnum || 0) > 0 ) {
449 # then it somehow belongs to another customer--shouldn't happen
450 $dbh->rollback if $oldAutoCommit;
451 return "$l belongs to customer ".$loc->custnum;
453 # else it already belongs to this customer
454 # (happens when ship_location is identical to bill_location)
456 $self->set($l.'num', $loc->locationnum);
458 if ( $self->get($l.'num') eq '' ) {
459 $dbh->rollback if $oldAutoCommit;
464 warn " inserting $self\n"
467 $self->signupdate(time) unless $self->signupdate;
469 $self->auto_agent_custid()
470 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
472 my $error = $self->SUPER::insert;
474 $dbh->rollback if $oldAutoCommit;
475 #return "inserting cust_main record (transaction rolled back): $error";
479 # now set cust_location.custnum
480 foreach my $l (qw(bill_location ship_location)) {
481 warn " setting $l.custnum\n"
483 my $loc = $self->$l or next;
484 unless ( $loc->custnum ) {
485 $loc->set(custnum => $self->custnum);
486 $error ||= $loc->replace;
490 $dbh->rollback if $oldAutoCommit;
491 return "error setting $l custnum: $error";
495 warn " setting customer tags\n"
498 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
499 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
500 'custnum' => $self->custnum };
501 my $error = $cust_tag->insert;
503 $dbh->rollback if $oldAutoCommit;
508 my $prospectnum = delete $options{'prospectnum'};
509 if ( $prospectnum ) {
511 warn " moving contacts and locations from prospect $prospectnum\n"
515 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
516 unless ( $prospect_main ) {
517 $dbh->rollback if $oldAutoCommit;
518 return "Unknown prospectnum $prospectnum";
520 $prospect_main->custnum($self->custnum);
521 $prospect_main->disabled('Y');
522 my $error = $prospect_main->replace;
524 $dbh->rollback if $oldAutoCommit;
528 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
529 my $cust_contact = new FS::cust_contact {
530 'custnum' => $self->custnum,
531 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
533 my $error = $cust_contact->insert
534 || $prospect_contact->delete;
536 $dbh->rollback if $oldAutoCommit;
541 my @cust_location = $prospect_main->cust_location;
542 my @qual = $prospect_main->qual;
544 foreach my $r ( @cust_location, @qual ) {
546 $r->custnum($self->custnum);
547 my $error = $r->replace;
549 $dbh->rollback if $oldAutoCommit;
556 warn " setting contacts\n"
559 $invoicing_list ||= $options{'invoicing_list'};
560 if ( $invoicing_list ) {
562 $invoicing_list = join(',', @$invoicing_list) if ref $invoicing_list;
563 my $contact = FS::contact->new({
564 'custnum' => $self->get('custnum'),
565 'last' => $self->get('last'),
566 'first' => $self->get('first'),
567 'emailaddress' => $invoicing_list,
568 'invoice_dest' => 'Y',
570 my $error = $contact->insert;
572 $dbh->rollback if $oldAutoCommit;
578 if ( my $contact = delete $options{'contact'} ) {
580 foreach my $c ( @$contact ) {
581 $c->custnum($self->custnum);
582 my $error = $c->insert;
584 $dbh->rollback if $oldAutoCommit;
590 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
592 my $error = $self->process_o2m( 'table' => 'contact',
593 'fields' => FS::contact->cgi_contact_fields,
594 'params' => $contact_params,
597 $dbh->rollback if $oldAutoCommit;
602 warn " setting cust_payby\n"
605 if ( $options{cust_payby} ) {
607 foreach my $cust_payby ( @{ $options{cust_payby} } ) {
608 $cust_payby->custnum($self->custnum);
609 my $error = $cust_payby->insert;
611 $dbh->rollback if $oldAutoCommit;
616 } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
618 my $error = $self->process_o2m(
619 'table' => 'cust_payby',
620 'fields' => FS::cust_payby->cgi_cust_payby_fields,
621 'params' => $cust_payby_params,
622 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
625 $dbh->rollback if $oldAutoCommit;
631 warn " setting cust_main_exemption\n"
634 my $tax_exemption = delete $options{'tax_exemption'};
635 if ( $tax_exemption ) {
637 $tax_exemption = { map { $_ => '' } @$tax_exemption }
638 if ref($tax_exemption) eq 'ARRAY';
640 foreach my $taxname ( keys %$tax_exemption ) {
641 my $cust_main_exemption = new FS::cust_main_exemption {
642 'custnum' => $self->custnum,
643 'taxname' => $taxname,
644 'exempt_number' => $tax_exemption->{$taxname},
646 my $error = $cust_main_exemption->insert;
648 $dbh->rollback if $oldAutoCommit;
649 return "inserting cust_main_exemption (transaction rolled back): $error";
654 warn " ordering packages\n"
657 $error = $self->order_pkgs( $cust_pkgs,
659 'seconds_ref' => \$seconds,
660 'upbytes_ref' => \$upbytes,
661 'downbytes_ref' => \$downbytes,
662 'totalbytes_ref' => \$totalbytes,
665 $dbh->rollback if $oldAutoCommit;
670 $dbh->rollback if $oldAutoCommit;
671 return "No svc_acct record to apply pre-paid time";
673 if ( $upbytes || $downbytes || $totalbytes ) {
674 $dbh->rollback if $oldAutoCommit;
675 return "No svc_acct record to apply pre-paid data";
679 warn " inserting initial $payby payment of $amount\n"
681 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
683 $dbh->rollback if $oldAutoCommit;
684 return "inserting payment (transaction rolled back): $error";
688 unless ( $import || $skip_fuzzyfiles ) {
689 warn " queueing fuzzyfiles update\n"
691 $error = $self->queue_fuzzyfiles_update;
693 $dbh->rollback if $oldAutoCommit;
694 return "updating fuzzy search cache: $error";
698 # FS::geocode_Mixin::after_insert or something?
699 if ( $conf->config('tax_district_method') and !$import ) {
700 # if anything non-empty, try to look it up
701 my $queue = new FS::queue {
702 'job' => 'FS::geocode_Mixin::process_district_update',
703 'custnum' => $self->custnum,
705 my $error = $queue->insert( ref($self), $self->custnum );
707 $dbh->rollback if $oldAutoCommit;
708 return "queueing tax district update: $error";
713 warn " exporting\n" if $DEBUG > 1;
715 my $export_args = $options{'export_args'} || [];
718 map qsearch( 'part_export', {exportnum=>$_} ),
719 $conf->config('cust_main-exports'); #, $agentnum
721 foreach my $part_export ( @part_export ) {
722 my $error = $part_export->export_insert($self, @$export_args);
724 $dbh->rollback if $oldAutoCommit;
725 return "exporting to ". $part_export->exporttype.
726 " (transaction rolled back): $error";
730 #foreach my $depend_jobnum ( @$depend_jobnums ) {
731 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
733 # foreach my $jobnum ( @jobnums ) {
734 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
735 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
737 # my $error = $queue->depend_insert($depend_jobnum);
739 # $dbh->rollback if $oldAutoCommit;
740 # return "error queuing job dependancy: $error";
747 #if ( exists $options{'jobnums'} ) {
748 # push @{ $options{'jobnums'} }, @jobnums;
751 warn " insert complete; committing transaction\n"
754 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
759 use File::CounterFile;
760 sub auto_agent_custid {
763 my $format = $conf->config('cust_main-auto_agent_custid');
765 if ( $format eq '1YMMXXXXXXXX' ) {
767 my $counter = new File::CounterFile 'cust_main.agent_custid';
770 my $ym = 100000000000 + time2str('%y%m00000000', time);
771 if ( $ym > $counter->value ) {
772 $counter->{'value'} = $agent_custid = $ym;
773 $counter->{'updated'} = 1;
775 $agent_custid = $counter->inc;
781 die "Unknown cust_main-auto_agent_custid format: $format";
784 $self->agent_custid($agent_custid);
788 =item PACKAGE METHODS
790 Documentation on customer package methods has been moved to
791 L<FS::cust_main::Packages>.
793 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
795 Recharges this (existing) customer with the specified prepaid card (see
796 L<FS::prepay_credit>), specified either by I<identifier> or as an
797 FS::prepay_credit object. If there is an error, returns the error, otherwise
800 Optionally, five scalar references can be passed as well. They will have their
801 values filled in with the amount, number of seconds, and number of upload,
802 download, and total bytes applied by this prepaid card.
806 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
807 #the only place that uses these args
808 sub recharge_prepay {
809 my( $self, $prepay_credit, $amountref, $secondsref,
810 $upbytesref, $downbytesref, $totalbytesref ) = @_;
812 local $SIG{HUP} = 'IGNORE';
813 local $SIG{INT} = 'IGNORE';
814 local $SIG{QUIT} = 'IGNORE';
815 local $SIG{TERM} = 'IGNORE';
816 local $SIG{TSTP} = 'IGNORE';
817 local $SIG{PIPE} = 'IGNORE';
819 my $oldAutoCommit = $FS::UID::AutoCommit;
820 local $FS::UID::AutoCommit = 0;
823 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
825 my $error = $self->get_prepay( $prepay_credit,
826 'amount_ref' => \$amount,
827 'seconds_ref' => \$seconds,
828 'upbytes_ref' => \$upbytes,
829 'downbytes_ref' => \$downbytes,
830 'totalbytes_ref' => \$totalbytes,
832 || $self->increment_seconds($seconds)
833 || $self->increment_upbytes($upbytes)
834 || $self->increment_downbytes($downbytes)
835 || $self->increment_totalbytes($totalbytes)
836 || $self->insert_cust_pay_prepay( $amount,
838 ? $prepay_credit->identifier
843 $dbh->rollback if $oldAutoCommit;
847 if ( defined($amountref) ) { $$amountref = $amount; }
848 if ( defined($secondsref) ) { $$secondsref = $seconds; }
849 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
850 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
851 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
853 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
858 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
860 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
861 specified either by I<identifier> or as an FS::prepay_credit object.
863 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
864 incremented by the values of the prepaid card.
866 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
867 check or set this customer's I<agentnum>.
869 If there is an error, returns the error, otherwise returns false.
875 my( $self, $prepay_credit, %opt ) = @_;
877 local $SIG{HUP} = 'IGNORE';
878 local $SIG{INT} = 'IGNORE';
879 local $SIG{QUIT} = 'IGNORE';
880 local $SIG{TERM} = 'IGNORE';
881 local $SIG{TSTP} = 'IGNORE';
882 local $SIG{PIPE} = 'IGNORE';
884 my $oldAutoCommit = $FS::UID::AutoCommit;
885 local $FS::UID::AutoCommit = 0;
888 unless ( ref($prepay_credit) ) {
890 my $identifier = $prepay_credit;
892 $prepay_credit = qsearchs(
894 { 'identifier' => $identifier },
899 unless ( $prepay_credit ) {
900 $dbh->rollback if $oldAutoCommit;
901 return "Invalid prepaid card: ". $identifier;
906 if ( $prepay_credit->agentnum ) {
907 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
908 $dbh->rollback if $oldAutoCommit;
909 return "prepaid card not valid for agent ". $self->agentnum;
911 $self->agentnum($prepay_credit->agentnum);
914 my $error = $prepay_credit->delete;
916 $dbh->rollback if $oldAutoCommit;
917 return "removing prepay_credit (transaction rolled back): $error";
920 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
921 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
923 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
928 =item increment_upbytes SECONDS
930 Updates this customer's single or primary account (see L<FS::svc_acct>) by
931 the specified number of upbytes. If there is an error, returns the error,
932 otherwise returns false.
936 sub increment_upbytes {
937 _increment_column( shift, 'upbytes', @_);
940 =item increment_downbytes SECONDS
942 Updates this customer's single or primary account (see L<FS::svc_acct>) by
943 the specified number of downbytes. If there is an error, returns the error,
944 otherwise returns false.
948 sub increment_downbytes {
949 _increment_column( shift, 'downbytes', @_);
952 =item increment_totalbytes SECONDS
954 Updates this customer's single or primary account (see L<FS::svc_acct>) by
955 the specified number of totalbytes. If there is an error, returns the error,
956 otherwise returns false.
960 sub increment_totalbytes {
961 _increment_column( shift, 'totalbytes', @_);
964 =item increment_seconds SECONDS
966 Updates this customer's single or primary account (see L<FS::svc_acct>) by
967 the specified number of seconds. If there is an error, returns the error,
968 otherwise returns false.
972 sub increment_seconds {
973 _increment_column( shift, 'seconds', @_);
976 =item _increment_column AMOUNT
978 Updates this customer's single or primary account (see L<FS::svc_acct>) by
979 the specified number of seconds or bytes. If there is an error, returns
980 the error, otherwise returns false.
984 sub _increment_column {
985 my( $self, $column, $amount ) = @_;
986 warn "$me increment_column called: $column, $amount\n"
989 return '' unless $amount;
991 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
992 $self->ncancelled_pkgs;
995 return 'No packages with primary or single services found'.
996 ' to apply pre-paid time';
997 } elsif ( scalar(@cust_pkg) > 1 ) {
998 #maybe have a way to specify the package/account?
999 return 'Multiple packages found to apply pre-paid time';
1002 my $cust_pkg = $cust_pkg[0];
1003 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1007 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1009 if ( ! @cust_svc ) {
1010 return 'No account found to apply pre-paid time';
1011 } elsif ( scalar(@cust_svc) > 1 ) {
1012 return 'Multiple accounts found to apply pre-paid time';
1015 my $svc_acct = $cust_svc[0]->svc_x;
1016 warn " found service svcnum ". $svc_acct->pkgnum.
1017 ' ('. $svc_acct->email. ")\n"
1020 $column = "increment_$column";
1021 $svc_acct->$column($amount);
1025 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1027 Inserts a prepayment in the specified amount for this customer. An optional
1028 second argument can specify the prepayment identifier for tracking purposes.
1029 If there is an error, returns the error, otherwise returns false.
1033 sub insert_cust_pay_prepay {
1034 shift->insert_cust_pay('PREP', @_);
1037 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1039 Inserts a cash payment in the specified amount for this customer. An optional
1040 second argument can specify the payment identifier for tracking purposes.
1041 If there is an error, returns the error, otherwise returns false.
1045 sub insert_cust_pay_cash {
1046 shift->insert_cust_pay('CASH', @_);
1049 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1051 Inserts a Western Union payment in the specified amount for this customer. An
1052 optional second argument can specify the prepayment identifier for tracking
1053 purposes. If there is an error, returns the error, otherwise returns false.
1057 sub insert_cust_pay_west {
1058 shift->insert_cust_pay('WEST', @_);
1061 sub insert_cust_pay {
1062 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1063 my $payinfo = scalar(@_) ? shift : '';
1065 my $cust_pay = new FS::cust_pay {
1066 'custnum' => $self->custnum,
1067 'paid' => sprintf('%.2f', $amount),
1068 #'_date' => #date the prepaid card was purchased???
1070 'payinfo' => $payinfo,
1076 =item delete [ OPTION => VALUE ... ]
1078 This deletes the customer. If there is an error, returns the error, otherwise
1081 This will completely remove all traces of the customer record. This is not
1082 what you want when a customer cancels service; for that, cancel all of the
1083 customer's packages (see L</cancel>).
1085 If the customer has any uncancelled packages, you need to pass a new (valid)
1086 customer number for those packages to be transferred to, as the "new_customer"
1087 option. Cancelled packages will be deleted. Did I mention that this is NOT
1088 what you want when a customer cancels service and that you really should be
1089 looking at L<FS::cust_pkg/cancel>?
1091 You can't delete a customer with invoices (see L<FS::cust_bill>),
1092 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1093 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1094 set the "delete_financials" option to a true value.
1099 my( $self, %opt ) = @_;
1101 local $SIG{HUP} = 'IGNORE';
1102 local $SIG{INT} = 'IGNORE';
1103 local $SIG{QUIT} = 'IGNORE';
1104 local $SIG{TERM} = 'IGNORE';
1105 local $SIG{TSTP} = 'IGNORE';
1106 local $SIG{PIPE} = 'IGNORE';
1108 my $oldAutoCommit = $FS::UID::AutoCommit;
1109 local $FS::UID::AutoCommit = 0;
1112 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1113 $dbh->rollback if $oldAutoCommit;
1114 return "Can't delete a master agent customer";
1117 #use FS::access_user
1118 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1119 $dbh->rollback if $oldAutoCommit;
1120 return "Can't delete a master employee customer";
1123 tie my %financial_tables, 'Tie::IxHash',
1124 'cust_bill' => 'invoices',
1125 'cust_statement' => 'statements',
1126 'cust_credit' => 'credits',
1127 'cust_pay' => 'payments',
1128 'cust_refund' => 'refunds',
1131 foreach my $table ( keys %financial_tables ) {
1133 my @records = $self->$table();
1135 if ( @records && ! $opt{'delete_financials'} ) {
1136 $dbh->rollback if $oldAutoCommit;
1137 return "Can't delete a customer with ". $financial_tables{$table};
1140 foreach my $record ( @records ) {
1141 my $error = $record->delete;
1143 $dbh->rollback if $oldAutoCommit;
1144 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1150 my @cust_pkg = $self->ncancelled_pkgs;
1152 my $new_custnum = $opt{'new_custnum'};
1153 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1154 $dbh->rollback if $oldAutoCommit;
1155 return "Invalid new customer number: $new_custnum";
1157 foreach my $cust_pkg ( @cust_pkg ) {
1158 my %hash = $cust_pkg->hash;
1159 $hash{'custnum'} = $new_custnum;
1160 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1161 my $error = $new_cust_pkg->replace($cust_pkg,
1162 options => { $cust_pkg->options },
1165 $dbh->rollback if $oldAutoCommit;
1170 my @cancelled_cust_pkg = $self->all_pkgs;
1171 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1172 my $error = $cust_pkg->delete;
1174 $dbh->rollback if $oldAutoCommit;
1179 #cust_tax_adjustment in financials?
1180 #cust_pay_pending? ouch
1181 foreach my $table (qw(
1182 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1183 cust_payby cust_location cust_main_note cust_tax_adjustment
1184 cust_pay_void cust_pay_batch queue cust_tax_exempt
1186 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1187 my $error = $record->delete;
1189 $dbh->rollback if $oldAutoCommit;
1195 my $sth = $dbh->prepare(
1196 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1198 my $errstr = $dbh->errstr;
1199 $dbh->rollback if $oldAutoCommit;
1202 $sth->execute($self->custnum) or do {
1203 my $errstr = $sth->errstr;
1204 $dbh->rollback if $oldAutoCommit;
1210 my $ticket_dbh = '';
1211 if ($conf->config('ticket_system') eq 'RT_Internal') {
1213 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1214 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1215 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1216 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1219 if ( $ticket_dbh ) {
1221 my $ticket_sth = $ticket_dbh->prepare(
1222 'DELETE FROM Links WHERE Target = ?'
1224 my $errstr = $ticket_dbh->errstr;
1225 $dbh->rollback if $oldAutoCommit;
1228 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1230 my $errstr = $ticket_sth->errstr;
1231 $dbh->rollback if $oldAutoCommit;
1235 #check and see if the customer is the only link on the ticket, and
1236 #if so, set the ticket to deleted status in RT?
1237 #maybe someday, for now this will at least fix tickets not displaying
1241 #delete the customer record
1243 my $error = $self->SUPER::delete;
1245 $dbh->rollback if $oldAutoCommit;
1249 # cust_main exports!
1251 #my $export_args = $options{'export_args'} || [];
1254 map qsearch( 'part_export', {exportnum=>$_} ),
1255 $conf->config('cust_main-exports'); #, $agentnum
1257 foreach my $part_export ( @part_export ) {
1258 my $error = $part_export->export_delete( $self ); #, @$export_args);
1260 $dbh->rollback if $oldAutoCommit;
1261 return "exporting to ". $part_export->exporttype.
1262 " (transaction rolled back): $error";
1266 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1271 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1273 Replaces the OLD_RECORD with this one in the database. If there is an error,
1274 returns the error, otherwise returns false.
1276 To change the customer's address, set the pseudo-fields C<bill_location> and
1277 C<ship_location>. The address will still only change if at least one of the
1278 address fields differs from the existing values.
1280 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1281 set as the contact email address for a default contact with the same name as
1284 Currently available options are: I<tax_exemption>, I<cust_payby_params>,
1285 I<contact_params>, I<invoicing_list>.
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.
1291 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1292 groups (describing the customer's payment methods and contacts, respectively)
1293 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1294 and L<FS::contact> for the fields these can contain.
1296 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1297 should be used instead if possible.
1304 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1306 : $self->replace_old;
1310 warn "$me replace called\n"
1313 my $curuser = $FS::CurrentUser::CurrentUser;
1314 return "You are not permitted to create complimentary accounts."
1315 if $self->complimentary eq 'Y'
1316 && $self->complimentary ne $old->complimentary
1317 && ! $curuser->access_right('Complimentary customer');
1319 local($ignore_expired_card) = 1
1320 if $old->payby =~ /^(CARD|DCRD)$/
1321 && $self->payby =~ /^(CARD|DCRD)$/
1322 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1324 local($ignore_banned_card) = 1
1325 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1326 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1327 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1329 return "Invoicing locale is required"
1332 && $conf->exists('cust_main-require_locale');
1334 local $SIG{HUP} = 'IGNORE';
1335 local $SIG{INT} = 'IGNORE';
1336 local $SIG{QUIT} = 'IGNORE';
1337 local $SIG{TERM} = 'IGNORE';
1338 local $SIG{TSTP} = 'IGNORE';
1339 local $SIG{PIPE} = 'IGNORE';
1341 my $oldAutoCommit = $FS::UID::AutoCommit;
1342 local $FS::UID::AutoCommit = 0;
1345 for my $l (qw(bill_location ship_location)) {
1346 #my $old_loc = $old->$l;
1347 my $new_loc = $self->$l or next;
1349 # find the existing location if there is one
1350 $new_loc->set('custnum' => $self->custnum);
1351 my $error = $new_loc->find_or_insert;
1353 $dbh->rollback if $oldAutoCommit;
1356 $self->set($l.'num', $new_loc->locationnum);
1360 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1361 warn "cust_main::replace: using deprecated invoicing list argument";
1362 $invoicing_list = shift @param;
1365 my %options = @param;
1367 $invoicing_list ||= $options{invoicing_list};
1369 if ( $invoicing_list ) {
1371 foreach (@$invoicing_list) {
1373 $self->set('postal_invoice', 'Y');
1375 $email .= ',' if length($email);
1379 my @contacts = map { $_->contact } $self->cust_contact;
1380 # if possible, use a contact that matches the customer's name
1381 my ($contact) = grep { $_->first eq $old->get('first') and
1382 $_->last eq $old->get('last') }
1384 $contact ||= FS::contact->new({
1385 'custnum' => $self->custnum,
1386 'locationnum' => $self->get('bill_locationnum'),
1388 $contact->set('last', $self->get('last'));
1389 $contact->set('first', $self->get('first'));
1390 $contact->set('emailaddress', $email);
1391 $contact->set('invoice_dest', 'Y');
1394 if ( $contact->contactnum ) {
1395 $error = $contact->replace;
1396 } elsif ( length($email) ) { # don't create a new contact if email is empty
1397 $error = $contact->insert;
1401 $dbh->rollback if $oldAutoCommit;
1407 # replace the customer record
1408 my $error = $self->SUPER::replace($old);
1411 $dbh->rollback if $oldAutoCommit;
1415 # now move packages to the new service location
1416 $self->set('ship_location', ''); #flush cache
1417 if ( $old->ship_locationnum and # should only be null during upgrade...
1418 $old->ship_locationnum != $self->ship_locationnum ) {
1419 $error = $old->ship_location->move_to($self->ship_location);
1421 $dbh->rollback if $oldAutoCommit;
1425 # don't move packages based on the billing location, but
1426 # disable it if it's no longer in use
1427 if ( $old->bill_locationnum and
1428 $old->bill_locationnum != $self->bill_locationnum ) {
1429 $error = $old->bill_location->disable_if_unused;
1431 $dbh->rollback if $oldAutoCommit;
1436 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1438 #this could be more efficient than deleting and re-inserting, if it matters
1439 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1440 my $error = $cust_tag->delete;
1442 $dbh->rollback if $oldAutoCommit;
1446 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1447 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1448 'custnum' => $self->custnum };
1449 my $error = $cust_tag->insert;
1451 $dbh->rollback if $oldAutoCommit;
1458 my $tax_exemption = delete $options{'tax_exemption'};
1459 if ( $tax_exemption ) {
1461 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1462 if ref($tax_exemption) eq 'ARRAY';
1464 my %cust_main_exemption =
1465 map { $_->taxname => $_ }
1466 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1468 foreach my $taxname ( keys %$tax_exemption ) {
1470 if ( $cust_main_exemption{$taxname} &&
1471 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1474 delete $cust_main_exemption{$taxname};
1478 my $cust_main_exemption = new FS::cust_main_exemption {
1479 'custnum' => $self->custnum,
1480 'taxname' => $taxname,
1481 'exempt_number' => $tax_exemption->{$taxname},
1483 my $error = $cust_main_exemption->insert;
1485 $dbh->rollback if $oldAutoCommit;
1486 return "inserting cust_main_exemption (transaction rolled back): $error";
1490 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1491 my $error = $cust_main_exemption->delete;
1493 $dbh->rollback if $oldAutoCommit;
1494 return "deleting cust_main_exemption (transaction rolled back): $error";
1500 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1502 my $error = $self->process_o2m(
1503 'table' => 'cust_payby',
1504 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1505 'params' => $cust_payby_params,
1506 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1509 $dbh->rollback if $oldAutoCommit;
1515 if ( my $contact_params = delete $options{'contact_params'} ) {
1517 # this can potentially replace contacts that were created by the
1518 # invoicing list argument, but the UI shouldn't allow both of them
1521 my $error = $self->process_o2m(
1522 'table' => 'contact',
1523 'fields' => FS::contact->cgi_contact_fields,
1524 'params' => $contact_params,
1527 $dbh->rollback if $oldAutoCommit;
1533 unless ( $import || $skip_fuzzyfiles ) {
1534 $error = $self->queue_fuzzyfiles_update;
1536 $dbh->rollback if $oldAutoCommit;
1537 return "updating fuzzy search cache: $error";
1541 # tax district update in cust_location
1543 # cust_main exports!
1545 my $export_args = $options{'export_args'} || [];
1548 map qsearch( 'part_export', {exportnum=>$_} ),
1549 $conf->config('cust_main-exports'); #, $agentnum
1551 foreach my $part_export ( @part_export ) {
1552 my $error = $part_export->export_replace( $self, $old, @$export_args);
1554 $dbh->rollback if $oldAutoCommit;
1555 return "exporting to ". $part_export->exporttype.
1556 " (transaction rolled back): $error";
1560 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1565 =item queue_fuzzyfiles_update
1567 Used by insert & replace to update the fuzzy search cache
1571 use FS::cust_main::Search;
1572 sub queue_fuzzyfiles_update {
1575 local $SIG{HUP} = 'IGNORE';
1576 local $SIG{INT} = 'IGNORE';
1577 local $SIG{QUIT} = 'IGNORE';
1578 local $SIG{TERM} = 'IGNORE';
1579 local $SIG{TSTP} = 'IGNORE';
1580 local $SIG{PIPE} = 'IGNORE';
1582 my $oldAutoCommit = $FS::UID::AutoCommit;
1583 local $FS::UID::AutoCommit = 0;
1586 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1587 my $queue = new FS::queue {
1588 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1590 my @args = "cust_main.$field", $self->get($field);
1591 my $error = $queue->insert( @args );
1593 $dbh->rollback if $oldAutoCommit;
1594 return "queueing job (transaction rolled back): $error";
1599 push @locations, $self->bill_location if $self->bill_locationnum;
1600 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1601 foreach my $location (@locations) {
1602 my $queue = new FS::queue {
1603 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1605 my @args = 'cust_location.address1', $location->address1;
1606 my $error = $queue->insert( @args );
1608 $dbh->rollback if $oldAutoCommit;
1609 return "queueing job (transaction rolled back): $error";
1613 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1620 Checks all fields to make sure this is a valid customer record. If there is
1621 an error, returns the error, otherwise returns false. Called by the insert
1622 and replace methods.
1629 warn "$me check BEFORE: \n". $self->_dump
1633 $self->ut_numbern('custnum')
1634 || $self->ut_number('agentnum')
1635 || $self->ut_textn('agent_custid')
1636 || $self->ut_number('refnum')
1637 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1638 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1639 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1640 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1641 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1642 || $self->ut_textn('custbatch')
1643 || $self->ut_name('last')
1644 || $self->ut_name('first')
1645 || $self->ut_snumbern('signupdate')
1646 || $self->ut_snumbern('birthdate')
1647 || $self->ut_namen('spouse_last')
1648 || $self->ut_namen('spouse_first')
1649 || $self->ut_snumbern('spouse_birthdate')
1650 || $self->ut_snumbern('anniversary_date')
1651 || $self->ut_textn('company')
1652 || $self->ut_textn('ship_company')
1653 || $self->ut_anything('comments')
1654 || $self->ut_numbern('referral_custnum')
1655 || $self->ut_textn('stateid')
1656 || $self->ut_textn('stateid_state')
1657 || $self->ut_textn('invoice_terms')
1658 || $self->ut_floatn('cdr_termination_percentage')
1659 || $self->ut_floatn('credit_limit')
1660 || $self->ut_numbern('billday')
1661 || $self->ut_numbern('prorate_day')
1662 || $self->ut_flag('edit_subject')
1663 || $self->ut_flag('calling_list_exempt')
1664 || $self->ut_flag('invoice_noemail')
1665 || $self->ut_flag('message_noemail')
1666 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1667 || $self->ut_currencyn('currency')
1668 || $self->ut_alphan('po_number')
1669 || $self->ut_enum('complimentary', [ '', 'Y' ])
1670 || $self->ut_flag('invoice_ship_address')
1671 || $self->ut_flag('invoice_dest')
1674 foreach (qw(company ship_company)) {
1675 my $company = $self->get($_);
1676 $company =~ s/^\s+//;
1677 $company =~ s/\s+$//;
1678 $company =~ s/\s+/ /g;
1679 $self->set($_, $company);
1682 #barf. need message catalogs. i18n. etc.
1683 $error .= "Please select an advertising source."
1684 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1685 return $error if $error;
1687 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1688 or return "Unknown agent";
1690 if ( $self->currency ) {
1691 my $agent_currency = qsearchs( 'agent_currency', {
1692 'agentnum' => $agent->agentnum,
1693 'currency' => $self->currency,
1695 or return "Agent ". $agent->agent.
1696 " not permitted to offer ". $self->currency. " invoicing";
1699 return "Unknown refnum"
1700 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1702 return "Unknown referring custnum: ". $self->referral_custnum
1703 unless ! $self->referral_custnum
1704 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1706 if ( $self->ss eq '' ) {
1711 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1712 or return "Illegal social security number: ". $self->ss;
1713 $self->ss("$1-$2-$3");
1716 #turn off invoice_ship_address if ship & bill are the same
1717 if ($self->bill_locationnum eq $self->ship_locationnum) {
1718 $self->invoice_ship_address('');
1721 # cust_main_county verification now handled by cust_location check
1724 $self->ut_phonen('daytime', $self->country)
1725 || $self->ut_phonen('night', $self->country)
1726 || $self->ut_phonen('fax', $self->country)
1727 || $self->ut_phonen('mobile', $self->country)
1729 return $error if $error;
1731 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1733 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1736 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1738 : FS::Msgcat::_gettext('daytime');
1739 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1741 : FS::Msgcat::_gettext('night');
1743 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1745 : FS::Msgcat::_gettext('mobile');
1747 return "$daytime_label, $night_label or $mobile_label is required"
1751 ### start of stuff moved to cust_payby
1752 # then mostly kept here to support upgrades (can remove in 5.x)
1753 # but modified to allow everything to be empty
1755 if ( $self->payby ) {
1756 FS::payby->can_payby($self->table, $self->payby)
1757 or return "Illegal payby: ". $self->payby;
1762 $error = $self->ut_numbern('paystart_month')
1763 || $self->ut_numbern('paystart_year')
1764 || $self->ut_numbern('payissue')
1765 || $self->ut_textn('paytype')
1767 return $error if $error;
1769 if ( $self->payip eq '' ) {
1772 $error = $self->ut_ip('payip');
1773 return $error if $error;
1776 # If it is encrypted and the private key is not availaible then we can't
1777 # check the credit card.
1778 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1780 # Need some kind of global flag to accept invalid cards, for testing
1782 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1783 $self->payby =~ /^(CARD|DCRD)$/ ) {
1785 my $payinfo = $self->payinfo;
1786 $payinfo =~ s/\D//g;
1787 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1788 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1790 $self->payinfo($payinfo);
1792 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1794 return gettext('unknown_card_type')
1795 if $self->payinfo !~ /^99\d{14}$/ #token
1796 && cardtype($self->payinfo) eq "Unknown";
1798 unless ( $ignore_banned_card ) {
1799 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1801 if ( $ban->bantype eq 'warn' ) {
1802 #or others depending on value of $ban->reason ?
1803 return '_duplicate_card'.
1804 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1805 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1806 ' (ban# '. $ban->bannum. ')'
1807 unless $self->override_ban_warn;
1809 return 'Banned credit card: banned on '.
1810 time2str('%a %h %o at %r', $ban->_date).
1811 ' by '. $ban->otaker.
1812 ' (ban# '. $ban->bannum. ')';
1817 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1818 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1819 $self->paycvv =~ /^(\d{4})$/
1820 or return "CVV2 (CID) for American Express cards is four digits.";
1823 $self->paycvv =~ /^(\d{3})$/
1824 or return "CVV2 (CVC2/CID) is three digits.";
1831 my $cardtype = cardtype($payinfo);
1832 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1834 return "Start date or issue number is required for $cardtype cards"
1835 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1837 return "Start month must be between 1 and 12"
1838 if $self->paystart_month
1839 and $self->paystart_month < 1 || $self->paystart_month > 12;
1841 return "Start year must be 1990 or later"
1842 if $self->paystart_year
1843 and $self->paystart_year < 1990;
1845 return "Issue number must be beween 1 and 99"
1847 and $self->payissue < 1 || $self->payissue > 99;
1850 $self->paystart_month('');
1851 $self->paystart_year('');
1852 $self->payissue('');
1855 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1856 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1858 my $payinfo = $self->payinfo;
1859 $payinfo =~ s/[^\d\@\.]//g;
1860 if ( $conf->config('echeck-country') eq 'CA' ) {
1861 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1862 or return 'invalid echeck account@branch.bank';
1863 $payinfo = "$1\@$2.$3";
1864 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1865 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1866 $payinfo = "$1\@$2";
1868 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1869 $payinfo = "$1\@$2";
1871 $self->payinfo($payinfo);
1874 unless ( $ignore_banned_card ) {
1875 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1877 if ( $ban->bantype eq 'warn' ) {
1878 #or others depending on value of $ban->reason ?
1879 return '_duplicate_ach' unless $self->override_ban_warn;
1881 return 'Banned ACH account: banned on '.
1882 time2str('%a %h %o at %r', $ban->_date).
1883 ' by '. $ban->otaker.
1884 ' (ban# '. $ban->bannum. ')';
1889 } elsif ( $self->payby eq 'LECB' ) {
1891 my $payinfo = $self->payinfo;
1892 $payinfo =~ s/\D//g;
1893 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1895 $self->payinfo($payinfo);
1898 } elsif ( $self->payby eq 'BILL' ) {
1900 $error = $self->ut_textn('payinfo');
1901 return "Illegal P.O. number: ". $self->payinfo if $error;
1904 } elsif ( $self->payby eq 'COMP' ) {
1906 my $curuser = $FS::CurrentUser::CurrentUser;
1907 if ( ! $self->custnum
1908 && ! $curuser->access_right('Complimentary customer')
1911 return "You are not permitted to create complimentary accounts."
1914 $error = $self->ut_textn('payinfo');
1915 return "Illegal comp account issuer: ". $self->payinfo if $error;
1918 } elsif ( $self->payby eq 'PREPAY' ) {
1920 my $payinfo = $self->payinfo;
1921 $payinfo =~ s/\W//g; #anything else would just confuse things
1922 $self->payinfo($payinfo);
1923 $error = $self->ut_alpha('payinfo');
1924 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1925 return "Unknown prepayment identifier"
1926 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1931 return "You are not permitted to create complimentary accounts."
1933 && $self->complimentary eq 'Y'
1934 && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer');
1936 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1937 return "Expiration date required"
1938 # shouldn't payinfo_check do this?
1939 unless ! $self->payby
1940 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1944 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1945 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1946 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1947 ( $m, $y ) = ( $2, "19$1" );
1948 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1949 ( $m, $y ) = ( $3, "20$2" );
1951 return "Illegal expiration date: ". $self->paydate;
1953 $m = sprintf('%02d',$m);
1954 $self->paydate("$y-$m-01");
1955 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1956 return gettext('expired_card')
1958 && !$ignore_expired_card
1959 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1962 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1963 ( ! $conf->exists('require_cardname')
1964 || $self->payby !~ /^(CARD|DCRD)$/ )
1966 $self->payname( $self->first. " ". $self->getfield('last') );
1969 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
1970 $self->payname =~ /^([\w \,\.\-\']*)$/
1971 or return gettext('illegal_name'). " payname: ". $self->payname;
1974 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
1975 or return gettext('illegal_name'). " payname: ". $self->payname;
1981 ### end of stuff moved to cust_payby
1983 return "Please select an invoicing locale"
1986 && $conf->exists('cust_main-require_locale');
1988 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1989 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1993 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1995 warn "$me check AFTER: \n". $self->_dump
1998 $self->SUPER::check;
2003 Additional checks for replace only.
2008 my ($new,$old) = @_;
2009 #preserve old value if global config is set
2010 if ($old && $conf->exists('invoice-ship_address')) {
2011 $new->invoice_ship_address($old->invoice_ship_address);
2018 Returns a list of fields which have ship_ duplicates.
2023 qw( last first company
2025 address1 address2 city county state zip country
2027 daytime night fax mobile
2031 =item has_ship_address
2033 Returns true if this customer record has a separate shipping address.
2037 sub has_ship_address {
2039 $self->bill_locationnum != $self->ship_locationnum;
2044 Returns a list of key/value pairs, with the following keys: address1,
2045 adddress2, city, county, state, zip, country, district, and geocode. The
2046 shipping address is used if present.
2052 $self->ship_location->location_hash;
2057 Returns all locations (see L<FS::cust_location>) for this customer.
2063 qsearch('cust_location', { 'custnum' => $self->custnum,
2064 'prospectnum' => '' } );
2069 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2075 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2080 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2087 'table' => 'cust_payby',
2088 'hashref' => { 'custnum' => $self->custnum },
2089 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2093 sub has_cust_payby_auto {
2096 'table' => 'cust_payby',
2097 'hashref' => { 'custnum' => $self->custnum, },
2098 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2099 'order_by' => 'LIMIT 1',
2106 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2107 and L<FS::cust_pkg>) for this customer, except those on hold.
2109 Returns a list: an empty list on success or a list of errors.
2115 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2120 Unsuspends all suspended packages in the on-hold state (those without setup
2121 dates) for this customer.
2127 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2132 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2134 Returns a list: an empty list on success or a list of errors.
2140 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2143 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2145 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2146 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2147 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)
2158 Returns a list: an empty list on success or a list of errors.
2162 sub suspend_if_pkgpart {
2164 my (@pkgparts, %opt);
2165 if (ref($_[0]) eq 'HASH'){
2166 @pkgparts = @{$_[0]{pkgparts}};
2171 grep { $_->suspend(%opt) }
2172 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2173 $self->unsuspended_pkgs;
2176 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2178 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2179 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2180 instead of a list of pkgparts; the hashref has the following keys:
2184 =item pkgparts - listref of pkgparts
2186 =item (other options are passed to the suspend method)
2190 Returns a list: an empty list on success or a list of errors.
2194 sub suspend_unless_pkgpart {
2196 my (@pkgparts, %opt);
2197 if (ref($_[0]) eq 'HASH'){
2198 @pkgparts = @{$_[0]{pkgparts}};
2203 grep { $_->suspend(%opt) }
2204 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2205 $self->unsuspended_pkgs;
2208 =item cancel [ OPTION => VALUE ... ]
2210 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2212 Available options are:
2216 =item quiet - can be set true to supress email cancellation notices.
2218 =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.
2220 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2222 =item nobill - can be set true to skip billing if it might otherwise be done.
2226 Always returns a list: an empty list on success or a list of errors.
2230 # nb that dates are not specified as valid options to this method
2233 my( $self, %opt ) = @_;
2235 warn "$me cancel called on customer ". $self->custnum. " with options ".
2236 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2239 return ( 'access denied' )
2240 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2242 if ( $opt{'ban'} ) {
2244 foreach my $cust_payby ( $self->cust_payby ) {
2246 #well, if they didn't get decrypted on search, then we don't have to
2247 # try again... queue a job for the server that does have decryption
2248 # capability if we're in a paranoid multi-server implementation?
2249 return ( "Can't (yet) ban encrypted credit cards" )
2250 if $cust_payby->is_encrypted($cust_payby->payinfo);
2252 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2253 my $error = $ban->insert;
2254 return ( $error ) if $error;
2260 my @pkgs = $self->ncancelled_pkgs;
2262 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2264 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2265 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2269 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2270 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2273 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2276 sub _banned_pay_hashref {
2287 'payby' => $payby2ban{$self->payby},
2288 'payinfo' => $self->payinfo,
2289 #don't ever *search* on reason! #'reason' =>
2295 Returns all notes (see L<FS::cust_main_note>) for this customer.
2300 my($self,$orderby_classnum) = (shift,shift);
2301 my $orderby = "sticky DESC, _date DESC";
2302 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2303 qsearch( 'cust_main_note',
2304 { 'custnum' => $self->custnum },
2306 "ORDER BY $orderby",
2312 Returns the agent (see L<FS::agent>) for this customer.
2316 Returns the agent name (see L<FS::agent>) for this customer.
2322 $self->agent->agent;
2327 Returns any tags associated with this customer, as FS::cust_tag objects,
2328 or an empty list if there are no tags.
2332 Returns any tags associated with this customer, as FS::part_tag objects,
2333 or an empty list if there are no tags.
2339 map $_->part_tag, $self->cust_tag;
2345 Returns the customer class, as an FS::cust_class object, or the empty string
2346 if there is no customer class.
2350 Returns the customer category name, or the empty string if there is no customer
2357 my $cust_class = $self->cust_class;
2359 ? $cust_class->categoryname
2365 Returns the customer class name, or the empty string if there is no customer
2372 my $cust_class = $self->cust_class;
2374 ? $cust_class->classname
2380 Returns the external tax status, as an FS::tax_status object, or the empty
2381 string if there is no tax status.
2387 if ( $self->taxstatusnum ) {
2388 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2396 Returns the tax status code if there is one.
2402 my $tax_status = $self->tax_status;
2404 ? $tax_status->taxstatus
2408 =item BILLING METHODS
2410 Documentation on billing methods has been moved to
2411 L<FS::cust_main::Billing>.
2413 =item REALTIME BILLING METHODS
2415 Documentation on realtime billing methods has been moved to
2416 L<FS::cust_main::Billing_Realtime>.
2420 Removes the I<paycvv> field from the database directly.
2422 If there is an error, returns the error, otherwise returns false.
2428 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2429 or return dbh->errstr;
2430 $sth->execute($self->custnum)
2431 or return $sth->errstr;
2438 Returns the total owed for this customer on all invoices
2439 (see L<FS::cust_bill/owed>).
2445 $self->total_owed_date(2145859200); #12/31/2037
2448 =item total_owed_date TIME
2450 Returns the total owed for this customer on all invoices with date earlier than
2451 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2452 see L<Time::Local> and L<Date::Parse> for conversion functions.
2456 sub total_owed_date {
2460 my $custnum = $self->custnum;
2462 my $owed_sql = FS::cust_bill->owed_sql;
2465 SELECT SUM($owed_sql) FROM cust_bill
2466 WHERE custnum = $custnum
2470 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2474 =item total_owed_pkgnum PKGNUM
2476 Returns the total owed on all invoices for this customer's specific package
2477 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2481 sub total_owed_pkgnum {
2482 my( $self, $pkgnum ) = @_;
2483 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2486 =item total_owed_date_pkgnum TIME PKGNUM
2488 Returns the total owed for this customer's specific package when using
2489 experimental package balances on all invoices with date earlier than
2490 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2491 see L<Time::Local> and L<Date::Parse> for conversion functions.
2495 sub total_owed_date_pkgnum {
2496 my( $self, $time, $pkgnum ) = @_;
2499 foreach my $cust_bill (
2500 grep { $_->_date <= $time }
2501 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2503 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2505 sprintf( "%.2f", $total_bill );
2511 Returns the total amount of all payments.
2518 $total += $_->paid foreach $self->cust_pay;
2519 sprintf( "%.2f", $total );
2522 =item total_unapplied_credits
2524 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2525 customer. See L<FS::cust_credit/credited>.
2527 =item total_credited
2529 Old name for total_unapplied_credits. Don't use.
2533 sub total_credited {
2534 #carp "total_credited deprecated, use total_unapplied_credits";
2535 shift->total_unapplied_credits(@_);
2538 sub total_unapplied_credits {
2541 my $custnum = $self->custnum;
2543 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2546 SELECT SUM($unapplied_sql) FROM cust_credit
2547 WHERE custnum = $custnum
2550 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2554 =item total_unapplied_credits_pkgnum PKGNUM
2556 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2557 customer. See L<FS::cust_credit/credited>.
2561 sub total_unapplied_credits_pkgnum {
2562 my( $self, $pkgnum ) = @_;
2563 my $total_credit = 0;
2564 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2565 sprintf( "%.2f", $total_credit );
2569 =item total_unapplied_payments
2571 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2572 See L<FS::cust_pay/unapplied>.
2576 sub total_unapplied_payments {
2579 my $custnum = $self->custnum;
2581 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2584 SELECT SUM($unapplied_sql) FROM cust_pay
2585 WHERE custnum = $custnum
2588 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2592 =item total_unapplied_payments_pkgnum PKGNUM
2594 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2595 specific package when using experimental package balances. See
2596 L<FS::cust_pay/unapplied>.
2600 sub total_unapplied_payments_pkgnum {
2601 my( $self, $pkgnum ) = @_;
2602 my $total_unapplied = 0;
2603 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2604 sprintf( "%.2f", $total_unapplied );
2608 =item total_unapplied_refunds
2610 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2611 customer. See L<FS::cust_refund/unapplied>.
2615 sub total_unapplied_refunds {
2617 my $custnum = $self->custnum;
2619 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2622 SELECT SUM($unapplied_sql) FROM cust_refund
2623 WHERE custnum = $custnum
2626 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2632 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2633 total_unapplied_credits minus total_unapplied_payments).
2639 $self->balance_date_range;
2642 =item balance_date TIME
2644 Returns the balance for this customer, only considering invoices with date
2645 earlier than TIME (total_owed_date minus total_credited minus
2646 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2647 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2654 $self->balance_date_range(shift);
2657 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2659 Returns the balance for this customer, optionally considering invoices with
2660 date earlier than START_TIME, and not later than END_TIME
2661 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2663 Times are specified as SQL fragments or numeric
2664 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2665 L<Date::Parse> for conversion functions. The empty string can be passed
2666 to disable that time constraint completely.
2668 Accepts the same options as L<balance_date_sql>:
2672 =item unapplied_date
2674 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)
2678 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2679 time will be ignored. Note that START_TIME and END_TIME only limit the date
2680 range for invoices and I<unapplied> payments, credits, and refunds.
2686 sub balance_date_range {
2688 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2689 ') FROM cust_main WHERE custnum='. $self->custnum;
2690 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2693 =item balance_pkgnum PKGNUM
2695 Returns the balance for this customer's specific package when using
2696 experimental package balances (total_owed plus total_unrefunded, minus
2697 total_unapplied_credits minus total_unapplied_payments)
2701 sub balance_pkgnum {
2702 my( $self, $pkgnum ) = @_;
2705 $self->total_owed_pkgnum($pkgnum)
2706 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2707 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2708 - $self->total_unapplied_credits_pkgnum($pkgnum)
2709 - $self->total_unapplied_payments_pkgnum($pkgnum)
2715 Returns a hash of useful information for making a payment.
2725 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2726 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2727 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2731 For credit card transactions:
2743 For electronic check transactions:
2758 $return{balance} = $self->balance;
2760 $return{payname} = $self->payname
2761 || ( $self->first. ' '. $self->get('last') );
2763 $return{$_} = $self->bill_location->$_
2764 for qw(address1 address2 city state zip);
2766 $return{payby} = $self->payby;
2767 $return{stateid_state} = $self->stateid_state;
2769 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2770 $return{card_type} = cardtype($self->payinfo);
2771 $return{payinfo} = $self->paymask;
2773 @return{'month', 'year'} = $self->paydate_monthyear;
2777 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2778 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2779 $return{payinfo1} = $payinfo1;
2780 $return{payinfo2} = $payinfo2;
2781 $return{paytype} = $self->paytype;
2782 $return{paystate} = $self->paystate;
2786 #doubleclick protection
2788 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2794 =item paydate_monthyear
2796 Returns a two-element list consisting of the month and year of this customer's
2797 paydate (credit card expiration date for CARD customers)
2801 sub paydate_monthyear {
2803 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2805 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2814 Returns the exact time in seconds corresponding to the payment method
2815 expiration date. For CARD/DCRD customers this is the end of the month;
2816 for others (COMP is the only other payby that uses paydate) it's the start.
2817 Returns 0 if the paydate is empty or set to the far future.
2823 my ($month, $year) = $self->paydate_monthyear;
2824 return 0 if !$year or $year >= 2037;
2825 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2827 if ( $month == 13 ) {
2831 return timelocal(0,0,0,1,$month-1,$year) - 1;
2834 return timelocal(0,0,0,1,$month-1,$year);
2838 =item paydate_epoch_sql
2840 Class method. Returns an SQL expression to obtain the payment expiration date
2841 as a number of seconds.
2845 # Special expiration date behavior for non-CARD/DCRD customers has been
2846 # carefully preserved. Do we really use that?
2847 sub paydate_epoch_sql {
2849 my $table = shift || 'cust_main';
2850 my ($case1, $case2);
2851 if ( driver_name eq 'Pg' ) {
2852 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2853 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2855 elsif ( lc(driver_name) eq 'mysql' ) {
2856 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2857 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2860 return "CASE WHEN $table.payby IN('CARD','DCRD')
2866 =item tax_exemption TAXNAME
2871 my( $self, $taxname ) = @_;
2873 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2874 'taxname' => $taxname,
2879 =item cust_main_exemption
2881 =item invoicing_list
2883 Returns a list of email addresses (with svcnum entries expanded), and the word
2884 'POST' if the customer receives postal invoices.
2888 sub invoicing_list {
2889 my( $self, $arrayref ) = @_;
2892 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2895 my @emails = $self->invoicing_list_emailonly;
2896 push @emails, 'POST' if $self->get('postal_invoice');
2901 =item check_invoicing_list ARRAYREF
2903 Checks these arguements as valid input for the invoicing_list method. If there
2904 is an error, returns the error, otherwise returns false.
2908 sub check_invoicing_list {
2909 my( $self, $arrayref ) = @_;
2911 foreach my $address ( @$arrayref ) {
2913 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2914 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2917 my $cust_main_invoice = new FS::cust_main_invoice ( {
2918 'custnum' => $self->custnum,
2921 my $error = $self->custnum
2922 ? $cust_main_invoice->check
2923 : $cust_main_invoice->checkdest
2925 return $error if $error;
2929 return "Email address required"
2930 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2931 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2938 Returns the email addresses of all accounts provisioned for this customer.
2945 foreach my $cust_pkg ( $self->all_pkgs ) {
2946 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2948 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2949 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2951 $list{$_}=1 foreach map { $_->email } @svc_acct;
2956 =item invoicing_list_addpost
2958 Adds postal invoicing to this customer. If this customer is already configured
2959 to receive postal invoices, does nothing.
2963 sub invoicing_list_addpost {
2965 if ( $self->get('postal_invoice') eq '' ) {
2966 $self->set('postal_invoice', 'Y');
2967 my $error = $self->replace;
2968 warn $error if $error; # should fail harder, but this is traditional
2972 =item invoicing_list_emailonly
2974 Returns the list of email invoice recipients (invoicing_list without non-email
2975 destinations such as POST and FAX).
2979 sub invoicing_list_emailonly {
2981 warn "$me invoicing_list_emailonly called"
2983 return () if !$self->custnum; # not yet inserted
2984 return map { $_->emailaddress }
2986 table => 'cust_contact',
2987 select => 'emailaddress',
2988 addl_from => ' JOIN contact USING (contactnum) '.
2989 ' JOIN contact_email USING (contactnum)',
2990 hashref => { 'custnum' => $self->custnum, },
2991 extra_sql => q( AND invoice_dest = 'Y'),
2995 =item invoicing_list_emailonly_scalar
2997 Returns the list of email invoice recipients (invoicing_list without non-email
2998 destinations such as POST and FAX) as a comma-separated scalar.
3002 sub invoicing_list_emailonly_scalar {
3004 warn "$me invoicing_list_emailonly_scalar called"
3006 join(', ', $self->invoicing_list_emailonly);
3009 =item referral_custnum_cust_main
3011 Returns the customer who referred this customer (or the empty string, if
3012 this customer was not referred).
3014 Note the difference with referral_cust_main method: This method,
3015 referral_custnum_cust_main returns the single customer (if any) who referred
3016 this customer, while referral_cust_main returns an array of customers referred
3021 sub referral_custnum_cust_main {
3023 return '' unless $self->referral_custnum;
3024 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3027 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3029 Returns an array of customers referred by this customer (referral_custnum set
3030 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3031 customers referred by customers referred by this customer and so on, inclusive.
3032 The default behavior is DEPTH 1 (no recursion).
3034 Note the difference with referral_custnum_cust_main method: This method,
3035 referral_cust_main, returns an array of customers referred BY this customer,
3036 while referral_custnum_cust_main returns the single customer (if any) who
3037 referred this customer.
3041 sub referral_cust_main {
3043 my $depth = @_ ? shift : 1;
3044 my $exclude = @_ ? shift : {};
3047 map { $exclude->{$_->custnum}++; $_; }
3048 grep { ! $exclude->{ $_->custnum } }
3049 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3053 map { $_->referral_cust_main($depth-1, $exclude) }
3060 =item referral_cust_main_ncancelled
3062 Same as referral_cust_main, except only returns customers with uncancelled
3067 sub referral_cust_main_ncancelled {
3069 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3072 =item referral_cust_pkg [ DEPTH ]
3074 Like referral_cust_main, except returns a flat list of all unsuspended (and
3075 uncancelled) packages for each customer. The number of items in this list may
3076 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3080 sub referral_cust_pkg {
3082 my $depth = @_ ? shift : 1;
3084 map { $_->unsuspended_pkgs }
3085 grep { $_->unsuspended_pkgs }
3086 $self->referral_cust_main($depth);
3089 =item referring_cust_main
3091 Returns the single cust_main record for the customer who referred this customer
3092 (referral_custnum), or false.
3096 sub referring_cust_main {
3098 return '' unless $self->referral_custnum;
3099 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3102 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3104 Applies a credit to this customer. If there is an error, returns the error,
3105 otherwise returns false.
3107 REASON can be a text string, an FS::reason object, or a scalar reference to
3108 a reasonnum. If a text string, it will be automatically inserted as a new
3109 reason, and a 'reason_type' option must be passed to indicate the
3110 FS::reason_type for the new reason.
3112 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3113 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3114 I<commission_pkgnum>.
3116 Any other options are passed to FS::cust_credit::insert.
3121 my( $self, $amount, $reason, %options ) = @_;
3123 my $cust_credit = new FS::cust_credit {
3124 'custnum' => $self->custnum,
3125 'amount' => $amount,
3128 if ( ref($reason) ) {
3130 if ( ref($reason) eq 'SCALAR' ) {
3131 $cust_credit->reasonnum( $$reason );
3133 $cust_credit->reasonnum( $reason->reasonnum );
3137 $cust_credit->set('reason', $reason)
3140 $cust_credit->$_( delete $options{$_} )
3141 foreach grep exists($options{$_}),
3142 qw( addlinfo eventnum ),
3143 map "commission_$_", qw( agentnum salesnum pkgnum );
3145 $cust_credit->insert(%options);
3149 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3151 Creates a one-time charge for this customer. If there is an error, returns
3152 the error, otherwise returns false.
3154 New-style, with a hashref of options:
3156 my $error = $cust_main->charge(
3160 'start_date' => str2time('7/4/2009'),
3161 'pkg' => 'Description',
3162 'comment' => 'Comment',
3163 'additional' => [], #extra invoice detail
3164 'classnum' => 1, #pkg_class
3166 'setuptax' => '', # or 'Y' for tax exempt
3168 'locationnum'=> 1234, # optional
3171 'taxclass' => 'Tax class',
3174 'taxproduct' => 2, #part_pkg_taxproduct
3175 'override' => {}, #XXX describe
3177 #will be filled in with the new object
3178 'cust_pkg_ref' => \$cust_pkg,
3180 #generate an invoice immediately
3182 'invoice_terms' => '', #with these terms
3188 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3192 #super false laziness w/quotation::charge
3195 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3196 my ( $pkg, $comment, $additional );
3197 my ( $setuptax, $taxclass ); #internal taxes
3198 my ( $taxproduct, $override ); #vendor (CCH) taxes
3200 my $separate_bill = '';
3201 my $cust_pkg_ref = '';
3202 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3204 if ( ref( $_[0] ) ) {
3205 $amount = $_[0]->{amount};
3206 $setup_cost = $_[0]->{setup_cost};
3207 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3208 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3209 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3210 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3211 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3212 : '$'. sprintf("%.2f",$amount);
3213 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3214 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3215 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3216 $additional = $_[0]->{additional} || [];
3217 $taxproduct = $_[0]->{taxproductnum};
3218 $override = { '' => $_[0]->{tax_override} };
3219 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3220 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3221 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3222 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3223 $separate_bill = $_[0]->{separate_bill} || '';
3229 $pkg = @_ ? shift : 'One-time charge';
3230 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3232 $taxclass = @_ ? shift : '';
3236 local $SIG{HUP} = 'IGNORE';
3237 local $SIG{INT} = 'IGNORE';
3238 local $SIG{QUIT} = 'IGNORE';
3239 local $SIG{TERM} = 'IGNORE';
3240 local $SIG{TSTP} = 'IGNORE';
3241 local $SIG{PIPE} = 'IGNORE';
3243 my $oldAutoCommit = $FS::UID::AutoCommit;
3244 local $FS::UID::AutoCommit = 0;
3247 my $part_pkg = new FS::part_pkg ( {
3249 'comment' => $comment,
3253 'classnum' => ( $classnum ? $classnum : '' ),
3254 'setuptax' => $setuptax,
3255 'taxclass' => $taxclass,
3256 'taxproductnum' => $taxproduct,
3257 'setup_cost' => $setup_cost,
3260 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3261 ( 0 .. @$additional - 1 )
3263 'additional_count' => scalar(@$additional),
3264 'setup_fee' => $amount,
3267 my $error = $part_pkg->insert( options => \%options,
3268 tax_overrides => $override,
3271 $dbh->rollback if $oldAutoCommit;
3275 my $pkgpart = $part_pkg->pkgpart;
3276 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3277 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3278 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3279 $error = $type_pkgs->insert;
3281 $dbh->rollback if $oldAutoCommit;
3286 my $cust_pkg = new FS::cust_pkg ( {
3287 'custnum' => $self->custnum,
3288 'pkgpart' => $pkgpart,
3289 'quantity' => $quantity,
3290 'start_date' => $start_date,
3291 'no_auto' => $no_auto,
3292 'separate_bill' => $separate_bill,
3293 'locationnum'=> $locationnum,
3296 $error = $cust_pkg->insert;
3298 $dbh->rollback if $oldAutoCommit;
3300 } elsif ( $cust_pkg_ref ) {
3301 ${$cust_pkg_ref} = $cust_pkg;
3305 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3306 'pkg_list' => [ $cust_pkg ],
3309 $dbh->rollback if $oldAutoCommit;
3314 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3319 #=item charge_postal_fee
3321 #Applies a one time charge this customer. If there is an error,
3322 #returns the error, returns the cust_pkg charge object or false
3323 #if there was no charge.
3327 # This should be a customer event. For that to work requires that bill
3328 # also be a customer event.
3330 sub charge_postal_fee {
3333 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3334 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3336 my $cust_pkg = new FS::cust_pkg ( {
3337 'custnum' => $self->custnum,
3338 'pkgpart' => $pkgpart,
3342 my $error = $cust_pkg->insert;
3343 $error ? $error : $cust_pkg;
3346 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3348 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3350 Optionally, a list or hashref of additional arguments to the qsearch call can
3357 my $opt = ref($_[0]) ? shift : { @_ };
3359 #return $self->num_cust_bill unless wantarray || keys %$opt;
3361 $opt->{'table'} = 'cust_bill';
3362 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3363 $opt->{'hashref'}{'custnum'} = $self->custnum;
3364 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3366 map { $_ } #behavior of sort undefined in scalar context
3367 sort { $a->_date <=> $b->_date }
3371 =item open_cust_bill
3373 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3378 sub open_cust_bill {
3382 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3388 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3390 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3394 sub legacy_cust_bill {
3397 #return $self->num_legacy_cust_bill unless wantarray;
3399 map { $_ } #behavior of sort undefined in scalar context
3400 sort { $a->_date <=> $b->_date }
3401 qsearch({ 'table' => 'legacy_cust_bill',
3402 'hashref' => { 'custnum' => $self->custnum, },
3403 'order_by' => 'ORDER BY _date ASC',
3407 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3409 Returns all the statements (see L<FS::cust_statement>) for this customer.
3411 Optionally, a list or hashref of additional arguments to the qsearch call can
3416 =item cust_bill_void
3418 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3422 sub cust_bill_void {
3425 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3426 sort { $a->_date <=> $b->_date }
3427 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3430 sub cust_statement {
3432 my $opt = ref($_[0]) ? shift : { @_ };
3434 #return $self->num_cust_statement unless wantarray || keys %$opt;
3436 $opt->{'table'} = 'cust_statement';
3437 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3438 $opt->{'hashref'}{'custnum'} = $self->custnum;
3439 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3441 map { $_ } #behavior of sort undefined in scalar context
3442 sort { $a->_date <=> $b->_date }
3446 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3448 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3450 Optionally, a list or hashref of additional arguments to the qsearch call can
3451 be passed following the SVCDB.
3458 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3459 warn "$me svc_x requires a svcdb";
3462 my $opt = ref($_[0]) ? shift : { @_ };
3464 $opt->{'table'} = $svcdb;
3465 $opt->{'addl_from'} =
3466 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3467 ($opt->{'addl_from'} || '');
3469 my $custnum = $self->custnum;
3470 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3471 my $where = "cust_pkg.custnum = $custnum";
3473 my $extra_sql = $opt->{'extra_sql'} || '';
3474 if ( keys %{ $opt->{'hashref'} } ) {
3475 $extra_sql = " AND $where $extra_sql";
3478 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3479 $extra_sql = "WHERE $where AND $1";
3482 $extra_sql = "WHERE $where $extra_sql";
3485 $opt->{'extra_sql'} = $extra_sql;
3490 # required for use as an eventtable;
3493 $self->svc_x('svc_acct', @_);
3498 Returns all the credits (see L<FS::cust_credit>) for this customer.
3504 map { $_ } #return $self->num_cust_credit unless wantarray;
3505 sort { $a->_date <=> $b->_date }
3506 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3509 =item cust_credit_pkgnum
3511 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3512 package when using experimental package balances.
3516 sub cust_credit_pkgnum {
3517 my( $self, $pkgnum ) = @_;
3518 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3519 sort { $a->_date <=> $b->_date }
3520 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3521 'pkgnum' => $pkgnum,
3526 =item cust_credit_void
3528 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3532 sub cust_credit_void {
3535 sort { $a->_date <=> $b->_date }
3536 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3541 Returns all the payments (see L<FS::cust_pay>) for this customer.
3547 my $opt = ref($_[0]) ? shift : { @_ };
3549 return $self->num_cust_pay unless wantarray || keys %$opt;
3551 $opt->{'table'} = 'cust_pay';
3552 $opt->{'hashref'}{'custnum'} = $self->custnum;
3554 map { $_ } #behavior of sort undefined in scalar context
3555 sort { $a->_date <=> $b->_date }
3562 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3563 called automatically when the cust_pay method is used in a scalar context.
3569 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3570 my $sth = dbh->prepare($sql) or die dbh->errstr;
3571 $sth->execute($self->custnum) or die $sth->errstr;
3572 $sth->fetchrow_arrayref->[0];
3575 =item unapplied_cust_pay
3577 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3581 sub unapplied_cust_pay {
3585 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3591 =item cust_pay_pkgnum
3593 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3594 package when using experimental package balances.
3598 sub cust_pay_pkgnum {
3599 my( $self, $pkgnum ) = @_;
3600 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3601 sort { $a->_date <=> $b->_date }
3602 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3603 'pkgnum' => $pkgnum,
3610 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3616 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3617 sort { $a->_date <=> $b->_date }
3618 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3621 =item cust_pay_pending
3623 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3624 (without status "done").
3628 sub cust_pay_pending {
3630 return $self->num_cust_pay_pending unless wantarray;
3631 sort { $a->_date <=> $b->_date }
3632 qsearch( 'cust_pay_pending', {
3633 'custnum' => $self->custnum,
3634 'status' => { op=>'!=', value=>'done' },
3639 =item cust_pay_pending_attempt
3641 Returns all payment attempts / declined payments for this customer, as pending
3642 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3643 a corresponding payment (see L<FS::cust_pay>).
3647 sub cust_pay_pending_attempt {
3649 return $self->num_cust_pay_pending_attempt unless wantarray;
3650 sort { $a->_date <=> $b->_date }
3651 qsearch( 'cust_pay_pending', {
3652 'custnum' => $self->custnum,
3659 =item num_cust_pay_pending
3661 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3662 customer (without status "done"). Also called automatically when the
3663 cust_pay_pending method is used in a scalar context.
3667 sub num_cust_pay_pending {
3670 " SELECT COUNT(*) FROM cust_pay_pending ".
3671 " WHERE custnum = ? AND status != 'done' ",
3676 =item num_cust_pay_pending_attempt
3678 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3679 customer, with status "done" but without a corresp. Also called automatically when the
3680 cust_pay_pending method is used in a scalar context.
3684 sub num_cust_pay_pending_attempt {
3687 " SELECT COUNT(*) FROM cust_pay_pending ".
3688 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3695 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3701 map { $_ } #return $self->num_cust_refund unless wantarray;
3702 sort { $a->_date <=> $b->_date }
3703 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3706 =item display_custnum
3708 Returns the displayed customer number for this customer: agent_custid if
3709 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3713 sub display_custnum {
3716 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3717 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3718 if ( $special eq 'CoStAg' ) {
3719 $prefix = uc( join('',
3721 ($self->state =~ /^(..)/),
3722 $prefix || ($self->agent->agent =~ /^(..)/)
3725 elsif ( $special eq 'CoStCl' ) {
3726 $prefix = uc( join('',
3728 ($self->state =~ /^(..)/),
3729 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3732 # add any others here if needed
3735 my $length = $conf->config('cust_main-custnum-display_length');
3736 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3737 return $self->agent_custid;
3738 } elsif ( $prefix ) {
3739 $length = 8 if !defined($length);
3741 sprintf('%0'.$length.'d', $self->custnum)
3742 } elsif ( $length ) {
3743 return sprintf('%0'.$length.'d', $self->custnum);
3745 return $self->custnum;
3751 Returns a name string for this customer, either "Company (Last, First)" or
3758 my $name = $self->contact;
3759 $name = $self->company. " ($name)" if $self->company;
3763 =item service_contact
3765 Returns the L<FS::contact> object for this customer that has the 'Service'
3766 contact class, or undef if there is no such contact. Deprecated; don't use
3771 sub service_contact {
3773 if ( !exists($self->{service_contact}) ) {
3774 my $classnum = $self->scalar_sql(
3775 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3776 ) || 0; #if it's zero, qsearchs will return nothing
3777 my $cust_contact = qsearchs('cust_contact', {
3778 'classnum' => $classnum,
3779 'custnum' => $self->custnum,
3781 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3783 $self->{service_contact};
3788 Returns a name string for this (service/shipping) contact, either
3789 "Company (Last, First)" or "Last, First".
3796 my $name = $self->ship_contact;
3797 $name = $self->company. " ($name)" if $self->company;
3803 Returns a name string for this customer, either "Company" or "First Last".
3809 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3812 =item ship_name_short
3814 Returns a name string for this (service/shipping) contact, either "Company"
3819 sub ship_name_short {
3821 $self->service_contact
3822 ? $self->ship_contact_firstlast
3828 Returns this customer's full (billing) contact name only, "Last, First"
3834 $self->get('last'). ', '. $self->first;
3839 Returns this customer's full (shipping) contact name only, "Last, First"
3845 my $contact = $self->service_contact || $self;
3846 $contact->get('last') . ', ' . $contact->get('first');
3849 =item contact_firstlast
3851 Returns this customers full (billing) contact name only, "First Last".
3855 sub contact_firstlast {
3857 $self->first. ' '. $self->get('last');
3860 =item ship_contact_firstlast
3862 Returns this customer's full (shipping) contact name only, "First Last".
3866 sub ship_contact_firstlast {
3868 my $contact = $self->service_contact || $self;
3869 $contact->get('first') . ' '. $contact->get('last');
3872 #XXX this doesn't work in 3.x+
3875 #Returns this customer's full country name
3881 # code2country($self->country);
3884 sub bill_country_full {
3886 code2country($self->bill_location->country);
3889 sub ship_country_full {
3891 code2country($self->ship_location->country);
3894 =item county_state_county [ PREFIX ]
3896 Returns a string consisting of just the county, state and country.
3900 sub county_state_country {
3903 if ( @_ && $_[0] && $self->has_ship_address ) {
3904 $locationnum = $self->ship_locationnum;
3906 $locationnum = $self->bill_locationnum;
3908 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3909 $cust_location->county_state_country;
3912 =item geocode DATA_VENDOR
3914 Returns a value for the customer location as encoded by DATA_VENDOR.
3915 Currently this only makes sense for "CCH" as DATA_VENDOR.
3923 Returns a status string for this customer, currently:
3929 No packages have ever been ordered. Displayed as "No packages".
3933 Recurring packages all are new (not yet billed).
3937 One or more recurring packages is active.
3941 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3945 All non-cancelled recurring packages are suspended.
3949 All recurring packages are cancelled.
3953 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3954 cust_main-status_module configuration option.
3958 sub status { shift->cust_status(@_); }
3962 for my $status ( FS::cust_main->statuses() ) {
3963 my $method = $status.'_sql';
3964 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3965 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3966 $sth->execute( ($self->custnum) x $numnum )
3967 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3968 return $status if $sth->fetchrow_arrayref->[0];
3972 =item is_status_delay_cancel
3974 Returns true if customer status is 'suspended'
3975 and all suspended cust_pkg return true for
3976 cust_pkg->is_status_delay_cancel.
3978 This is not a real status, this only meant for hacking display
3979 values, because otherwise treating the customer as suspended is
3980 really the whole point of the delay_cancel option.
3984 sub is_status_delay_cancel {
3986 return 0 unless $self->status eq 'suspended';
3987 foreach my $cust_pkg ($self->ncancelled_pkgs) {
3988 return 0 unless $cust_pkg->is_status_delay_cancel;
3993 =item ucfirst_cust_status
3995 =item ucfirst_status
3997 Deprecated, use the cust_status_label method instead.
3999 Returns the status with the first character capitalized.
4003 sub ucfirst_status {
4004 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4005 local($ucfirst_nowarn) = 1;
4006 shift->ucfirst_cust_status(@_);
4009 sub ucfirst_cust_status {
4010 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4012 ucfirst($self->cust_status);
4015 =item cust_status_label
4019 Returns the display label for this status.
4023 sub status_label { shift->cust_status_label(@_); }
4025 sub cust_status_label {
4027 __PACKAGE__->statuslabels->{$self->cust_status};
4032 Returns a hex triplet color string for this customer's status.
4036 sub statuscolor { shift->cust_statuscolor(@_); }
4038 sub cust_statuscolor {
4040 __PACKAGE__->statuscolors->{$self->cust_status};
4043 =item tickets [ STATUS ]
4045 Returns an array of hashes representing the customer's RT tickets.
4047 An optional status (or arrayref or hashref of statuses) may be specified.
4053 my $status = ( @_ && $_[0] ) ? shift : '';
4055 my $num = $conf->config('cust_main-max_tickets') || 10;
4058 if ( $conf->config('ticket_system') ) {
4059 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4061 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4070 foreach my $priority (
4071 $conf->config('ticket_system-custom_priority_field-values'), ''
4073 last if scalar(@tickets) >= $num;
4075 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4076 $num - scalar(@tickets),
4087 =item appointments [ STATUS ]
4089 Returns an array of hashes representing the customer's RT tickets which
4096 my $status = ( @_ && $_[0] ) ? shift : '';
4098 return () unless $conf->config('ticket_system');
4100 my $queueid = $conf->config('ticket_system-appointment-queueid');
4102 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4111 # Return services representing svc_accts in customer support packages
4112 sub support_services {
4114 my %packages = map { $_ => 1 } $conf->config('support_packages');
4116 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4117 grep { $_->part_svc->svcdb eq 'svc_acct' }
4118 map { $_->cust_svc }
4119 grep { exists $packages{ $_->pkgpart } }
4120 $self->ncancelled_pkgs;
4124 # Return a list of latitude/longitude for one of the services (if any)
4125 sub service_coordinates {
4129 grep { $_->latitude && $_->longitude }
4131 map { $_->cust_svc }
4132 $self->ncancelled_pkgs;
4134 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4139 Returns a masked version of the named field
4144 my ($self,$field) = @_;
4148 'x'x(length($self->getfield($field))-4).
4149 substr($self->getfield($field), (length($self->getfield($field))-4));
4153 =item payment_history
4155 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4156 cust_credit and cust_refund objects. Each hashref has the following fields:
4158 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4160 I<date> - value of _date field, unix timestamp
4162 I<date_pretty> - user-friendly date
4164 I<description> - user-friendly description of item
4166 I<amount> - impact of item on user's balance
4167 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4168 Not to be confused with the native 'amount' field in cust_credit, see below.
4170 I<amount_pretty> - includes money char
4172 I<balance> - customer balance, chronologically as of this item
4174 I<balance_pretty> - includes money char
4176 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4178 I<paid> - amount paid for cust_pay records, undef for other types
4180 I<credit> - amount credited for cust_credit records, undef for other types.
4181 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4183 I<refund> - amount refunded for cust_refund records, undef for other types
4185 The four table-specific keys always have positive values, whether they reflect charges or payments.
4187 The following options may be passed to this method:
4189 I<line_items> - if true, returns charges ('Line item') rather than invoices
4191 I<start_date> - unix timestamp, only include records on or after.
4192 If specified, an item of type 'Previous' will also be included.
4193 It does not have table-specific fields.
4195 I<end_date> - unix timestamp, only include records before
4197 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4199 I<conf> - optional already-loaded FS::Conf object.
4203 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4204 # and also for sending customer statements, which should both be kept customer-friendly.
4205 # If you add anything that shouldn't be passed on through the API or exposed
4206 # to customers, add a new option to include it, don't include it by default
4207 sub payment_history {
4209 my $opt = ref($_[0]) ? $_[0] : { @_ };
4211 my $conf = $$opt{'conf'} || new FS::Conf;
4212 my $money_char = $conf->config("money_char") || '$',
4214 #first load entire history,
4215 #need previous to calculate previous balance
4216 #loading after end_date shouldn't hurt too much?
4218 if ( $$opt{'line_items'} ) {
4220 foreach my $cust_bill ( $self->cust_bill ) {
4223 'type' => 'Line item',
4224 'description' => $_->desc( $self->locale ).
4225 ( $_->sdate && $_->edate
4226 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4227 ' To '. time2str('%d-%b-%Y', $_->edate)
4230 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4231 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4232 'date' => $cust_bill->_date,
4233 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4235 foreach $cust_bill->cust_bill_pkg;
4242 'type' => 'Invoice',
4243 'description' => 'Invoice #'. $_->display_invnum,
4244 'amount' => sprintf('%.2f', $_->charged ),
4245 'charged' => sprintf('%.2f', $_->charged ),
4246 'date' => $_->_date,
4247 'date_pretty' => $self->time2str_local('short', $_->_date ),
4249 foreach $self->cust_bill;
4254 'type' => 'Payment',
4255 'description' => 'Payment', #XXX type
4256 'amount' => sprintf('%.2f', 0 - $_->paid ),
4257 'paid' => sprintf('%.2f', $_->paid ),
4258 'date' => $_->_date,
4259 'date_pretty' => $self->time2str_local('short', $_->_date ),
4261 foreach $self->cust_pay;
4265 'description' => 'Credit', #more info?
4266 'amount' => sprintf('%.2f', 0 -$_->amount ),
4267 'credit' => sprintf('%.2f', $_->amount ),
4268 'date' => $_->_date,
4269 'date_pretty' => $self->time2str_local('short', $_->_date ),
4271 foreach $self->cust_credit;
4275 'description' => 'Refund', #more info? type, like payment?
4276 'amount' => $_->refund,
4277 'refund' => $_->refund,
4278 'date' => $_->_date,
4279 'date_pretty' => $self->time2str_local('short', $_->_date ),
4281 foreach $self->cust_refund;
4283 #put it all in chronological order
4284 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4286 #calculate balance, filter items outside date range
4290 foreach my $item (@history) {
4291 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4292 $balance += $$item{'amount'};
4293 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4294 $previous += $$item{'amount'};
4297 $$item{'balance'} = sprintf("%.2f",$balance);
4298 foreach my $key ( qw(amount balance) ) {
4299 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4304 # start with previous balance, if there was one
4307 'type' => 'Previous',
4308 'description' => 'Previous balance',
4309 'amount' => sprintf("%.2f",$previous),
4310 'balance' => sprintf("%.2f",$previous),
4311 'date' => $$opt{'start_date'},
4312 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4314 #false laziness with above
4315 foreach my $key ( qw(amount balance) ) {
4316 $$item{$key.'_pretty'} = $$item{$key};
4317 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4319 unshift(@out,$item);
4322 @out = reverse @history if $$opt{'reverse_sort'};
4329 =head1 CLASS METHODS
4335 Class method that returns the list of possible status strings for customers
4336 (see L<the status method|/status>). For example:
4338 @statuses = FS::cust_main->statuses();
4344 keys %{ $self->statuscolors };
4347 =item cust_status_sql
4349 Returns an SQL fragment to determine the status of a cust_main record, as a
4354 sub cust_status_sql {
4356 for my $status ( FS::cust_main->statuses() ) {
4357 my $method = $status.'_sql';
4358 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4367 Returns an SQL expression identifying prospective cust_main records (customers
4368 with no packages ever ordered)
4372 use vars qw($select_count_pkgs);
4373 $select_count_pkgs =
4374 "SELECT COUNT(*) FROM cust_pkg
4375 WHERE cust_pkg.custnum = cust_main.custnum";
4377 sub select_count_pkgs_sql {
4382 " 0 = ( $select_count_pkgs ) ";
4387 Returns an SQL expression identifying ordered cust_main records (customers with
4388 no active packages, but recurring packages not yet setup or one time charges
4394 FS::cust_main->none_active_sql.
4395 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4400 Returns an SQL expression identifying active cust_main records (customers with
4401 active recurring packages).
4406 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4409 =item none_active_sql
4411 Returns an SQL expression identifying cust_main records with no active
4412 recurring packages. This includes customers of status prospect, ordered,
4413 inactive, and suspended.
4417 sub none_active_sql {
4418 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4423 Returns an SQL expression identifying inactive cust_main records (customers with
4424 no active recurring packages, but otherwise unsuspended/uncancelled).
4429 FS::cust_main->none_active_sql.
4430 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4436 Returns an SQL expression identifying suspended cust_main records.
4441 sub suspended_sql { susp_sql(@_); }
4443 FS::cust_main->none_active_sql.
4444 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4450 Returns an SQL expression identifying cancelled cust_main records.
4454 sub cancel_sql { shift->cancelled_sql(@_); }
4457 =item uncancelled_sql
4459 Returns an SQL expression identifying un-cancelled cust_main records.
4463 sub uncancelled_sql { uncancel_sql(@_); }
4464 sub uncancel_sql { "
4465 ( 0 < ( $select_count_pkgs
4466 AND ( cust_pkg.cancel IS NULL
4467 OR cust_pkg.cancel = 0
4470 OR 0 = ( $select_count_pkgs )
4476 Returns an SQL fragment to retreive the balance.
4481 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4482 WHERE cust_bill.custnum = cust_main.custnum )
4483 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4484 WHERE cust_pay.custnum = cust_main.custnum )
4485 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4486 WHERE cust_credit.custnum = cust_main.custnum )
4487 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4488 WHERE cust_refund.custnum = cust_main.custnum )
4491 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4493 Returns an SQL fragment to retreive the balance for this customer, optionally
4494 considering invoices with date earlier than START_TIME, and not
4495 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4496 total_unapplied_payments).
4498 Times are specified as SQL fragments or numeric
4499 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4500 L<Date::Parse> for conversion functions. The empty string can be passed
4501 to disable that time constraint completely.
4503 Available options are:
4507 =item unapplied_date
4509 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)
4514 set to true to remove all customer comparison clauses, for totals
4519 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4524 JOIN clause (typically used with the total option)
4528 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4529 time will be ignored. Note that START_TIME and END_TIME only limit the date
4530 range for invoices and I<unapplied> payments, credits, and refunds.
4536 sub balance_date_sql {
4537 my( $class, $start, $end, %opt ) = @_;
4539 my $cutoff = $opt{'cutoff'};
4541 my $owed = FS::cust_bill->owed_sql($cutoff);
4542 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4543 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4544 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4546 my $j = $opt{'join'} || '';
4548 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4549 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4550 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4551 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4553 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4554 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4555 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4556 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4561 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4563 Returns an SQL fragment to retreive the total unapplied payments for this
4564 customer, only considering payments with date earlier than START_TIME, and
4565 optionally not later than END_TIME.
4567 Times are specified as SQL fragments or numeric
4568 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4569 L<Date::Parse> for conversion functions. The empty string can be passed
4570 to disable that time constraint completely.
4572 Available options are:
4576 sub unapplied_payments_date_sql {
4577 my( $class, $start, $end, %opt ) = @_;
4579 my $cutoff = $opt{'cutoff'};
4581 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4583 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4584 'unapplied_date'=>1 );
4586 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4589 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4591 Helper method for balance_date_sql; name (and usage) subject to change
4592 (suggestions welcome).
4594 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4595 cust_refund, cust_credit or cust_pay).
4597 If TABLE is "cust_bill" or the unapplied_date option is true, only
4598 considers records with date earlier than START_TIME, and optionally not
4599 later than END_TIME .
4603 sub _money_table_where {
4604 my( $class, $table, $start, $end, %opt ) = @_;
4607 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4608 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4609 push @where, "$table._date <= $start" if defined($start) && length($start);
4610 push @where, "$table._date > $end" if defined($end) && length($end);
4612 push @where, @{$opt{'where'}} if $opt{'where'};
4613 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4619 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4620 use FS::cust_main::Search;
4623 FS::cust_main::Search->search(@_);
4632 #=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4634 #Deprecated. Use event notification and message templates
4635 #(L<FS::msg_template>) instead.
4637 #Sends a templated email notification to the customer (see L<Text::Template>).
4639 #OPTIONS is a hash and may include
4641 #I<from> - the email sender (default is invoice_from)
4643 #I<to> - comma-separated scalar or arrayref of recipients
4644 # (default is invoicing_list)
4646 #I<subject> - The subject line of the sent email notification
4647 # (default is "Notice from company_name")
4649 #I<extra_fields> - a hashref of name/value pairs which will be substituted
4652 #The following variables are vavailable in the template.
4654 #I<$first> - the customer first name
4655 #I<$last> - the customer last name
4656 #I<$company> - the customer company
4657 #I<$payby> - a description of the method of payment for the customer
4658 # # would be nice to use FS::payby::shortname
4659 #I<$payinfo> - the account information used to collect for this customer
4660 #I<$expdate> - the expiration of the customer payment in seconds from epoch
4665 # my ($self, $template, %options) = @_;
4667 # return unless $conf->exists($template);
4669 # my $from = $conf->invoice_from_full($self->agentnum)
4670 # if $conf->exists('invoice_from', $self->agentnum);
4671 # $from = $options{from} if exists($options{from});
4673 # my $to = join(',', $self->invoicing_list_emailonly);
4674 # $to = $options{to} if exists($options{to});
4676 # my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4677 # if $conf->exists('company_name', $self->agentnum);
4678 # $subject = $options{subject} if exists($options{subject});
4680 # my $notify_template = new Text::Template (TYPE => 'ARRAY',
4681 # SOURCE => [ map "$_\n",
4682 # $conf->config($template)]
4684 # or die "can't create new Text::Template object: Text::Template::ERROR";
4685 # $notify_template->compile()
4686 # or die "can't compile template: Text::Template::ERROR";
4688 # $FS::notify_template::_template::company_name =
4689 # $conf->config('company_name', $self->agentnum);
4690 # $FS::notify_template::_template::company_address =
4691 # join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4693 # my $paydate = $self->paydate || '2037-12-31';
4694 # $FS::notify_template::_template::first = $self->first;
4695 # $FS::notify_template::_template::last = $self->last;
4696 # $FS::notify_template::_template::company = $self->company;
4697 # $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4698 # my $payby = $self->payby;
4699 # my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4700 # my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4702 # #credit cards expire at the end of the month/year of their exp date
4703 # if ($payby eq 'CARD' || $payby eq 'DCRD') {
4704 # $FS::notify_template::_template::payby = 'credit card';
4705 # ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4706 # $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4708 # }elsif ($payby eq 'COMP') {
4709 # $FS::notify_template::_template::payby = 'complimentary account';
4711 # $FS::notify_template::_template::payby = 'current method';
4713 # $FS::notify_template::_template::expdate = $expire_time;
4715 # for (keys %{$options{extra_fields}}){
4717 # ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4720 # send_email(from => $from,
4722 # subject => $subject,
4723 # body => $notify_template->fill_in( PACKAGE =>
4724 # 'FS::notify_template::_template' ),
4729 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4731 Generates a templated notification to the customer (see L<Text::Template>).
4733 OPTIONS is a hash and may include
4735 I<extra_fields> - a hashref of name/value pairs which will be substituted
4736 into the template. These values may override values mentioned below
4737 and those from the customer record.
4739 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
4741 The following variables are available in the template instead of or in addition
4742 to the fields of the customer record.
4744 I<$payby> - a description of the method of payment for the customer
4745 # would be nice to use FS::payby::shortname
4746 I<$payinfo> - the masked account information used to collect for this customer
4747 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4748 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4752 # a lot like cust_bill::print_latex
4753 sub generate_letter {
4754 my ($self, $template, %options) = @_;
4756 warn "Template $template does not exist" && return
4757 unless $conf->exists($template) || $options{'template_text'};
4759 my $template_source = $options{'template_text'}
4760 ? [ $options{'template_text'} ]
4761 : [ map "$_\n", $conf->config($template) ];
4763 my $letter_template = new Text::Template
4765 SOURCE => $template_source,
4766 DELIMITERS => [ '[@--', '--@]' ],
4768 or die "can't create new Text::Template object: Text::Template::ERROR";
4770 $letter_template->compile()
4771 or die "can't compile template: Text::Template::ERROR";
4773 my %letter_data = map { $_ => $self->$_ } $self->fields;
4774 $letter_data{payinfo} = $self->mask_payinfo;
4776 #my $paydate = $self->paydate || '2037-12-31';
4777 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4779 my $payby = $self->payby;
4780 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4781 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4783 #credit cards expire at the end of the month/year of their exp date
4784 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4785 $letter_data{payby} = 'credit card';
4786 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4787 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4789 }elsif ($payby eq 'COMP') {
4790 $letter_data{payby} = 'complimentary account';
4792 $letter_data{payby} = 'current method';
4794 $letter_data{expdate} = $expire_time;
4796 for (keys %{$options{extra_fields}}){
4797 $letter_data{$_} = $options{extra_fields}->{$_};
4800 unless(exists($letter_data{returnaddress})){
4801 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4802 $self->agent_template)
4804 if ( length($retadd) ) {
4805 $letter_data{returnaddress} = $retadd;
4806 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4807 $letter_data{returnaddress} =
4808 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4812 ( $conf->config('company_name', $self->agentnum),
4813 $conf->config('company_address', $self->agentnum),
4817 $letter_data{returnaddress} = '~';
4821 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4823 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4825 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4827 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4831 ) or die "can't open temp file: $!\n";
4832 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4833 or die "can't write temp file: $!\n";
4835 $letter_data{'logo_file'} = $lh->filename;
4837 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4841 ) or die "can't open temp file: $!\n";
4843 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4845 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4846 return ($1, $letter_data{'logo_file'});
4850 =item print_ps TEMPLATE
4852 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4858 my($file, $lfile) = $self->generate_letter(@_);
4859 my $ps = FS::Misc::generate_ps($file);
4860 unlink($file.'.tex');
4866 =item print TEMPLATE
4868 Prints the filled in template.
4870 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4874 sub queueable_print {
4877 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4878 or die "invalid customer number: " . $opt{custnum};
4880 #do not backport this change to 3.x
4881 # my $error = $self->print( { 'template' => $opt{template} } );
4882 my $error = $self->print( $opt{'template'} );
4883 die $error if $error;
4887 my ($self, $template) = (shift, shift);
4889 [ $self->print_ps($template) ],
4890 'agentnum' => $self->agentnum,
4894 #these three subs should just go away once agent stuff is all config overrides
4896 sub agent_template {
4898 $self->_agent_plandata('agent_templatename');
4901 sub agent_invoice_from {
4903 $self->_agent_plandata('agent_invoice_from');
4906 sub _agent_plandata {
4907 my( $self, $option ) = @_;
4909 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4910 #agent-specific Conf
4912 use FS::part_event::Condition;
4914 my $agentnum = $self->agentnum;
4916 my $regexp = regexp_sql();
4918 my $part_event_option =
4920 'select' => 'part_event_option.*',
4921 'table' => 'part_event_option',
4923 LEFT JOIN part_event USING ( eventpart )
4924 LEFT JOIN part_event_option AS peo_agentnum
4925 ON ( part_event.eventpart = peo_agentnum.eventpart
4926 AND peo_agentnum.optionname = 'agentnum'
4927 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4929 LEFT JOIN part_event_condition
4930 ON ( part_event.eventpart = part_event_condition.eventpart
4931 AND part_event_condition.conditionname = 'cust_bill_age'
4933 LEFT JOIN part_event_condition_option
4934 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4935 AND part_event_condition_option.optionname = 'age'
4938 #'hashref' => { 'optionname' => $option },
4939 #'hashref' => { 'part_event_option.optionname' => $option },
4941 " WHERE part_event_option.optionname = ". dbh->quote($option).
4942 " AND action = 'cust_bill_send_agent' ".
4943 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4944 " AND peo_agentnum.optionname = 'agentnum' ".
4945 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4947 CASE WHEN part_event_condition_option.optionname IS NULL
4949 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4951 , part_event.weight".
4955 unless ( $part_event_option ) {
4956 return $self->agent->invoice_template || ''
4957 if $option eq 'agent_templatename';
4961 $part_event_option->optionvalue;
4965 sub process_o2m_qsearch {
4968 return qsearch($table, @_) unless $table eq 'contact';
4970 my $hashref = shift;
4971 my %hash = %$hashref;
4972 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4973 or die 'guru meditation #4343';
4975 qsearch({ 'table' => 'contact',
4976 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4977 'hashref' => \%hash,
4978 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4979 " cust_contact.custnum = $custnum "
4983 sub process_o2m_qsearchs {
4986 return qsearchs($table, @_) unless $table eq 'contact';
4988 my $hashref = shift;
4989 my %hash = %$hashref;
4990 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4991 or die 'guru meditation #2121';
4993 qsearchs({ 'table' => 'contact',
4994 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4995 'hashref' => \%hash,
4996 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4997 " cust_contact.custnum = $custnum "
5001 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5003 Subroutine (not a method), designed to be called from the queue.
5005 Takes a list of options and values.
5007 Pulls up the customer record via the custnum option and calls bill_and_collect.
5012 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5014 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5015 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5017 #without this errors don't get rolled back
5018 $args{'fatal'} = 1; # runs from job queue, will be caught
5020 $cust_main->bill_and_collect( %args );
5023 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5025 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5026 C<collect> part. This is used in batch tax calculation, where invoice
5027 generation and collection events have to be completely separated.
5031 sub queued_collect {
5033 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5035 $cust_main->collect(%args);
5038 sub process_bill_and_collect {
5041 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5042 or die "custnum '$param->{custnum}' not found!\n";
5043 $param->{'job'} = $job;
5044 $param->{'fatal'} = 1; # runs from job queue, will be caught
5045 $param->{'retry'} = 1;
5047 $cust_main->bill_and_collect( %$param );
5050 #starting to take quite a while for big dbs
5051 # (JRNL: journaled so it only happens once per database)
5052 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5053 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5054 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5055 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5056 # JRNL leading/trailing spaces in first, last, company
5057 # JRNL migrate to cust_payby
5058 # - otaker upgrade? journal and call it good? (double check to make sure
5059 # we're not still setting otaker here)
5061 #only going to get worse with new location stuff...
5063 sub _upgrade_data { #class method
5064 my ($class, %opts) = @_;
5067 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5070 #this seems to be the only expensive one.. why does it take so long?
5071 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5073 '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';
5074 FS::upgrade_journal->set_done('cust_main__signupdate');
5077 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5079 # fix yyyy-m-dd formatted paydates
5080 if ( driver_name =~ /^mysql/i ) {
5082 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5083 } else { # the SQL standard
5085 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5087 FS::upgrade_journal->set_done('cust_main__paydate');
5090 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5092 push @statements, #fix the weird BILL with a cc# in payinfo problem
5094 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5096 FS::upgrade_journal->set_done('cust_main__payinfo');
5101 foreach my $sql ( @statements ) {
5102 my $sth = dbh->prepare($sql) or die dbh->errstr;
5103 $sth->execute or die $sth->errstr;
5104 #warn ( (time - $t). " seconds\n" );
5108 local($ignore_expired_card) = 1;
5109 local($ignore_banned_card) = 1;
5110 local($skip_fuzzyfiles) = 1;
5111 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5113 FS::cust_main::Location->_upgrade_data(%opts);
5115 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5117 foreach my $cust_main ( qsearch({
5118 'table' => 'cust_main',
5120 'extra_sql' => 'WHERE '.
5122 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5123 qw( first last company )
5126 my $error = $cust_main->replace;
5127 die $error if $error;
5130 FS::upgrade_journal->set_done('cust_main__trimspaces');
5134 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
5136 #we don't want to decrypt them, just stuff them as-is into cust_payby
5137 local(@encrypted_fields) = ();
5139 local($FS::cust_payby::ignore_expired_card) = 1;
5140 local($FS::cust_payby::ignore_banned_card) = 1;
5142 my @payfields = qw( payby payinfo paycvv paymask
5143 paydate paystart_month paystart_year payissue
5144 payname paystate paytype payip
5147 my $search = new FS::Cursor {
5148 'table' => 'cust_main',
5149 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
5152 while (my $cust_main = $search->fetch) {
5154 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
5156 my $cust_payby = new FS::cust_payby {
5157 'custnum' => $cust_main->custnum,
5159 map { $_ => $cust_main->$_(); } @payfields
5162 my $error = $cust_payby->insert;
5163 die $error if $error;
5167 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
5169 $cust_main->invoice_attn( $cust_main->payname )
5170 if $cust_main->payby eq 'BILL' && $cust_main->payname;
5171 $cust_main->po_number( $cust_main->payinfo )
5172 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
5174 $cust_main->setfield($_, '') foreach @payfields;
5175 my $error = $cust_main->replace;
5176 die "Error upgradging payment information for custnum ".
5177 $cust_main->custnum. ": $error"
5182 FS::upgrade_journal->set_done('cust_main__cust_payby');
5185 $class->_upgrade_otaker(%opts);
5195 The delete method should possibly take an FS::cust_main object reference
5196 instead of a scalar customer number.
5198 Bill and collect options should probably be passed as references instead of a
5201 There should probably be a configuration file with a list of allowed credit
5204 No multiple currency support (probably a larger project than just this module).
5206 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5208 Birthdates rely on negative epoch values.
5210 The payby for card/check batches is broken. With mixed batching, bad
5213 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5217 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5218 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5219 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.