4 use vars qw( @ISA $conf $Debug $import );
8 eval "use Time::Local;";
9 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
10 if $] < 5.006 && !defined($Time::Local::VERSION);
11 eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 use Business::CreditCard;
16 use FS::UID qw( getotaker dbh );
17 use FS::Record qw( qsearchs qsearch dbdef );
20 use FS::cust_bill_pkg;
24 use FS::part_referral;
25 use FS::cust_main_county;
27 use FS::cust_main_invoice;
28 use FS::cust_credit_bill;
29 use FS::cust_bill_pay;
30 use FS::prepay_credit;
33 use FS::part_bill_event;
34 use FS::cust_bill_event;
35 use FS::cust_tax_exempt;
37 use FS::Msgcat qw(gettext);
39 @ISA = qw( FS::Record );
46 #ask FS::UID to run this stuff for us later
47 $FS::UID::callback{'FS::cust_main'} = sub {
49 #yes, need it for stuff below (prolly should be cached)
54 my ( $hashref, $cache ) = @_;
55 if ( exists $hashref->{'pkgnum'} ) {
56 # #@{ $self->{'_pkgnum'} } = ();
57 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
58 $self->{'_pkgnum'} = $subcache;
59 #push @{ $self->{'_pkgnum'} },
60 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
66 FS::cust_main - Object methods for cust_main records
72 $record = new FS::cust_main \%hash;
73 $record = new FS::cust_main { 'column' => 'value' };
75 $error = $record->insert;
77 $error = $new_record->replace($old_record);
79 $error = $record->delete;
81 $error = $record->check;
83 @cust_pkg = $record->all_pkgs;
85 @cust_pkg = $record->ncancelled_pkgs;
87 @cust_pkg = $record->suspended_pkgs;
89 $error = $record->bill;
90 $error = $record->bill %options;
91 $error = $record->bill 'time' => $time;
93 $error = $record->collect;
94 $error = $record->collect %options;
95 $error = $record->collect 'invoice_time' => $time,
96 'batch_card' => 'yes',
97 'report_badcard' => 'yes',
102 An FS::cust_main object represents a customer. FS::cust_main inherits from
103 FS::Record. The following fields are currently supported:
107 =item custnum - primary key (assigned automatically for new customers)
109 =item agentnum - agent (see L<FS::agent>)
111 =item refnum - Advertising source (see L<FS::part_referral>)
117 =item ss - social security number (optional)
119 =item company - (optional)
123 =item address2 - (optional)
127 =item county - (optional, see L<FS::cust_main_county>)
129 =item state - (see L<FS::cust_main_county>)
133 =item country - (see L<FS::cust_main_county>)
135 =item daytime - phone (optional)
137 =item night - phone (optional)
139 =item fax - phone (optional)
141 =item ship_first - name
143 =item ship_last - name
145 =item ship_company - (optional)
149 =item ship_address2 - (optional)
153 =item ship_county - (optional, see L<FS::cust_main_county>)
155 =item ship_state - (see L<FS::cust_main_county>)
159 =item ship_country - (see L<FS::cust_main_county>)
161 =item ship_daytime - phone (optional)
163 =item ship_night - phone (optional)
165 =item ship_fax - phone (optional)
167 =item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
169 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
171 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
173 =item payname - name on card or billing name
175 =item tax - tax exempt, empty or `Y'
177 =item otaker - order taker (assigned automatically, see L<FS::UID>)
179 =item comments - comments (optional)
189 Creates a new customer. To add the customer to the database, see L<"insert">.
191 Note that this stores the hash reference, not a distinct copy of the hash it
192 points to. You can ask the object for a copy with the I<hash> method.
196 sub table { 'cust_main'; }
198 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
200 Adds this customer to the database. If there is an error, returns the error,
201 otherwise returns false.
203 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
204 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
205 are inserted atomicly, or the transaction is rolled back. Passing an empty
206 hash reference is equivalent to not supplying this parameter. There should be
207 a better explanation of this, but until then, here's an example:
210 tie %hash, 'Tie::RefHash'; #this part is important
212 $cust_pkg => [ $svc_acct ],
215 $cust_main->insert( \%hash );
217 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
218 be set as the invoicing list (see L<"invoicing_list">). Errors return as
219 expected and rollback the entire transaction; it is not necessary to call
220 check_invoicing_list first. The invoicing_list is set after the records in the
221 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
222 invoicing_list destination to the newly-created svc_acct. Here's an example:
224 $cust_main->insert( {}, [ $email, 'POST' ] );
226 Currently available options are: I<noexport>
228 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
229 (You can schedule them later with the B<reexport> method.)
235 my $cust_pkgs = @_ ? shift : {};
236 my $invoicing_list = @_ ? shift : '';
239 local $SIG{HUP} = 'IGNORE';
240 local $SIG{INT} = 'IGNORE';
241 local $SIG{QUIT} = 'IGNORE';
242 local $SIG{TERM} = 'IGNORE';
243 local $SIG{TSTP} = 'IGNORE';
244 local $SIG{PIPE} = 'IGNORE';
246 my $oldAutoCommit = $FS::UID::AutoCommit;
247 local $FS::UID::AutoCommit = 0;
252 if ( $self->payby eq 'PREPAY' ) {
253 $self->payby('BILL');
254 my $prepay_credit = qsearchs(
256 { 'identifier' => $self->payinfo },
260 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
261 unless $prepay_credit;
262 $amount = $prepay_credit->amount;
263 $seconds = $prepay_credit->seconds;
264 my $error = $prepay_credit->delete;
266 $dbh->rollback if $oldAutoCommit;
267 return "removing prepay_credit (transaction rolled back): $error";
271 my $error = $self->SUPER::insert;
273 $dbh->rollback if $oldAutoCommit;
274 #return "inserting cust_main record (transaction rolled back): $error";
279 if ( $invoicing_list ) {
280 $error = $self->check_invoicing_list( $invoicing_list );
282 $dbh->rollback if $oldAutoCommit;
283 return "checking invoicing_list (transaction rolled back): $error";
285 $self->invoicing_list( $invoicing_list );
289 #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
290 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
292 $dbh->rollback if $oldAutoCommit;
297 $dbh->rollback if $oldAutoCommit;
298 return "No svc_acct record to apply pre-paid time";
302 my $cust_credit = new FS::cust_credit {
303 'custnum' => $self->custnum,
306 $error = $cust_credit->insert;
308 $dbh->rollback if $oldAutoCommit;
309 return "inserting credit (transaction rolled back): $error";
313 $error = $self->queue_fuzzyfiles_update;
315 $dbh->rollback if $oldAutoCommit;
316 return "updating fuzzy search cache: $error";
319 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
324 =item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
326 Like the insert method on an existing record, this method orders a package
327 and included services atomicaly. Pass a Tie::RefHash data structure to this
328 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
329 be a better explanation of this, but until then, here's an example:
332 tie %hash, 'Tie::RefHash'; #this part is important
334 $cust_pkg => [ $svc_acct ],
337 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
339 Currently available options are: I<noexport>
341 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
342 (You can schedule them later with the B<reexport> method for each
343 cust_pkg object. Using the B<reexport> method on the cust_main object is not
344 recommended, as existing services will also be reexported.)
350 my $cust_pkgs = shift;
354 local $SIG{HUP} = 'IGNORE';
355 local $SIG{INT} = 'IGNORE';
356 local $SIG{QUIT} = 'IGNORE';
357 local $SIG{TERM} = 'IGNORE';
358 local $SIG{TSTP} = 'IGNORE';
359 local $SIG{PIPE} = 'IGNORE';
361 my $oldAutoCommit = $FS::UID::AutoCommit;
362 local $FS::UID::AutoCommit = 0;
365 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
367 foreach my $cust_pkg ( keys %$cust_pkgs ) {
368 $cust_pkg->custnum( $self->custnum );
369 my $error = $cust_pkg->insert;
371 $dbh->rollback if $oldAutoCommit;
372 return "inserting cust_pkg (transaction rolled back): $error";
374 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
375 $svc_something->pkgnum( $cust_pkg->pkgnum );
376 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
377 $svc_something->seconds( $svc_something->seconds + $$seconds );
380 $error = $svc_something->insert;
382 $dbh->rollback if $oldAutoCommit;
383 #return "inserting svc_ (transaction rolled back): $error";
389 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
395 Re-schedules all exports by calling the B<reexport> method of all associated
396 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
397 otherwise returns false.
404 local $SIG{HUP} = 'IGNORE';
405 local $SIG{INT} = 'IGNORE';
406 local $SIG{QUIT} = 'IGNORE';
407 local $SIG{TERM} = 'IGNORE';
408 local $SIG{TSTP} = 'IGNORE';
409 local $SIG{PIPE} = 'IGNORE';
411 my $oldAutoCommit = $FS::UID::AutoCommit;
412 local $FS::UID::AutoCommit = 0;
415 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
416 my $error = $cust_pkg->reexport;
418 $dbh->rollback if $oldAutoCommit;
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
428 =item delete NEW_CUSTNUM
430 This deletes the customer. If there is an error, returns the error, otherwise
433 This will completely remove all traces of the customer record. This is not
434 what you want when a customer cancels service; for that, cancel all of the
435 customer's packages (see L</cancel>).
437 If the customer has any uncancelled packages, you need to pass a new (valid)
438 customer number for those packages to be transferred to. Cancelled packages
439 will be deleted. Did I mention that this is NOT what you want when a customer
440 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
442 You can't delete a customer with invoices (see L<FS::cust_bill>),
443 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
444 refunds (see L<FS::cust_refund>).
451 local $SIG{HUP} = 'IGNORE';
452 local $SIG{INT} = 'IGNORE';
453 local $SIG{QUIT} = 'IGNORE';
454 local $SIG{TERM} = 'IGNORE';
455 local $SIG{TSTP} = 'IGNORE';
456 local $SIG{PIPE} = 'IGNORE';
458 my $oldAutoCommit = $FS::UID::AutoCommit;
459 local $FS::UID::AutoCommit = 0;
462 if ( $self->cust_bill ) {
463 $dbh->rollback if $oldAutoCommit;
464 return "Can't delete a customer with invoices";
466 if ( $self->cust_credit ) {
467 $dbh->rollback if $oldAutoCommit;
468 return "Can't delete a customer with credits";
470 if ( $self->cust_pay ) {
471 $dbh->rollback if $oldAutoCommit;
472 return "Can't delete a customer with payments";
474 if ( $self->cust_refund ) {
475 $dbh->rollback if $oldAutoCommit;
476 return "Can't delete a customer with refunds";
479 my @cust_pkg = $self->ncancelled_pkgs;
481 my $new_custnum = shift;
482 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
483 $dbh->rollback if $oldAutoCommit;
484 return "Invalid new customer number: $new_custnum";
486 foreach my $cust_pkg ( @cust_pkg ) {
487 my %hash = $cust_pkg->hash;
488 $hash{'custnum'} = $new_custnum;
489 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
490 my $error = $new_cust_pkg->replace($cust_pkg);
492 $dbh->rollback if $oldAutoCommit;
497 my @cancelled_cust_pkg = $self->all_pkgs;
498 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
499 my $error = $cust_pkg->delete;
501 $dbh->rollback if $oldAutoCommit;
506 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
507 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
509 my $error = $cust_main_invoice->delete;
511 $dbh->rollback if $oldAutoCommit;
516 my $error = $self->SUPER::delete;
518 $dbh->rollback if $oldAutoCommit;
522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
527 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
529 Replaces the OLD_RECORD with this one in the database. If there is an error,
530 returns the error, otherwise returns false.
532 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
533 be set as the invoicing list (see L<"invoicing_list">). Errors return as
534 expected and rollback the entire transaction; it is not necessary to call
535 check_invoicing_list first. Here's an example:
537 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
546 local $SIG{HUP} = 'IGNORE';
547 local $SIG{INT} = 'IGNORE';
548 local $SIG{QUIT} = 'IGNORE';
549 local $SIG{TERM} = 'IGNORE';
550 local $SIG{TSTP} = 'IGNORE';
551 local $SIG{PIPE} = 'IGNORE';
553 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
554 && $conf->config('users-allow_comp') ) {
555 return "You are not permitted to create complimentary accounts."
556 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
559 my $oldAutoCommit = $FS::UID::AutoCommit;
560 local $FS::UID::AutoCommit = 0;
563 my $error = $self->SUPER::replace($old);
566 $dbh->rollback if $oldAutoCommit;
570 if ( @param ) { # INVOICING_LIST_ARYREF
571 my $invoicing_list = shift @param;
572 $error = $self->check_invoicing_list( $invoicing_list );
574 $dbh->rollback if $oldAutoCommit;
577 $self->invoicing_list( $invoicing_list );
580 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
581 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
582 # card/check/lec info has changed, want to retry realtime_ invoice events
583 my $error = $self->retry_realtime;
585 $dbh->rollback if $oldAutoCommit;
590 $error = $self->queue_fuzzyfiles_update;
592 $dbh->rollback if $oldAutoCommit;
593 return "updating fuzzy search cache: $error";
596 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
601 =item queue_fuzzyfiles_update
603 Used by insert & replace to update the fuzzy search cache
607 sub queue_fuzzyfiles_update {
610 local $SIG{HUP} = 'IGNORE';
611 local $SIG{INT} = 'IGNORE';
612 local $SIG{QUIT} = 'IGNORE';
613 local $SIG{TERM} = 'IGNORE';
614 local $SIG{TSTP} = 'IGNORE';
615 local $SIG{PIPE} = 'IGNORE';
617 my $oldAutoCommit = $FS::UID::AutoCommit;
618 local $FS::UID::AutoCommit = 0;
621 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
622 my $error = $queue->insert($self->getfield('last'), $self->company);
624 $dbh->rollback if $oldAutoCommit;
625 return "queueing job (transaction rolled back): $error";
628 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
629 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
630 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
632 $dbh->rollback if $oldAutoCommit;
633 return "queueing job (transaction rolled back): $error";
637 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
644 Checks all fields to make sure this is a valid customer record. If there is
645 an error, returns the error, otherwise returns false. Called by the insert
653 #warn "BEFORE: \n". $self->_dump;
656 $self->ut_numbern('custnum')
657 || $self->ut_number('agentnum')
658 || $self->ut_number('refnum')
659 || $self->ut_name('last')
660 || $self->ut_name('first')
661 || $self->ut_textn('company')
662 || $self->ut_text('address1')
663 || $self->ut_textn('address2')
664 || $self->ut_text('city')
665 || $self->ut_textn('county')
666 || $self->ut_textn('state')
667 || $self->ut_country('country')
668 || $self->ut_anything('comments')
669 || $self->ut_numbern('referral_custnum')
671 #barf. need message catalogs. i18n. etc.
672 $error .= "Please select an advertising source."
673 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
674 return $error if $error;
676 return "Unknown agent"
677 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
679 return "Unknown refnum"
680 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
682 return "Unknown referring custnum ". $self->referral_custnum
683 unless ! $self->referral_custnum
684 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
686 if ( $self->ss eq '' ) {
691 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
692 or return "Illegal social security number: ". $self->ss;
693 $self->ss("$1-$2-$3");
697 # bad idea to disable, causes billing to fail because of no tax rates later
698 # unless ( $import ) {
699 unless ( qsearch('cust_main_county', {
700 'country' => $self->country,
703 return "Unknown state/county/country: ".
704 $self->state. "/". $self->county. "/". $self->country
705 unless qsearch('cust_main_county',{
706 'state' => $self->state,
707 'county' => $self->county,
708 'country' => $self->country,
714 $self->ut_phonen('daytime', $self->country)
715 || $self->ut_phonen('night', $self->country)
716 || $self->ut_phonen('fax', $self->country)
717 || $self->ut_zip('zip', $self->country)
719 return $error if $error;
722 last first company address1 address2 city county state zip
723 country daytime night fax
726 if ( defined $self->dbdef_table->column('ship_last') ) {
727 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
729 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
733 $self->ut_name('ship_last')
734 || $self->ut_name('ship_first')
735 || $self->ut_textn('ship_company')
736 || $self->ut_text('ship_address1')
737 || $self->ut_textn('ship_address2')
738 || $self->ut_text('ship_city')
739 || $self->ut_textn('ship_county')
740 || $self->ut_textn('ship_state')
741 || $self->ut_country('ship_country')
743 return $error if $error;
745 #false laziness with above
746 unless ( qsearchs('cust_main_county', {
747 'country' => $self->ship_country,
750 return "Unknown ship_state/ship_county/ship_country: ".
751 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
752 unless qsearchs('cust_main_county',{
753 'state' => $self->ship_state,
754 'county' => $self->ship_county,
755 'country' => $self->ship_country,
761 $self->ut_phonen('ship_daytime', $self->ship_country)
762 || $self->ut_phonen('ship_night', $self->ship_country)
763 || $self->ut_phonen('ship_fax', $self->ship_country)
764 || $self->ut_zip('ship_zip', $self->ship_country)
766 return $error if $error;
768 } else { # ship_ info eq billing info, so don't store dup info in database
769 $self->setfield("ship_$_", '')
770 foreach qw( last first company address1 address2 city county state zip
771 country daytime night fax );
775 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
776 or return "Illegal payby: ". $self->payby;
779 if ( $self->payby eq 'CARD' ) {
781 my $payinfo = $self->payinfo;
783 $payinfo =~ /^(\d{13,16})$/
784 or return gettext('invalid_card'); # . ": ". $self->payinfo;
786 $self->payinfo($payinfo);
788 or return gettext('invalid_card'); # . ": ". $self->payinfo;
789 return gettext('unknown_card_type')
790 if cardtype($self->payinfo) eq "Unknown";
791 if ( defined $self->dbdef_table->column('paycvv') ) {
792 if ( length($self->paycvv) ) {
793 if ( cardtype($self->payinfo) eq 'American Express card' ) {
794 $self->paycvv =~ /^(\d{4})$/
795 or return "CVV2 (CID) for American Express cards is four digits.";
798 $self->paycvv =~ /^(\d{3})$/
799 or return "CVV2 (CVC2/CID) is three digits.";
807 } elsif ( $self->payby eq 'CHEK' ) {
809 my $payinfo = $self->payinfo;
810 $payinfo =~ s/[^\d\@]//g;
811 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
813 $self->payinfo($payinfo);
814 $self->paycvv('') if $self->dbdef_table->column('paycvv');
816 } elsif ( $self->payby eq 'LECB' ) {
818 my $payinfo = $self->payinfo;
820 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
822 $self->payinfo($payinfo);
823 $self->paycvv('') if $self->dbdef_table->column('paycvv');
825 } elsif ( $self->payby eq 'BILL' ) {
827 $error = $self->ut_textn('payinfo');
828 return "Illegal P.O. number: ". $self->payinfo if $error;
829 $self->paycvv('') if $self->dbdef_table->column('paycvv');
831 } elsif ( $self->payby eq 'COMP' ) {
833 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
834 return "You are not permitted to create complimentary accounts."
835 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
838 $error = $self->ut_textn('payinfo');
839 return "Illegal comp account issuer: ". $self->payinfo if $error;
840 $self->paycvv('') if $self->dbdef_table->column('paycvv');
842 } elsif ( $self->payby eq 'PREPAY' ) {
844 my $payinfo = $self->payinfo;
845 $payinfo =~ s/\W//g; #anything else would just confuse things
846 $self->payinfo($payinfo);
847 $error = $self->ut_alpha('payinfo');
848 return "Illegal prepayment identifier: ". $self->payinfo if $error;
849 return "Unknown prepayment identifier"
850 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
851 $self->paycvv('') if $self->dbdef_table->column('paycvv');
855 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
856 return "Expriation date required"
857 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
860 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
861 or return "Illegal expiration date: ". $self->paydate;
862 my $y = length($2) == 4 ? $2 : "20$2";
863 $self->paydate("$y-$1-01");
864 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
865 return gettext('expired_card')
866 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
869 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
870 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
871 $self->payname( $self->first. " ". $self->getfield('last') );
873 $self->payname =~ /^([\w \,\.\-\']+)$/
874 or return gettext('illegal_name'). " payname: ". $self->payname;
878 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
881 $self->otaker(getotaker) unless $self->otaker;
883 #warn "AFTER: \n". $self->_dump;
890 Returns all packages (see L<FS::cust_pkg>) for this customer.
896 if ( $self->{'_pkgnum'} ) {
897 values %{ $self->{'_pkgnum'}->cache };
899 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
903 =item ncancelled_pkgs
905 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
909 sub ncancelled_pkgs {
911 if ( $self->{'_pkgnum'} ) {
912 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
914 @{ [ # force list context
915 qsearch( 'cust_pkg', {
916 'custnum' => $self->custnum,
919 qsearch( 'cust_pkg', {
920 'custnum' => $self->custnum,
929 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
935 grep { $_->susp } $self->ncancelled_pkgs;
938 =item unflagged_suspended_pkgs
940 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
941 customer (thouse packages without the `manual_flag' set).
945 sub unflagged_suspended_pkgs {
947 return $self->suspended_pkgs
948 unless dbdef->table('cust_pkg')->column('manual_flag');
949 grep { ! $_->manual_flag } $self->suspended_pkgs;
952 =item unsuspended_pkgs
954 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
959 sub unsuspended_pkgs {
961 grep { ! $_->susp } $self->ncancelled_pkgs;
966 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
967 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
968 on success or a list of errors.
974 grep { $_->unsuspend } $self->suspended_pkgs;
979 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
980 Always returns a list: an empty list on success or a list of errors.
986 grep { $_->suspend } $self->unsuspended_pkgs;
989 =item cancel [ OPTION => VALUE ... ]
991 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
993 Available options are: I<quiet>
995 I<quiet> can be set true to supress email cancellation notices.
997 Always returns a list: an empty list on success or a list of errors.
1003 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
1008 Returns the agent (see L<FS::agent>) for this customer.
1014 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1019 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1020 conjunction with the collect method.
1022 Options are passed as name-value pairs.
1024 Currently available options are:
1026 resetup - if set true, re-charges setup fees.
1028 time - bills the customer as if it were that time. Specified as a UNIX
1029 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1030 L<Date::Parse> for conversion functions. For example:
1034 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1037 If there is an error, returns the error, otherwise returns false.
1042 my( $self, %options ) = @_;
1043 my $time = $options{'time'} || time;
1048 local $SIG{HUP} = 'IGNORE';
1049 local $SIG{INT} = 'IGNORE';
1050 local $SIG{QUIT} = 'IGNORE';
1051 local $SIG{TERM} = 'IGNORE';
1052 local $SIG{TSTP} = 'IGNORE';
1053 local $SIG{PIPE} = 'IGNORE';
1055 my $oldAutoCommit = $FS::UID::AutoCommit;
1056 local $FS::UID::AutoCommit = 0;
1059 # find the packages which are due for billing, find out how much they are
1060 # & generate invoice database.
1062 my( $total_setup, $total_recur ) = ( 0, 0 );
1063 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1064 my @cust_bill_pkg = ();
1066 #my $taxable_charged = 0;##
1071 foreach my $cust_pkg (
1072 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1075 #NO!! next if $cust_pkg->cancel;
1076 next if $cust_pkg->getfield('cancel');
1078 #? to avoid use of uninitialized value errors... ?
1079 $cust_pkg->setfield('bill', '')
1080 unless defined($cust_pkg->bill);
1082 my $part_pkg = $cust_pkg->part_pkg;
1084 #so we don't modify cust_pkg record unnecessarily
1085 my $cust_pkg_mod_flag = 0;
1086 my %hash = $cust_pkg->hash;
1087 my $old_cust_pkg = new FS::cust_pkg \%hash;
1091 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1092 my $setup_prog = $part_pkg->getfield('setup');
1093 $setup_prog =~ /^(.*)$/ or do {
1094 $dbh->rollback if $oldAutoCommit;
1095 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1099 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1101 #my $cpt = new Safe;
1102 ##$cpt->permit(); #what is necessary?
1103 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1104 #$setup = $cpt->reval($setup_prog);
1105 $setup = eval $setup_prog;
1106 unless ( defined($setup) ) {
1107 $dbh->rollback if $oldAutoCommit;
1108 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1109 "(expression $setup_prog): $@";
1111 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1112 $cust_pkg_mod_flag=1;
1118 if ( $part_pkg->getfield('freq') ne '0' &&
1119 ! $cust_pkg->getfield('susp') &&
1120 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1122 my $recur_prog = $part_pkg->getfield('recur');
1123 $recur_prog =~ /^(.*)$/ or do {
1124 $dbh->rollback if $oldAutoCommit;
1125 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1129 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1131 # shared with $recur_prog
1132 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1134 #my $cpt = new Safe;
1135 ##$cpt->permit(); #what is necessary?
1136 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1137 #$recur = $cpt->reval($recur_prog);
1138 $recur = eval $recur_prog;
1139 unless ( defined($recur) ) {
1140 $dbh->rollback if $oldAutoCommit;
1141 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1142 "(expression $recur_prog): $@";
1144 #change this bit to use Date::Manip? CAREFUL with timezones (see
1145 # mailing list archive)
1146 my ($sec,$min,$hour,$mday,$mon,$year) =
1147 (localtime($sdate) )[0,1,2,3,4,5];
1149 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1150 # only for figuring next bill date, nothing else, so, reset $sdate again
1152 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1153 $cust_pkg->last_bill($sdate)
1154 if $cust_pkg->dbdef_table->column('last_bill');
1156 if ( $part_pkg->freq =~ /^\d+$/ ) {
1157 $mon += $part_pkg->freq;
1158 until ( $mon < 12 ) { $mon -= 12; $year++; }
1159 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1161 $mday += $weeks * 7;
1162 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1166 $dbh->rollback if $oldAutoCommit;
1167 return "unparsable frequency: ". $part_pkg->freq;
1169 $cust_pkg->setfield('bill',
1170 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1171 $cust_pkg_mod_flag = 1;
1174 warn "\$setup is undefined" unless defined($setup);
1175 warn "\$recur is undefined" unless defined($recur);
1176 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1178 if ( $cust_pkg_mod_flag ) {
1179 $error=$cust_pkg->replace($old_cust_pkg);
1180 if ( $error ) { #just in case
1181 $dbh->rollback if $oldAutoCommit;
1182 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1184 $setup = sprintf( "%.2f", $setup );
1185 $recur = sprintf( "%.2f", $recur );
1187 $dbh->rollback if $oldAutoCommit;
1188 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1191 $dbh->rollback if $oldAutoCommit;
1192 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1194 if ( $setup > 0 || $recur > 0 ) {
1195 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1196 'pkgnum' => $cust_pkg->pkgnum,
1200 'edate' => $cust_pkg->bill,
1202 push @cust_bill_pkg, $cust_bill_pkg;
1203 $total_setup += $setup;
1204 $total_recur += $recur;
1206 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1208 my @taxes = qsearch( 'cust_main_county', {
1209 'state' => $self->state,
1210 'county' => $self->county,
1211 'country' => $self->country,
1212 'taxclass' => $part_pkg->taxclass,
1215 @taxes = qsearch( 'cust_main_county', {
1216 'state' => $self->state,
1217 'county' => $self->county,
1218 'country' => $self->country,
1223 #one more try at a whole-country tax rate
1225 @taxes = qsearch( 'cust_main_county', {
1228 'country' => $self->country,
1233 # maybe eliminate this entirely, along with all the 0% records
1235 $dbh->rollback if $oldAutoCommit;
1237 "fatal: can't find tax rate for state/county/country/taxclass ".
1238 join('/', ( map $self->$_(), qw(state county country) ),
1239 $part_pkg->taxclass ). "\n";
1242 foreach my $tax ( @taxes ) {
1244 my $taxable_charged = 0;
1245 $taxable_charged += $setup
1246 unless $part_pkg->setuptax =~ /^Y$/i
1247 || $tax->setuptax =~ /^Y$/i;
1248 $taxable_charged += $recur
1249 unless $part_pkg->recurtax =~ /^Y$/i
1250 || $tax->recurtax =~ /^Y$/i;
1251 next unless $taxable_charged;
1253 if ( $tax->exempt_amount > 0 ) {
1254 my ($mon,$year) = (localtime($sdate) )[4,5];
1256 my $freq = $part_pkg->freq || 1;
1257 if ( $freq !~ /(\d+)$/ ) {
1258 $dbh->rollback if $oldAutoCommit;
1259 return "daily/weekly package definitions not (yet?)".
1260 " compatible with monthly tax exemptions";
1262 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1263 foreach my $which_month ( 1 .. $freq ) {
1265 'custnum' => $self->custnum,
1266 'taxnum' => $tax->taxnum,
1267 'year' => 1900+$year,
1270 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1271 until ( $mon < 13 ) { $mon -= 12; $year++; }
1272 my $cust_tax_exempt =
1273 qsearchs('cust_tax_exempt', \%hash)
1274 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1275 my $remaining_exemption = sprintf("%.2f",
1276 $tax->exempt_amount - $cust_tax_exempt->amount );
1277 if ( $remaining_exemption > 0 ) {
1278 my $addl = $remaining_exemption > $taxable_per_month
1279 ? $taxable_per_month
1280 : $remaining_exemption;
1281 $taxable_charged -= $addl;
1282 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1283 $cust_tax_exempt->hash,
1285 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1287 $error = $new_cust_tax_exempt->exemptnum
1288 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1289 : $new_cust_tax_exempt->insert;
1291 $dbh->rollback if $oldAutoCommit;
1292 return "fatal: can't update cust_tax_exempt: $error";
1295 } # if $remaining_exemption > 0
1297 } #foreach $which_month
1299 } #if $tax->exempt_amount
1301 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1303 #$tax += $taxable_charged * $cust_main_county->tax / 100
1304 $tax{ $tax->taxname || 'Tax' } +=
1305 $taxable_charged * $tax->tax / 100
1307 } #foreach my $tax ( @taxes )
1309 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1311 } #if $setup > 0 || $recur > 0
1313 } #if $cust_pkg_mod_flag
1315 } #foreach my $cust_pkg
1317 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1318 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1320 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1321 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1325 # unless ( $self->tax =~ /Y/i
1326 # || $self->payby eq 'COMP'
1327 # || $taxable_charged == 0 ) {
1328 # my $cust_main_county = qsearchs('cust_main_county',{
1329 # 'state' => $self->state,
1330 # 'county' => $self->county,
1331 # 'country' => $self->country,
1332 # } ) or die "fatal: can't find tax rate for state/county/country ".
1333 # $self->state. "/". $self->county. "/". $self->country. "\n";
1334 # my $tax = sprintf( "%.2f",
1335 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1338 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1340 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1341 my $tax = sprintf("%.2f", $tax{$taxname} );
1342 $charged = sprintf( "%.2f", $charged+$tax );
1344 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1350 'itemdesc' => $taxname,
1352 push @cust_bill_pkg, $cust_bill_pkg;
1355 } else { #1.4 schema
1358 foreach ( values %tax ) { $tax += $_ };
1359 $tax = sprintf("%.2f", $tax);
1361 $charged = sprintf( "%.2f", $charged+$tax );
1363 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1370 push @cust_bill_pkg, $cust_bill_pkg;
1375 my $cust_bill = new FS::cust_bill ( {
1376 'custnum' => $self->custnum,
1378 'charged' => $charged,
1380 $error = $cust_bill->insert;
1382 $dbh->rollback if $oldAutoCommit;
1383 return "can't create invoice for customer #". $self->custnum. ": $error";
1386 my $invnum = $cust_bill->invnum;
1388 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1390 $cust_bill_pkg->invnum($invnum);
1391 $error = $cust_bill_pkg->insert;
1393 $dbh->rollback if $oldAutoCommit;
1394 return "can't create invoice line item for customer #". $self->custnum.
1399 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1403 =item collect OPTIONS
1405 (Attempt to) collect money for this customer's outstanding invoices (see
1406 L<FS::cust_bill>). Usually used after the bill method.
1408 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1409 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1411 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1412 and the invoice events web interface.
1414 If there is an error, returns the error, otherwise returns false.
1416 Options are passed as name-value pairs.
1418 Currently available options are:
1420 invoice_time - Use this time when deciding when to print invoices and
1421 late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
1422 for conversion functions.
1424 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1427 retry_card - Deprecated alias for 'retry'
1429 batch_card - This option is deprecated. See the invoice events web interface
1430 to control whether cards are batched or run against a realtime gateway.
1432 report_badcard - This option is deprecated.
1434 force_print - This option is deprecated; see the invoice events web interface.
1436 quiet - set true to surpress email card/ACH decline notices.
1441 my( $self, %options ) = @_;
1442 my $invoice_time = $options{'invoice_time'} || time;
1445 local $SIG{HUP} = 'IGNORE';
1446 local $SIG{INT} = 'IGNORE';
1447 local $SIG{QUIT} = 'IGNORE';
1448 local $SIG{TERM} = 'IGNORE';
1449 local $SIG{TSTP} = 'IGNORE';
1450 local $SIG{PIPE} = 'IGNORE';
1452 my $oldAutoCommit = $FS::UID::AutoCommit;
1453 local $FS::UID::AutoCommit = 0;
1456 my $balance = $self->balance;
1457 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1458 unless ( $balance > 0 ) { #redundant?????
1459 $dbh->rollback if $oldAutoCommit; #hmm
1463 if ( exists($options{'retry_card'}) ) {
1464 carp 'retry_card option passed to collect is deprecated; use retry';
1465 $options{'retry'} ||= $options{'retry_card'};
1467 if ( exists($options{'retry'}) && $options{'retry'} ) {
1468 my $error = $self->retry_realtime;
1470 $dbh->rollback if $oldAutoCommit;
1475 foreach my $cust_bill ( $self->open_cust_bill ) {
1477 # don't try to charge for the same invoice if it's already in a batch
1478 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1480 last if $self->balance <= 0;
1482 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1485 foreach my $part_bill_event (
1486 sort { $a->seconds <=> $b->seconds
1487 || $a->weight <=> $b->weight
1488 || $a->eventpart <=> $b->eventpart }
1489 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1490 && ! qsearchs( 'cust_bill_event', {
1491 'invnum' => $cust_bill->invnum,
1492 'eventpart' => $_->eventpart,
1496 qsearch('part_bill_event', { 'payby' => $self->payby,
1497 'disabled' => '', } )
1500 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1501 || $self->balance <= 0; # or if balance<=0
1503 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1505 my $cust_main = $self; #for callback
1509 #supress "used only once" warning
1510 $FS::cust_bill::realtime_bop_decline_quiet += 0;
1511 local $FS::cust_bill::realtime_bop_decline_quiet = 1
1512 if $options{'quiet'};
1513 $error = eval $part_bill_event->eventcode;
1517 my $statustext = '';
1521 } elsif ( $error ) {
1523 $statustext = $error;
1528 #add cust_bill_event
1529 my $cust_bill_event = new FS::cust_bill_event {
1530 'invnum' => $cust_bill->invnum,
1531 'eventpart' => $part_bill_event->eventpart,
1532 #'_date' => $invoice_time,
1534 'status' => $status,
1535 'statustext' => $statustext,
1537 $error = $cust_bill_event->insert;
1539 #$dbh->rollback if $oldAutoCommit;
1540 #return "error: $error";
1542 # gah, even with transactions.
1543 $dbh->commit if $oldAutoCommit; #well.
1544 my $e = 'WARNING: Event run but database not updated - '.
1545 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1546 ', eventpart '. $part_bill_event->eventpart.
1557 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1562 =item retry_realtime
1564 Schedules realtime credit card / electronic check / LEC billing events for
1565 for retry. Useful if card information has changed or manual retry is desired.
1566 The 'collect' method must be called to actually retry the transaction.
1568 Implementation details: For each of this customer's open invoices, changes
1569 the status of the first "done" (with statustext error) realtime processing
1574 sub retry_realtime {
1577 local $SIG{HUP} = 'IGNORE';
1578 local $SIG{INT} = 'IGNORE';
1579 local $SIG{QUIT} = 'IGNORE';
1580 local $SIG{TERM} = 'IGNORE';
1581 local $SIG{TSTP} = 'IGNORE';
1582 local $SIG{PIPE} = 'IGNORE';
1584 my $oldAutoCommit = $FS::UID::AutoCommit;
1585 local $FS::UID::AutoCommit = 0;
1588 foreach my $cust_bill (
1589 grep { $_->cust_bill_event }
1590 $self->open_cust_bill
1592 my @cust_bill_event =
1593 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1595 #$_->part_bill_event->plan eq 'realtime-card'
1596 $_->part_bill_event->eventcode =~
1597 /\$cust_bill\->realtime_(card|ach|lec)/
1598 && $_->status eq 'done'
1601 $cust_bill->cust_bill_event;
1602 next unless @cust_bill_event;
1603 my $error = $cust_bill_event[0]->retry;
1605 $dbh->rollback if $oldAutoCommit;
1606 return "error scheduling invoice event for retry: $error";
1611 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1618 Returns the total owed for this customer on all invoices
1619 (see L<FS::cust_bill/owed>).
1625 $self->total_owed_date(2145859200); #12/31/2037
1628 =item total_owed_date TIME
1630 Returns the total owed for this customer on all invoices with date earlier than
1631 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1632 see L<Time::Local> and L<Date::Parse> for conversion functions.
1636 sub total_owed_date {
1640 foreach my $cust_bill (
1641 grep { $_->_date <= $time }
1642 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1644 $total_bill += $cust_bill->owed;
1646 sprintf( "%.2f", $total_bill );
1651 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1652 to outstanding invoice balances in chronological order and returns the value
1653 of any remaining unapplied credits available for refund
1654 (see L<FS::cust_refund>).
1661 return 0 unless $self->total_credited;
1663 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1664 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1666 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1667 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1671 foreach my $cust_bill ( @invoices ) {
1674 if ( !defined($credit) || $credit->credited == 0) {
1675 $credit = pop @credits or last;
1678 if ($cust_bill->owed >= $credit->credited) {
1679 $amount=$credit->credited;
1681 $amount=$cust_bill->owed;
1684 my $cust_credit_bill = new FS::cust_credit_bill ( {
1685 'crednum' => $credit->crednum,
1686 'invnum' => $cust_bill->invnum,
1687 'amount' => $amount,
1689 my $error = $cust_credit_bill->insert;
1690 die $error if $error;
1692 redo if ($cust_bill->owed > 0);
1696 return $self->total_credited;
1699 =item apply_payments
1701 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1702 to outstanding invoice balances in chronological order.
1704 #and returns the value of any remaining unapplied payments.
1708 sub apply_payments {
1713 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1714 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1716 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1717 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1721 foreach my $cust_bill ( @invoices ) {
1724 if ( !defined($payment) || $payment->unapplied == 0 ) {
1725 $payment = pop @payments or last;
1728 if ( $cust_bill->owed >= $payment->unapplied ) {
1729 $amount = $payment->unapplied;
1731 $amount = $cust_bill->owed;
1734 my $cust_bill_pay = new FS::cust_bill_pay ( {
1735 'paynum' => $payment->paynum,
1736 'invnum' => $cust_bill->invnum,
1737 'amount' => $amount,
1739 my $error = $cust_bill_pay->insert;
1740 die $error if $error;
1742 redo if ( $cust_bill->owed > 0);
1746 return $self->total_unapplied_payments;
1749 =item total_credited
1751 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1752 customer. See L<FS::cust_credit/credited>.
1756 sub total_credited {
1758 my $total_credit = 0;
1759 foreach my $cust_credit ( qsearch('cust_credit', {
1760 'custnum' => $self->custnum,
1762 $total_credit += $cust_credit->credited;
1764 sprintf( "%.2f", $total_credit );
1767 =item total_unapplied_payments
1769 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1770 See L<FS::cust_pay/unapplied>.
1774 sub total_unapplied_payments {
1776 my $total_unapplied = 0;
1777 foreach my $cust_pay ( qsearch('cust_pay', {
1778 'custnum' => $self->custnum,
1780 $total_unapplied += $cust_pay->unapplied;
1782 sprintf( "%.2f", $total_unapplied );
1787 Returns the balance for this customer (total_owed minus total_credited
1788 minus total_unapplied_payments).
1795 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1799 =item balance_date TIME
1801 Returns the balance for this customer, only considering invoices with date
1802 earlier than TIME (total_owed_date minus total_credited minus
1803 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1804 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1813 $self->total_owed_date($time)
1814 - $self->total_credited
1815 - $self->total_unapplied_payments
1819 =item invoicing_list [ ARRAYREF ]
1821 If an arguement is given, sets these email addresses as invoice recipients
1822 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1823 (except as warnings), so use check_invoicing_list first.
1825 Returns a list of email addresses (with svcnum entries expanded).
1827 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1828 check it without disturbing anything by passing nothing.
1830 This interface may change in the future.
1834 sub invoicing_list {
1835 my( $self, $arrayref ) = @_;
1837 my @cust_main_invoice;
1838 if ( $self->custnum ) {
1839 @cust_main_invoice =
1840 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1842 @cust_main_invoice = ();
1844 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1845 #warn $cust_main_invoice->destnum;
1846 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1847 #warn $cust_main_invoice->destnum;
1848 my $error = $cust_main_invoice->delete;
1849 warn $error if $error;
1852 if ( $self->custnum ) {
1853 @cust_main_invoice =
1854 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1856 @cust_main_invoice = ();
1858 my %seen = map { $_->address => 1 } @cust_main_invoice;
1859 foreach my $address ( @{$arrayref} ) {
1860 next if exists $seen{$address} && $seen{$address};
1861 $seen{$address} = 1;
1862 my $cust_main_invoice = new FS::cust_main_invoice ( {
1863 'custnum' => $self->custnum,
1866 my $error = $cust_main_invoice->insert;
1867 warn $error if $error;
1870 if ( $self->custnum ) {
1872 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1878 =item check_invoicing_list ARRAYREF
1880 Checks these arguements as valid input for the invoicing_list method. If there
1881 is an error, returns the error, otherwise returns false.
1885 sub check_invoicing_list {
1886 my( $self, $arrayref ) = @_;
1887 foreach my $address ( @{$arrayref} ) {
1888 my $cust_main_invoice = new FS::cust_main_invoice ( {
1889 'custnum' => $self->custnum,
1892 my $error = $self->custnum
1893 ? $cust_main_invoice->check
1894 : $cust_main_invoice->checkdest
1896 return $error if $error;
1901 =item set_default_invoicing_list
1903 Sets the invoicing list to all accounts associated with this customer,
1904 overwriting any previous invoicing list.
1908 sub set_default_invoicing_list {
1910 $self->invoicing_list($self->all_emails);
1915 Returns the email addresses of all accounts provisioned for this customer.
1922 foreach my $cust_pkg ( $self->all_pkgs ) {
1923 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1925 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1926 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1928 $list{$_}=1 foreach map { $_->email } @svc_acct;
1933 =item invoicing_list_addpost
1935 Adds postal invoicing to this customer. If this customer is already configured
1936 to receive postal invoices, does nothing.
1940 sub invoicing_list_addpost {
1942 return if grep { $_ eq 'POST' } $self->invoicing_list;
1943 my @invoicing_list = $self->invoicing_list;
1944 push @invoicing_list, 'POST';
1945 $self->invoicing_list(\@invoicing_list);
1948 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1950 Returns an array of customers referred by this customer (referral_custnum set
1951 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1952 customers referred by customers referred by this customer and so on, inclusive.
1953 The default behavior is DEPTH 1 (no recursion).
1957 sub referral_cust_main {
1959 my $depth = @_ ? shift : 1;
1960 my $exclude = @_ ? shift : {};
1963 map { $exclude->{$_->custnum}++; $_; }
1964 grep { ! $exclude->{ $_->custnum } }
1965 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1969 map { $_->referral_cust_main($depth-1, $exclude) }
1976 =item referral_cust_main_ncancelled
1978 Same as referral_cust_main, except only returns customers with uncancelled
1983 sub referral_cust_main_ncancelled {
1985 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1988 =item referral_cust_pkg [ DEPTH ]
1990 Like referral_cust_main, except returns a flat list of all unsuspended (and
1991 uncancelled) packages for each customer. The number of items in this list may
1992 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1996 sub referral_cust_pkg {
1998 my $depth = @_ ? shift : 1;
2000 map { $_->unsuspended_pkgs }
2001 grep { $_->unsuspended_pkgs }
2002 $self->referral_cust_main($depth);
2005 =item credit AMOUNT, REASON
2007 Applies a credit to this customer. If there is an error, returns the error,
2008 otherwise returns false.
2013 my( $self, $amount, $reason ) = @_;
2014 my $cust_credit = new FS::cust_credit {
2015 'custnum' => $self->custnum,
2016 'amount' => $amount,
2017 'reason' => $reason,
2019 $cust_credit->insert;
2022 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2024 Creates a one-time charge for this customer. If there is an error, returns
2025 the error, otherwise returns false.
2030 my ( $self, $amount ) = ( shift, shift );
2031 my $pkg = @_ ? shift : 'One-time charge';
2032 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2033 my $taxclass = @_ ? shift : '';
2035 local $SIG{HUP} = 'IGNORE';
2036 local $SIG{INT} = 'IGNORE';
2037 local $SIG{QUIT} = 'IGNORE';
2038 local $SIG{TERM} = 'IGNORE';
2039 local $SIG{TSTP} = 'IGNORE';
2040 local $SIG{PIPE} = 'IGNORE';
2042 my $oldAutoCommit = $FS::UID::AutoCommit;
2043 local $FS::UID::AutoCommit = 0;
2046 my $part_pkg = new FS::part_pkg ( {
2048 'comment' => $comment,
2053 'taxclass' => $taxclass,
2056 my $error = $part_pkg->insert;
2058 $dbh->rollback if $oldAutoCommit;
2062 my $pkgpart = $part_pkg->pkgpart;
2063 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2064 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2065 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2066 $error = $type_pkgs->insert;
2068 $dbh->rollback if $oldAutoCommit;
2073 my $cust_pkg = new FS::cust_pkg ( {
2074 'custnum' => $self->custnum,
2075 'pkgpart' => $pkgpart,
2078 $error = $cust_pkg->insert;
2080 $dbh->rollback if $oldAutoCommit;
2084 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2091 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2097 sort { $a->_date <=> $b->_date }
2098 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2101 =item open_cust_bill
2103 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2108 sub open_cust_bill {
2110 grep { $_->owed > 0 } $self->cust_bill;
2115 Returns all the credits (see L<FS::cust_credit>) for this customer.
2121 sort { $a->_date <=> $b->_date }
2122 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2127 Returns all the payments (see L<FS::cust_pay>) for this customer.
2133 sort { $a->_date <=> $b->_date }
2134 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2139 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2145 sort { $a->_date <=> $b->_date }
2146 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2155 =item check_and_rebuild_fuzzyfiles
2159 sub check_and_rebuild_fuzzyfiles {
2160 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2161 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2162 or &rebuild_fuzzyfiles;
2165 =item rebuild_fuzzyfiles
2169 sub rebuild_fuzzyfiles {
2171 use Fcntl qw(:flock);
2173 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2177 open(LASTLOCK,">>$dir/cust_main.last")
2178 or die "can't open $dir/cust_main.last: $!";
2179 flock(LASTLOCK,LOCK_EX)
2180 or die "can't lock $dir/cust_main.last: $!";
2182 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2184 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2185 if defined dbdef->table('cust_main')->column('ship_last');
2187 open (LASTCACHE,">$dir/cust_main.last.tmp")
2188 or die "can't open $dir/cust_main.last.tmp: $!";
2189 print LASTCACHE join("\n", @all_last), "\n";
2190 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2192 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2197 open(COMPANYLOCK,">>$dir/cust_main.company")
2198 or die "can't open $dir/cust_main.company: $!";
2199 flock(COMPANYLOCK,LOCK_EX)
2200 or die "can't lock $dir/cust_main.company: $!";
2202 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2204 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2205 if defined dbdef->table('cust_main')->column('ship_last');
2207 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2208 or die "can't open $dir/cust_main.company.tmp: $!";
2209 print COMPANYCACHE join("\n", @all_company), "\n";
2210 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2212 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2222 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2223 open(LASTCACHE,"<$dir/cust_main.last")
2224 or die "can't open $dir/cust_main.last: $!";
2225 my @array = map { chomp; $_; } <LASTCACHE>;
2235 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2236 open(COMPANYCACHE,"<$dir/cust_main.company")
2237 or die "can't open $dir/cust_main.last: $!";
2238 my @array = map { chomp; $_; } <COMPANYCACHE>;
2243 =item append_fuzzyfiles LASTNAME COMPANY
2247 sub append_fuzzyfiles {
2248 my( $last, $company ) = @_;
2250 &check_and_rebuild_fuzzyfiles;
2252 use Fcntl qw(:flock);
2254 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2258 open(LAST,">>$dir/cust_main.last")
2259 or die "can't open $dir/cust_main.last: $!";
2261 or die "can't lock $dir/cust_main.last: $!";
2263 print LAST "$last\n";
2266 or die "can't unlock $dir/cust_main.last: $!";
2272 open(COMPANY,">>$dir/cust_main.company")
2273 or die "can't open $dir/cust_main.company: $!";
2274 flock(COMPANY,LOCK_EX)
2275 or die "can't lock $dir/cust_main.company: $!";
2277 print COMPANY "$company\n";
2279 flock(COMPANY,LOCK_UN)
2280 or die "can't unlock $dir/cust_main.company: $!";
2294 #warn join('-',keys %$param);
2295 my $fh = $param->{filehandle};
2296 my $agentnum = $param->{agentnum};
2297 my $refnum = $param->{refnum};
2298 my $pkgpart = $param->{pkgpart};
2299 my @fields = @{$param->{fields}};
2301 eval "use Date::Parse;";
2303 eval "use Text::CSV_XS;";
2306 my $csv = new Text::CSV_XS;
2313 local $SIG{HUP} = 'IGNORE';
2314 local $SIG{INT} = 'IGNORE';
2315 local $SIG{QUIT} = 'IGNORE';
2316 local $SIG{TERM} = 'IGNORE';
2317 local $SIG{TSTP} = 'IGNORE';
2318 local $SIG{PIPE} = 'IGNORE';
2320 my $oldAutoCommit = $FS::UID::AutoCommit;
2321 local $FS::UID::AutoCommit = 0;
2324 #while ( $columns = $csv->getline($fh) ) {
2326 while ( defined($line=<$fh>) ) {
2328 $csv->parse($line) or do {
2329 $dbh->rollback if $oldAutoCommit;
2330 return "can't parse: ". $csv->error_input();
2333 my @columns = $csv->fields();
2334 #warn join('-',@columns);
2337 agentnum => $agentnum,
2339 country => 'US', #default
2340 payby => 'BILL', #default
2341 paydate => '12/2037', #default
2343 my $billtime = time;
2344 my %cust_pkg = ( pkgpart => $pkgpart );
2345 foreach my $field ( @fields ) {
2346 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2347 #$cust_pkg{$1} = str2time( shift @$columns );
2348 if ( $1 eq 'setup' ) {
2349 $billtime = str2time(shift @columns);
2351 $cust_pkg{$1} = str2time( shift @columns );
2354 #$cust_main{$field} = shift @$columns;
2355 $cust_main{$field} = shift @columns;
2359 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2360 my $cust_main = new FS::cust_main ( \%cust_main );
2362 tie my %hash, 'Tie::RefHash'; #this part is important
2363 $hash{$cust_pkg} = [] if $pkgpart;
2364 my $error = $cust_main->insert( \%hash );
2367 $dbh->rollback if $oldAutoCommit;
2368 return "can't insert customer for $line: $error";
2371 #false laziness w/bill.cgi
2372 $error = $cust_main->bill( 'time' => $billtime );
2374 $dbh->rollback if $oldAutoCommit;
2375 return "can't bill customer for $line: $error";
2378 $cust_main->apply_payments;
2379 $cust_main->apply_credits;
2381 $error = $cust_main->collect();
2383 $dbh->rollback if $oldAutoCommit;
2384 return "can't collect customer for $line: $error";
2390 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2392 return "Empty file!" unless $imported;
2404 #warn join('-',keys %$param);
2405 my $fh = $param->{filehandle};
2406 my @fields = @{$param->{fields}};
2408 eval "use Date::Parse;";
2410 eval "use Text::CSV_XS;";
2413 my $csv = new Text::CSV_XS;
2420 local $SIG{HUP} = 'IGNORE';
2421 local $SIG{INT} = 'IGNORE';
2422 local $SIG{QUIT} = 'IGNORE';
2423 local $SIG{TERM} = 'IGNORE';
2424 local $SIG{TSTP} = 'IGNORE';
2425 local $SIG{PIPE} = 'IGNORE';
2427 my $oldAutoCommit = $FS::UID::AutoCommit;
2428 local $FS::UID::AutoCommit = 0;
2431 #while ( $columns = $csv->getline($fh) ) {
2433 while ( defined($line=<$fh>) ) {
2435 $csv->parse($line) or do {
2436 $dbh->rollback if $oldAutoCommit;
2437 return "can't parse: ". $csv->error_input();
2440 my @columns = $csv->fields();
2441 #warn join('-',@columns);
2444 foreach my $field ( @fields ) {
2445 $row{$field} = shift @columns;
2448 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2449 unless ( $cust_main ) {
2450 $dbh->rollback if $oldAutoCommit;
2451 return "unknown custnum $row{'custnum'}";
2454 if ( $row{'amount'} > 0 ) {
2455 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2457 $dbh->rollback if $oldAutoCommit;
2461 } elsif ( $row{'amount'} < 0 ) {
2462 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2465 $dbh->rollback if $oldAutoCommit;
2475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2477 return "Empty file!" unless $imported;
2489 The delete method should possibly take an FS::cust_main object reference
2490 instead of a scalar customer number.
2492 Bill and collect options should probably be passed as references instead of a
2495 There should probably be a configuration file with a list of allowed credit
2498 No multiple currency support (probably a larger project than just this module).
2502 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2503 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2504 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.