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;
23 use FS::part_referral;
24 use FS::cust_main_county;
26 use FS::cust_main_invoice;
27 use FS::cust_credit_bill;
28 use FS::cust_bill_pay;
29 use FS::prepay_credit;
32 use FS::part_bill_event;
33 use FS::cust_bill_event;
34 use FS::cust_tax_exempt;
36 use FS::Msgcat qw(gettext);
38 @ISA = qw( FS::Record );
45 #ask FS::UID to run this stuff for us later
46 $FS::UID::callback{'FS::cust_main'} = sub {
48 #yes, need it for stuff below (prolly should be cached)
53 my ( $hashref, $cache ) = @_;
54 if ( exists $hashref->{'pkgnum'} ) {
55 # #@{ $self->{'_pkgnum'} } = ();
56 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
57 $self->{'_pkgnum'} = $subcache;
58 #push @{ $self->{'_pkgnum'} },
59 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
65 FS::cust_main - Object methods for cust_main records
71 $record = new FS::cust_main \%hash;
72 $record = new FS::cust_main { 'column' => 'value' };
74 $error = $record->insert;
76 $error = $new_record->replace($old_record);
78 $error = $record->delete;
80 $error = $record->check;
82 @cust_pkg = $record->all_pkgs;
84 @cust_pkg = $record->ncancelled_pkgs;
86 @cust_pkg = $record->suspended_pkgs;
88 $error = $record->bill;
89 $error = $record->bill %options;
90 $error = $record->bill 'time' => $time;
92 $error = $record->collect;
93 $error = $record->collect %options;
94 $error = $record->collect 'invoice_time' => $time,
95 'batch_card' => 'yes',
96 'report_badcard' => 'yes',
101 An FS::cust_main object represents a customer. FS::cust_main inherits from
102 FS::Record. The following fields are currently supported:
106 =item custnum - primary key (assigned automatically for new customers)
108 =item agentnum - agent (see L<FS::agent>)
110 =item refnum - Advertising source (see L<FS::part_referral>)
116 =item ss - social security number (optional)
118 =item company - (optional)
122 =item address2 - (optional)
126 =item county - (optional, see L<FS::cust_main_county>)
128 =item state - (see L<FS::cust_main_county>)
132 =item country - (see L<FS::cust_main_county>)
134 =item daytime - phone (optional)
136 =item night - phone (optional)
138 =item fax - phone (optional)
140 =item ship_first - name
142 =item ship_last - name
144 =item ship_company - (optional)
148 =item ship_address2 - (optional)
152 =item ship_county - (optional, see L<FS::cust_main_county>)
154 =item ship_state - (see L<FS::cust_main_county>)
158 =item ship_country - (see L<FS::cust_main_county>)
160 =item ship_daytime - phone (optional)
162 =item ship_night - phone (optional)
164 =item ship_fax - phone (optional)
166 =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)
168 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
170 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
172 =item payname - name on card or billing name
174 =item tax - tax exempt, empty or `Y'
176 =item otaker - order taker (assigned automatically, see L<FS::UID>)
178 =item comments - comments (optional)
188 Creates a new customer. To add the customer to the database, see L<"insert">.
190 Note that this stores the hash reference, not a distinct copy of the hash it
191 points to. You can ask the object for a copy with the I<hash> method.
195 sub table { 'cust_main'; }
197 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
199 Adds this customer to the database. If there is an error, returns the error,
200 otherwise returns false.
202 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
203 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
204 are inserted atomicly, or the transaction is rolled back. Passing an empty
205 hash reference is equivalent to not supplying this parameter. There should be
206 a better explanation of this, but until then, here's an example:
209 tie %hash, 'Tie::RefHash'; #this part is important
211 $cust_pkg => [ $svc_acct ],
214 $cust_main->insert( \%hash );
216 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
217 be set as the invoicing list (see L<"invoicing_list">). Errors return as
218 expected and rollback the entire transaction; it is not necessary to call
219 check_invoicing_list first. The invoicing_list is set after the records in the
220 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
221 invoicing_list destination to the newly-created svc_acct. Here's an example:
223 $cust_main->insert( {}, [ $email, 'POST' ] );
225 Currently available options are: I<noexport>
227 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
228 (You can schedule them later with the B<reexport> method.)
234 my $cust_pkgs = @_ ? shift : {};
235 my $invoicing_list = @_ ? shift : '';
238 local $SIG{HUP} = 'IGNORE';
239 local $SIG{INT} = 'IGNORE';
240 local $SIG{QUIT} = 'IGNORE';
241 local $SIG{TERM} = 'IGNORE';
242 local $SIG{TSTP} = 'IGNORE';
243 local $SIG{PIPE} = 'IGNORE';
245 my $oldAutoCommit = $FS::UID::AutoCommit;
246 local $FS::UID::AutoCommit = 0;
251 if ( $self->payby eq 'PREPAY' ) {
252 $self->payby('BILL');
253 my $prepay_credit = qsearchs(
255 { 'identifier' => $self->payinfo },
259 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
260 unless $prepay_credit;
261 $amount = $prepay_credit->amount;
262 $seconds = $prepay_credit->seconds;
263 my $error = $prepay_credit->delete;
265 $dbh->rollback if $oldAutoCommit;
266 return "removing prepay_credit (transaction rolled back): $error";
270 my $error = $self->SUPER::insert;
272 $dbh->rollback if $oldAutoCommit;
273 #return "inserting cust_main record (transaction rolled back): $error";
278 if ( $invoicing_list ) {
279 $error = $self->check_invoicing_list( $invoicing_list );
281 $dbh->rollback if $oldAutoCommit;
282 return "checking invoicing_list (transaction rolled back): $error";
284 $self->invoicing_list( $invoicing_list );
288 #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
289 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
291 $dbh->rollback if $oldAutoCommit;
296 $dbh->rollback if $oldAutoCommit;
297 return "No svc_acct record to apply pre-paid time";
301 my $cust_credit = new FS::cust_credit {
302 'custnum' => $self->custnum,
305 $error = $cust_credit->insert;
307 $dbh->rollback if $oldAutoCommit;
308 return "inserting credit (transaction rolled back): $error";
312 $error = $self->queue_fuzzyfiles_update;
314 $dbh->rollback if $oldAutoCommit;
315 return "updating fuzzy search cache: $error";
318 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
323 =item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
325 Like the insert method on an existing record, this method orders a package
326 and included services atomicaly. Pass a Tie::RefHash data structure to this
327 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
328 be a better explanation of this, but until then, here's an example:
331 tie %hash, 'Tie::RefHash'; #this part is important
333 $cust_pkg => [ $svc_acct ],
336 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
338 Currently available options are: I<noexport>
340 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
341 (You can schedule them later with the B<reexport> method for each
342 cust_pkg object. Using the B<reexport> method on the cust_main object is not
343 recommended, as existing services will also be reexported.)
349 my $cust_pkgs = shift;
353 local $SIG{HUP} = 'IGNORE';
354 local $SIG{INT} = 'IGNORE';
355 local $SIG{QUIT} = 'IGNORE';
356 local $SIG{TERM} = 'IGNORE';
357 local $SIG{TSTP} = 'IGNORE';
358 local $SIG{PIPE} = 'IGNORE';
360 my $oldAutoCommit = $FS::UID::AutoCommit;
361 local $FS::UID::AutoCommit = 0;
364 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
366 foreach my $cust_pkg ( keys %$cust_pkgs ) {
367 $cust_pkg->custnum( $self->custnum );
368 my $error = $cust_pkg->insert;
370 $dbh->rollback if $oldAutoCommit;
371 return "inserting cust_pkg (transaction rolled back): $error";
373 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
374 $svc_something->pkgnum( $cust_pkg->pkgnum );
375 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
376 $svc_something->seconds( $svc_something->seconds + $$seconds );
379 $error = $svc_something->insert;
381 $dbh->rollback if $oldAutoCommit;
382 #return "inserting svc_ (transaction rolled back): $error";
388 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
394 Re-schedules all exports by calling the B<reexport> method of all associated
395 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
396 otherwise returns false.
403 local $SIG{HUP} = 'IGNORE';
404 local $SIG{INT} = 'IGNORE';
405 local $SIG{QUIT} = 'IGNORE';
406 local $SIG{TERM} = 'IGNORE';
407 local $SIG{TSTP} = 'IGNORE';
408 local $SIG{PIPE} = 'IGNORE';
410 my $oldAutoCommit = $FS::UID::AutoCommit;
411 local $FS::UID::AutoCommit = 0;
414 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
415 my $error = $cust_pkg->reexport;
417 $dbh->rollback if $oldAutoCommit;
422 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
427 =item delete NEW_CUSTNUM
429 This deletes the customer. If there is an error, returns the error, otherwise
432 This will completely remove all traces of the customer record. This is not
433 what you want when a customer cancels service; for that, cancel all of the
434 customer's packages (see L</cancel>).
436 If the customer has any uncancelled packages, you need to pass a new (valid)
437 customer number for those packages to be transferred to. Cancelled packages
438 will be deleted. Did I mention that this is NOT what you want when a customer
439 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
441 You can't delete a customer with invoices (see L<FS::cust_bill>),
442 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
443 refunds (see L<FS::cust_refund>).
450 local $SIG{HUP} = 'IGNORE';
451 local $SIG{INT} = 'IGNORE';
452 local $SIG{QUIT} = 'IGNORE';
453 local $SIG{TERM} = 'IGNORE';
454 local $SIG{TSTP} = 'IGNORE';
455 local $SIG{PIPE} = 'IGNORE';
457 my $oldAutoCommit = $FS::UID::AutoCommit;
458 local $FS::UID::AutoCommit = 0;
461 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
462 $dbh->rollback if $oldAutoCommit;
463 return "Can't delete a customer with invoices";
465 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
466 $dbh->rollback if $oldAutoCommit;
467 return "Can't delete a customer with credits";
469 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
470 $dbh->rollback if $oldAutoCommit;
471 return "Can't delete a customer with payments";
473 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
474 $dbh->rollback if $oldAutoCommit;
475 return "Can't delete a customer with refunds";
478 my @cust_pkg = $self->ncancelled_pkgs;
480 my $new_custnum = shift;
481 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
482 $dbh->rollback if $oldAutoCommit;
483 return "Invalid new customer number: $new_custnum";
485 foreach my $cust_pkg ( @cust_pkg ) {
486 my %hash = $cust_pkg->hash;
487 $hash{'custnum'} = $new_custnum;
488 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
489 my $error = $new_cust_pkg->replace($cust_pkg);
491 $dbh->rollback if $oldAutoCommit;
496 my @cancelled_cust_pkg = $self->all_pkgs;
497 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
498 my $error = $cust_pkg->delete;
500 $dbh->rollback if $oldAutoCommit;
505 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
506 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
508 my $error = $cust_main_invoice->delete;
510 $dbh->rollback if $oldAutoCommit;
515 my $error = $self->SUPER::delete;
517 $dbh->rollback if $oldAutoCommit;
521 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
526 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
528 Replaces the OLD_RECORD with this one in the database. If there is an error,
529 returns the error, otherwise returns false.
531 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
532 be set as the invoicing list (see L<"invoicing_list">). Errors return as
533 expected and rollback the entire transaction; it is not necessary to call
534 check_invoicing_list first. Here's an example:
536 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
545 local $SIG{HUP} = 'IGNORE';
546 local $SIG{INT} = 'IGNORE';
547 local $SIG{QUIT} = 'IGNORE';
548 local $SIG{TERM} = 'IGNORE';
549 local $SIG{TSTP} = 'IGNORE';
550 local $SIG{PIPE} = 'IGNORE';
552 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
553 && $conf->config('users-allow_comp') ) {
554 return "You are not permitted to create complimentary accounts."
555 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
558 my $oldAutoCommit = $FS::UID::AutoCommit;
559 local $FS::UID::AutoCommit = 0;
562 my $error = $self->SUPER::replace($old);
565 $dbh->rollback if $oldAutoCommit;
569 if ( @param ) { # INVOICING_LIST_ARYREF
570 my $invoicing_list = shift @param;
571 $error = $self->check_invoicing_list( $invoicing_list );
573 $dbh->rollback if $oldAutoCommit;
576 $self->invoicing_list( $invoicing_list );
579 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
580 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
581 # card/check/lec info has changed, want to retry realtime_ invoice events
582 my $error = $self->retry_realtime;
584 $dbh->rollback if $oldAutoCommit;
589 $error = $self->queue_fuzzyfiles_update;
591 $dbh->rollback if $oldAutoCommit;
592 return "updating fuzzy search cache: $error";
595 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
600 =item queue_fuzzyfiles_update
602 Used by insert & replace to update the fuzzy search cache
606 sub queue_fuzzyfiles_update {
609 local $SIG{HUP} = 'IGNORE';
610 local $SIG{INT} = 'IGNORE';
611 local $SIG{QUIT} = 'IGNORE';
612 local $SIG{TERM} = 'IGNORE';
613 local $SIG{TSTP} = 'IGNORE';
614 local $SIG{PIPE} = 'IGNORE';
616 my $oldAutoCommit = $FS::UID::AutoCommit;
617 local $FS::UID::AutoCommit = 0;
620 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
621 my $error = $queue->insert($self->getfield('last'), $self->company);
623 $dbh->rollback if $oldAutoCommit;
624 return "queueing job (transaction rolled back): $error";
627 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
628 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
629 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
631 $dbh->rollback if $oldAutoCommit;
632 return "queueing job (transaction rolled back): $error";
636 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
643 Checks all fields to make sure this is a valid customer record. If there is
644 an error, returns the error, otherwise returns false. Called by the insert
652 #warn "BEFORE: \n". $self->_dump;
655 $self->ut_numbern('custnum')
656 || $self->ut_number('agentnum')
657 || $self->ut_number('refnum')
658 || $self->ut_name('last')
659 || $self->ut_name('first')
660 || $self->ut_textn('company')
661 || $self->ut_text('address1')
662 || $self->ut_textn('address2')
663 || $self->ut_text('city')
664 || $self->ut_textn('county')
665 || $self->ut_textn('state')
666 || $self->ut_country('country')
667 || $self->ut_anything('comments')
668 || $self->ut_numbern('referral_custnum')
670 #barf. need message catalogs. i18n. etc.
671 $error .= "Please select an advertising source."
672 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
673 return $error if $error;
675 return "Unknown agent"
676 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
678 return "Unknown refnum"
679 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
681 return "Unknown referring custnum ". $self->referral_custnum
682 unless ! $self->referral_custnum
683 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
685 if ( $self->ss eq '' ) {
690 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
691 or return "Illegal social security number: ". $self->ss;
692 $self->ss("$1-$2-$3");
696 # bad idea to disable, causes billing to fail because of no tax rates later
697 # unless ( $import ) {
698 unless ( qsearch('cust_main_county', {
699 'country' => $self->country,
702 return "Unknown state/county/country: ".
703 $self->state. "/". $self->county. "/". $self->country
704 unless qsearch('cust_main_county',{
705 'state' => $self->state,
706 'county' => $self->county,
707 'country' => $self->country,
713 $self->ut_phonen('daytime', $self->country)
714 || $self->ut_phonen('night', $self->country)
715 || $self->ut_phonen('fax', $self->country)
716 || $self->ut_zip('zip', $self->country)
718 return $error if $error;
721 last first company address1 address2 city county state zip
722 country daytime night fax
725 if ( defined $self->dbdef_table->column('ship_last') ) {
726 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
728 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
732 $self->ut_name('ship_last')
733 || $self->ut_name('ship_first')
734 || $self->ut_textn('ship_company')
735 || $self->ut_text('ship_address1')
736 || $self->ut_textn('ship_address2')
737 || $self->ut_text('ship_city')
738 || $self->ut_textn('ship_county')
739 || $self->ut_textn('ship_state')
740 || $self->ut_country('ship_country')
742 return $error if $error;
744 #false laziness with above
745 unless ( qsearchs('cust_main_county', {
746 'country' => $self->ship_country,
749 return "Unknown ship_state/ship_county/ship_country: ".
750 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
751 unless qsearchs('cust_main_county',{
752 'state' => $self->ship_state,
753 'county' => $self->ship_county,
754 'country' => $self->ship_country,
760 $self->ut_phonen('ship_daytime', $self->ship_country)
761 || $self->ut_phonen('ship_night', $self->ship_country)
762 || $self->ut_phonen('ship_fax', $self->ship_country)
763 || $self->ut_zip('ship_zip', $self->ship_country)
765 return $error if $error;
767 } else { # ship_ info eq billing info, so don't store dup info in database
768 $self->setfield("ship_$_", '')
769 foreach qw( last first company address1 address2 city county state zip
770 country daytime night fax );
774 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
775 or return "Illegal payby: ". $self->payby;
778 if ( $self->payby eq 'CARD' ) {
780 my $payinfo = $self->payinfo;
782 $payinfo =~ /^(\d{13,16})$/
783 or return gettext('invalid_card'); # . ": ". $self->payinfo;
785 $self->payinfo($payinfo);
787 or return gettext('invalid_card'); # . ": ". $self->payinfo;
788 return gettext('unknown_card_type')
789 if cardtype($self->payinfo) eq "Unknown";
790 if ( defined $self->dbdef_table->column('paycvv') ) {
791 if ( length($self->paycvv) ) {
792 if ( cardtype($self->payinfo) eq 'American Express card' ) {
793 $self->paycvv =~ /^(\d{4})$/
794 or return "CVV2 (CID) for American Express cards is four digits.";
797 $self->paycvv =~ /^(\d{3})$/
798 or return "CVV2 (CVC2/CID) is three digits.";
806 } elsif ( $self->payby eq 'CHEK' ) {
808 my $payinfo = $self->payinfo;
809 $payinfo =~ s/[^\d\@]//g;
810 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
812 $self->payinfo($payinfo);
813 $self->paycvv('') if $self->dbdef_table->column('paycvv');
815 } elsif ( $self->payby eq 'LECB' ) {
817 my $payinfo = $self->payinfo;
819 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
821 $self->payinfo($payinfo);
822 $self->paycvv('') if $self->dbdef_table->column('paycvv');
824 } elsif ( $self->payby eq 'BILL' ) {
826 $error = $self->ut_textn('payinfo');
827 return "Illegal P.O. number: ". $self->payinfo if $error;
828 $self->paycvv('') if $self->dbdef_table->column('paycvv');
830 } elsif ( $self->payby eq 'COMP' ) {
832 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
833 return "You are not permitted to create complimentary accounts."
834 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
837 $error = $self->ut_textn('payinfo');
838 return "Illegal comp account issuer: ". $self->payinfo if $error;
839 $self->paycvv('') if $self->dbdef_table->column('paycvv');
841 } elsif ( $self->payby eq 'PREPAY' ) {
843 my $payinfo = $self->payinfo;
844 $payinfo =~ s/\W//g; #anything else would just confuse things
845 $self->payinfo($payinfo);
846 $error = $self->ut_alpha('payinfo');
847 return "Illegal prepayment identifier: ". $self->payinfo if $error;
848 return "Unknown prepayment identifier"
849 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
850 $self->paycvv('') if $self->dbdef_table->column('paycvv');
854 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
855 return "Expriation date required"
856 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
859 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
860 or return "Illegal expiration date: ". $self->paydate;
861 my $y = length($2) == 4 ? $2 : "20$2";
862 $self->paydate("$y-$1-01");
863 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
864 return gettext('expired_card')
865 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
868 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
869 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
870 $self->payname( $self->first. " ". $self->getfield('last') );
872 $self->payname =~ /^([\w \,\.\-\']+)$/
873 or return gettext('illegal_name'). " payname: ". $self->payname;
877 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
880 $self->otaker(getotaker) unless $self->otaker;
882 #warn "AFTER: \n". $self->_dump;
889 Returns all packages (see L<FS::cust_pkg>) for this customer.
895 if ( $self->{'_pkgnum'} ) {
896 values %{ $self->{'_pkgnum'}->cache };
898 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
902 =item ncancelled_pkgs
904 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
908 sub ncancelled_pkgs {
910 if ( $self->{'_pkgnum'} ) {
911 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
913 @{ [ # force list context
914 qsearch( 'cust_pkg', {
915 'custnum' => $self->custnum,
918 qsearch( 'cust_pkg', {
919 'custnum' => $self->custnum,
928 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
934 grep { $_->susp } $self->ncancelled_pkgs;
937 =item unflagged_suspended_pkgs
939 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
940 customer (thouse packages without the `manual_flag' set).
944 sub unflagged_suspended_pkgs {
946 return $self->suspended_pkgs
947 unless dbdef->table('cust_pkg')->column('manual_flag');
948 grep { ! $_->manual_flag } $self->suspended_pkgs;
951 =item unsuspended_pkgs
953 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
958 sub unsuspended_pkgs {
960 grep { ! $_->susp } $self->ncancelled_pkgs;
965 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
966 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
967 on success or a list of errors.
973 grep { $_->unsuspend } $self->suspended_pkgs;
978 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
979 Always returns a list: an empty list on success or a list of errors.
985 grep { $_->suspend } $self->unsuspended_pkgs;
988 =item cancel [ OPTION => VALUE ... ]
990 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
992 Available options are: I<quiet>
994 I<quiet> can be set true to supress email cancellation notices.
996 Always returns a list: an empty list on success or a list of errors.
1002 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
1007 Returns the agent (see L<FS::agent>) for this customer.
1013 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1018 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1019 conjunction with the collect method.
1021 Options are passed as name-value pairs.
1023 Currently available options are:
1025 resetup - if set true, re-charges setup fees.
1027 time - bills the customer as if it were that time. Specified as a UNIX
1028 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1029 L<Date::Parse> for conversion functions. For example:
1033 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1036 If there is an error, returns the error, otherwise returns false.
1041 my( $self, %options ) = @_;
1042 my $time = $options{'time'} || time;
1047 local $SIG{HUP} = 'IGNORE';
1048 local $SIG{INT} = 'IGNORE';
1049 local $SIG{QUIT} = 'IGNORE';
1050 local $SIG{TERM} = 'IGNORE';
1051 local $SIG{TSTP} = 'IGNORE';
1052 local $SIG{PIPE} = 'IGNORE';
1054 my $oldAutoCommit = $FS::UID::AutoCommit;
1055 local $FS::UID::AutoCommit = 0;
1058 # find the packages which are due for billing, find out how much they are
1059 # & generate invoice database.
1061 my( $total_setup, $total_recur ) = ( 0, 0 );
1062 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1063 my @cust_bill_pkg = ();
1065 #my $taxable_charged = 0;##
1070 foreach my $cust_pkg (
1071 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1074 #NO!! next if $cust_pkg->cancel;
1075 next if $cust_pkg->getfield('cancel');
1077 #? to avoid use of uninitialized value errors... ?
1078 $cust_pkg->setfield('bill', '')
1079 unless defined($cust_pkg->bill);
1081 my $part_pkg = $cust_pkg->part_pkg;
1083 #so we don't modify cust_pkg record unnecessarily
1084 my $cust_pkg_mod_flag = 0;
1085 my %hash = $cust_pkg->hash;
1086 my $old_cust_pkg = new FS::cust_pkg \%hash;
1090 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1091 my $setup_prog = $part_pkg->getfield('setup');
1092 $setup_prog =~ /^(.*)$/ or do {
1093 $dbh->rollback if $oldAutoCommit;
1094 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1098 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1100 #my $cpt = new Safe;
1101 ##$cpt->permit(); #what is necessary?
1102 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1103 #$setup = $cpt->reval($setup_prog);
1104 $setup = eval $setup_prog;
1105 unless ( defined($setup) ) {
1106 $dbh->rollback if $oldAutoCommit;
1107 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1108 "(expression $setup_prog): $@";
1110 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1111 $cust_pkg_mod_flag=1;
1117 if ( $part_pkg->getfield('freq') ne '0' &&
1118 ! $cust_pkg->getfield('susp') &&
1119 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1121 my $recur_prog = $part_pkg->getfield('recur');
1122 $recur_prog =~ /^(.*)$/ or do {
1123 $dbh->rollback if $oldAutoCommit;
1124 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1128 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1130 # shared with $recur_prog
1131 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1133 #my $cpt = new Safe;
1134 ##$cpt->permit(); #what is necessary?
1135 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1136 #$recur = $cpt->reval($recur_prog);
1137 $recur = eval $recur_prog;
1138 unless ( defined($recur) ) {
1139 $dbh->rollback if $oldAutoCommit;
1140 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1141 "(expression $recur_prog): $@";
1143 #change this bit to use Date::Manip? CAREFUL with timezones (see
1144 # mailing list archive)
1145 my ($sec,$min,$hour,$mday,$mon,$year) =
1146 (localtime($sdate) )[0,1,2,3,4,5];
1148 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1149 # only for figuring next bill date, nothing else, so, reset $sdate again
1151 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1152 $cust_pkg->last_bill($sdate)
1153 if $cust_pkg->dbdef_table->column('last_bill');
1155 if ( $part_pkg->freq =~ /^\d+$/ ) {
1156 $mon += $part_pkg->freq;
1157 until ( $mon < 12 ) { $mon -= 12; $year++; }
1158 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1160 $mday += $weeks * 7;
1161 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1165 $dbh->rollback if $oldAutoCommit;
1166 return "unparsable frequency: ". $part_pkg->freq;
1168 $cust_pkg->setfield('bill',
1169 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1170 $cust_pkg_mod_flag = 1;
1173 warn "\$setup is undefined" unless defined($setup);
1174 warn "\$recur is undefined" unless defined($recur);
1175 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1177 if ( $cust_pkg_mod_flag ) {
1178 $error=$cust_pkg->replace($old_cust_pkg);
1179 if ( $error ) { #just in case
1180 $dbh->rollback if $oldAutoCommit;
1181 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1183 $setup = sprintf( "%.2f", $setup );
1184 $recur = sprintf( "%.2f", $recur );
1186 $dbh->rollback if $oldAutoCommit;
1187 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1190 $dbh->rollback if $oldAutoCommit;
1191 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1193 if ( $setup > 0 || $recur > 0 ) {
1194 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1195 'pkgnum' => $cust_pkg->pkgnum,
1199 'edate' => $cust_pkg->bill,
1201 push @cust_bill_pkg, $cust_bill_pkg;
1202 $total_setup += $setup;
1203 $total_recur += $recur;
1205 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1207 my @taxes = qsearch( 'cust_main_county', {
1208 'state' => $self->state,
1209 'county' => $self->county,
1210 'country' => $self->country,
1211 'taxclass' => $part_pkg->taxclass,
1214 @taxes = qsearch( 'cust_main_county', {
1215 'state' => $self->state,
1216 'county' => $self->county,
1217 'country' => $self->country,
1222 # maybe eliminate this entirely, along with all the 0% records
1224 $dbh->rollback if $oldAutoCommit;
1226 "fatal: can't find tax rate for state/county/country/taxclass ".
1227 join('/', ( map $self->$_(), qw(state county country) ),
1228 $part_pkg->taxclass ). "\n";
1231 foreach my $tax ( @taxes ) {
1233 my $taxable_charged = 0;
1234 $taxable_charged += $setup
1235 unless $part_pkg->setuptax =~ /^Y$/i
1236 || $tax->setuptax =~ /^Y$/i;
1237 $taxable_charged += $recur
1238 unless $part_pkg->recurtax =~ /^Y$/i
1239 || $tax->recurtax =~ /^Y$/i;
1240 next unless $taxable_charged;
1242 if ( $tax->exempt_amount > 0 ) {
1243 my ($mon,$year) = (localtime($sdate) )[4,5];
1245 my $freq = $part_pkg->freq || 1;
1246 if ( $freq !~ /(\d+)$/ ) {
1247 $dbh->rollback if $oldAutoCommit;
1248 return "daily/weekly package definitions not (yet?)".
1249 " compatible with monthly tax exemptions";
1251 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1252 foreach my $which_month ( 1 .. $freq ) {
1254 'custnum' => $self->custnum,
1255 'taxnum' => $tax->taxnum,
1256 'year' => 1900+$year,
1259 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1260 until ( $mon < 13 ) { $mon -= 12; $year++; }
1261 my $cust_tax_exempt =
1262 qsearchs('cust_tax_exempt', \%hash)
1263 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1264 my $remaining_exemption = sprintf("%.2f",
1265 $tax->exempt_amount - $cust_tax_exempt->amount );
1266 if ( $remaining_exemption > 0 ) {
1267 my $addl = $remaining_exemption > $taxable_per_month
1268 ? $taxable_per_month
1269 : $remaining_exemption;
1270 $taxable_charged -= $addl;
1271 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1272 $cust_tax_exempt->hash,
1274 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1276 $error = $new_cust_tax_exempt->exemptnum
1277 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1278 : $new_cust_tax_exempt->insert;
1280 $dbh->rollback if $oldAutoCommit;
1281 return "fatal: can't update cust_tax_exempt: $error";
1284 } # if $remaining_exemption > 0
1286 } #foreach $which_month
1288 } #if $tax->exempt_amount
1290 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1292 #$tax += $taxable_charged * $cust_main_county->tax / 100
1293 $tax{ $tax->taxname || 'Tax' } +=
1294 $taxable_charged * $tax->tax / 100
1296 } #foreach my $tax ( @taxes )
1298 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1300 } #if $setup > 0 || $recur > 0
1302 } #if $cust_pkg_mod_flag
1304 } #foreach my $cust_pkg
1306 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1307 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1309 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1310 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1314 # unless ( $self->tax =~ /Y/i
1315 # || $self->payby eq 'COMP'
1316 # || $taxable_charged == 0 ) {
1317 # my $cust_main_county = qsearchs('cust_main_county',{
1318 # 'state' => $self->state,
1319 # 'county' => $self->county,
1320 # 'country' => $self->country,
1321 # } ) or die "fatal: can't find tax rate for state/county/country ".
1322 # $self->state. "/". $self->county. "/". $self->country. "\n";
1323 # my $tax = sprintf( "%.2f",
1324 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1327 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1329 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1330 my $tax = sprintf("%.2f", $tax{$taxname} );
1331 $charged = sprintf( "%.2f", $charged+$tax );
1333 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1339 'itemdesc' => $taxname,
1341 push @cust_bill_pkg, $cust_bill_pkg;
1344 } else { #1.4 schema
1347 foreach ( values %tax ) { $tax += $_ };
1348 $tax = sprintf("%.2f", $tax);
1350 $charged = sprintf( "%.2f", $charged+$tax );
1352 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1359 push @cust_bill_pkg, $cust_bill_pkg;
1364 my $cust_bill = new FS::cust_bill ( {
1365 'custnum' => $self->custnum,
1367 'charged' => $charged,
1369 $error = $cust_bill->insert;
1371 $dbh->rollback if $oldAutoCommit;
1372 return "can't create invoice for customer #". $self->custnum. ": $error";
1375 my $invnum = $cust_bill->invnum;
1377 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1379 $cust_bill_pkg->invnum($invnum);
1380 $error = $cust_bill_pkg->insert;
1382 $dbh->rollback if $oldAutoCommit;
1383 return "can't create invoice line item for customer #". $self->custnum.
1388 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1392 =item collect OPTIONS
1394 (Attempt to) collect money for this customer's outstanding invoices (see
1395 L<FS::cust_bill>). Usually used after the bill method.
1397 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1398 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1400 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1401 and the invoice events web interface.
1403 If there is an error, returns the error, otherwise returns false.
1405 Options are passed as name-value pairs.
1407 Currently available options are:
1409 invoice_time - Use this time when deciding when to print invoices and
1410 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>
1411 for conversion functions.
1413 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1416 retry_card - Deprecated alias for 'retry'
1418 batch_card - This option is deprecated. See the invoice events web interface
1419 to control whether cards are batched or run against a realtime gateway.
1421 report_badcard - This option is deprecated.
1423 force_print - This option is deprecated; see the invoice events web interface.
1425 quiet - set true to surpress email card/ACH decline notices.
1430 my( $self, %options ) = @_;
1431 my $invoice_time = $options{'invoice_time'} || time;
1434 local $SIG{HUP} = 'IGNORE';
1435 local $SIG{INT} = 'IGNORE';
1436 local $SIG{QUIT} = 'IGNORE';
1437 local $SIG{TERM} = 'IGNORE';
1438 local $SIG{TSTP} = 'IGNORE';
1439 local $SIG{PIPE} = 'IGNORE';
1441 my $oldAutoCommit = $FS::UID::AutoCommit;
1442 local $FS::UID::AutoCommit = 0;
1445 my $balance = $self->balance;
1446 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1447 unless ( $balance > 0 ) { #redundant?????
1448 $dbh->rollback if $oldAutoCommit; #hmm
1452 if ( exists($options{'retry_card'}) ) {
1453 carp 'retry_card option passed to collect is deprecated; use retry';
1454 $options{'retry'} ||= $options{'retry_card'};
1456 if ( exists($options{'retry'}) && $options{'retry'} ) {
1457 my $error = $self->retry_realtime;
1459 $dbh->rollback if $oldAutoCommit;
1464 foreach my $cust_bill ( $self->cust_bill ) {
1466 #this has to be before next's
1467 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1471 $balance = sprintf( "%.2f", $balance - $amount );
1473 next unless $cust_bill->owed > 0;
1475 # don't try to charge for the same invoice if it's already in a batch
1476 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1478 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1480 next unless $amount > 0;
1483 foreach my $part_bill_event (
1484 sort { $a->seconds <=> $b->seconds
1485 || $a->weight <=> $b->weight
1486 || $a->eventpart <=> $b->eventpart }
1487 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1488 && ! qsearchs( 'cust_bill_event', {
1489 'invnum' => $cust_bill->invnum,
1490 'eventpart' => $_->eventpart,
1494 qsearch('part_bill_event', { 'payby' => $self->payby,
1495 'disabled' => '', } )
1498 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1500 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1502 my $cust_main = $self; #for callback
1506 #supress "used only once" warning
1507 $FS::cust_bill::realtime_bop_decline_quiet += 0;
1508 local $FS::cust_bill::realtime_bop_decline_quiet = 1
1509 if $options{'quiet'};
1510 $error = eval $part_bill_event->eventcode;
1514 my $statustext = '';
1518 } elsif ( $error ) {
1520 $statustext = $error;
1525 #add cust_bill_event
1526 my $cust_bill_event = new FS::cust_bill_event {
1527 'invnum' => $cust_bill->invnum,
1528 'eventpart' => $part_bill_event->eventpart,
1529 #'_date' => $invoice_time,
1531 'status' => $status,
1532 'statustext' => $statustext,
1534 $error = $cust_bill_event->insert;
1536 #$dbh->rollback if $oldAutoCommit;
1537 #return "error: $error";
1539 # gah, even with transactions.
1540 $dbh->commit if $oldAutoCommit; #well.
1541 my $e = 'WARNING: Event run but database not updated - '.
1542 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1543 ', eventpart '. $part_bill_event->eventpart.
1554 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1559 =item retry_realtime
1561 Schedules realtime credit card / electronic check / LEC billing events for
1562 for retry. Useful if card information has changed or manual retry is desired.
1563 The 'collect' method must be called to actually retry the transaction.
1565 Implementation details: For each of this customer's open invoices, changes
1566 the status of the first "done" (with statustext error) realtime processing
1571 sub retry_realtime {
1574 local $SIG{HUP} = 'IGNORE';
1575 local $SIG{INT} = 'IGNORE';
1576 local $SIG{QUIT} = 'IGNORE';
1577 local $SIG{TERM} = 'IGNORE';
1578 local $SIG{TSTP} = 'IGNORE';
1579 local $SIG{PIPE} = 'IGNORE';
1581 my $oldAutoCommit = $FS::UID::AutoCommit;
1582 local $FS::UID::AutoCommit = 0;
1585 foreach my $cust_bill (
1586 grep { $_->cust_bill_event }
1587 $self->open_cust_bill
1589 my @cust_bill_event =
1590 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1592 #$_->part_bill_event->plan eq 'realtime-card'
1593 $_->part_bill_event->eventcode =~
1594 /\$cust_bill\->realtime_(card|ach|lec)/
1595 && $_->status eq 'done'
1598 $cust_bill->cust_bill_event;
1599 next unless @cust_bill_event;
1600 my $error = $cust_bill_event[0]->retry;
1602 $dbh->rollback if $oldAutoCommit;
1603 return "error scheduling invoice event for retry: $error";
1608 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1615 Returns the total owed for this customer on all invoices
1616 (see L<FS::cust_bill/owed>).
1622 $self->total_owed_date(2145859200); #12/31/2037
1625 =item total_owed_date TIME
1627 Returns the total owed for this customer on all invoices with date earlier than
1628 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1629 see L<Time::Local> and L<Date::Parse> for conversion functions.
1633 sub total_owed_date {
1637 foreach my $cust_bill (
1638 grep { $_->_date <= $time }
1639 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1641 $total_bill += $cust_bill->owed;
1643 sprintf( "%.2f", $total_bill );
1648 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1649 to outstanding invoice balances in chronological order and returns the value
1650 of any remaining unapplied credits available for refund
1651 (see L<FS::cust_refund>).
1658 return 0 unless $self->total_credited;
1660 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1661 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1663 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1664 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1668 foreach my $cust_bill ( @invoices ) {
1671 if ( !defined($credit) || $credit->credited == 0) {
1672 $credit = pop @credits or last;
1675 if ($cust_bill->owed >= $credit->credited) {
1676 $amount=$credit->credited;
1678 $amount=$cust_bill->owed;
1681 my $cust_credit_bill = new FS::cust_credit_bill ( {
1682 'crednum' => $credit->crednum,
1683 'invnum' => $cust_bill->invnum,
1684 'amount' => $amount,
1686 my $error = $cust_credit_bill->insert;
1687 die $error if $error;
1689 redo if ($cust_bill->owed > 0);
1693 return $self->total_credited;
1696 =item apply_payments
1698 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1699 to outstanding invoice balances in chronological order.
1701 #and returns the value of any remaining unapplied payments.
1705 sub apply_payments {
1710 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1711 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1713 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1714 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1718 foreach my $cust_bill ( @invoices ) {
1721 if ( !defined($payment) || $payment->unapplied == 0 ) {
1722 $payment = pop @payments or last;
1725 if ( $cust_bill->owed >= $payment->unapplied ) {
1726 $amount = $payment->unapplied;
1728 $amount = $cust_bill->owed;
1731 my $cust_bill_pay = new FS::cust_bill_pay ( {
1732 'paynum' => $payment->paynum,
1733 'invnum' => $cust_bill->invnum,
1734 'amount' => $amount,
1736 my $error = $cust_bill_pay->insert;
1737 die $error if $error;
1739 redo if ( $cust_bill->owed > 0);
1743 return $self->total_unapplied_payments;
1746 =item total_credited
1748 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1749 customer. See L<FS::cust_credit/credited>.
1753 sub total_credited {
1755 my $total_credit = 0;
1756 foreach my $cust_credit ( qsearch('cust_credit', {
1757 'custnum' => $self->custnum,
1759 $total_credit += $cust_credit->credited;
1761 sprintf( "%.2f", $total_credit );
1764 =item total_unapplied_payments
1766 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1767 See L<FS::cust_pay/unapplied>.
1771 sub total_unapplied_payments {
1773 my $total_unapplied = 0;
1774 foreach my $cust_pay ( qsearch('cust_pay', {
1775 'custnum' => $self->custnum,
1777 $total_unapplied += $cust_pay->unapplied;
1779 sprintf( "%.2f", $total_unapplied );
1784 Returns the balance for this customer (total_owed minus total_credited
1785 minus total_unapplied_payments).
1792 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1796 =item balance_date TIME
1798 Returns the balance for this customer, only considering invoices with date
1799 earlier than TIME (total_owed_date minus total_credited minus
1800 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1801 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1810 $self->total_owed_date($time)
1811 - $self->total_credited
1812 - $self->total_unapplied_payments
1816 =item invoicing_list [ ARRAYREF ]
1818 If an arguement is given, sets these email addresses as invoice recipients
1819 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1820 (except as warnings), so use check_invoicing_list first.
1822 Returns a list of email addresses (with svcnum entries expanded).
1824 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1825 check it without disturbing anything by passing nothing.
1827 This interface may change in the future.
1831 sub invoicing_list {
1832 my( $self, $arrayref ) = @_;
1834 my @cust_main_invoice;
1835 if ( $self->custnum ) {
1836 @cust_main_invoice =
1837 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1839 @cust_main_invoice = ();
1841 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1842 #warn $cust_main_invoice->destnum;
1843 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1844 #warn $cust_main_invoice->destnum;
1845 my $error = $cust_main_invoice->delete;
1846 warn $error if $error;
1849 if ( $self->custnum ) {
1850 @cust_main_invoice =
1851 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1853 @cust_main_invoice = ();
1855 my %seen = map { $_->address => 1 } @cust_main_invoice;
1856 foreach my $address ( @{$arrayref} ) {
1857 next if exists $seen{$address} && $seen{$address};
1858 $seen{$address} = 1;
1859 my $cust_main_invoice = new FS::cust_main_invoice ( {
1860 'custnum' => $self->custnum,
1863 my $error = $cust_main_invoice->insert;
1864 warn $error if $error;
1867 if ( $self->custnum ) {
1869 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1875 =item check_invoicing_list ARRAYREF
1877 Checks these arguements as valid input for the invoicing_list method. If there
1878 is an error, returns the error, otherwise returns false.
1882 sub check_invoicing_list {
1883 my( $self, $arrayref ) = @_;
1884 foreach my $address ( @{$arrayref} ) {
1885 my $cust_main_invoice = new FS::cust_main_invoice ( {
1886 'custnum' => $self->custnum,
1889 my $error = $self->custnum
1890 ? $cust_main_invoice->check
1891 : $cust_main_invoice->checkdest
1893 return $error if $error;
1898 =item set_default_invoicing_list
1900 Sets the invoicing list to all accounts associated with this customer,
1901 overwriting any previous invoicing list.
1905 sub set_default_invoicing_list {
1907 $self->invoicing_list($self->all_emails);
1912 Returns the email addresses of all accounts provisioned for this customer.
1919 foreach my $cust_pkg ( $self->all_pkgs ) {
1920 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1922 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1923 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1925 $list{$_}=1 foreach map { $_->email } @svc_acct;
1930 =item invoicing_list_addpost
1932 Adds postal invoicing to this customer. If this customer is already configured
1933 to receive postal invoices, does nothing.
1937 sub invoicing_list_addpost {
1939 return if grep { $_ eq 'POST' } $self->invoicing_list;
1940 my @invoicing_list = $self->invoicing_list;
1941 push @invoicing_list, 'POST';
1942 $self->invoicing_list(\@invoicing_list);
1945 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1947 Returns an array of customers referred by this customer (referral_custnum set
1948 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1949 customers referred by customers referred by this customer and so on, inclusive.
1950 The default behavior is DEPTH 1 (no recursion).
1954 sub referral_cust_main {
1956 my $depth = @_ ? shift : 1;
1957 my $exclude = @_ ? shift : {};
1960 map { $exclude->{$_->custnum}++; $_; }
1961 grep { ! $exclude->{ $_->custnum } }
1962 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1966 map { $_->referral_cust_main($depth-1, $exclude) }
1973 =item referral_cust_main_ncancelled
1975 Same as referral_cust_main, except only returns customers with uncancelled
1980 sub referral_cust_main_ncancelled {
1982 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1985 =item referral_cust_pkg [ DEPTH ]
1987 Like referral_cust_main, except returns a flat list of all unsuspended (and
1988 uncancelled) packages for each customer. The number of items in this list may
1989 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1993 sub referral_cust_pkg {
1995 my $depth = @_ ? shift : 1;
1997 map { $_->unsuspended_pkgs }
1998 grep { $_->unsuspended_pkgs }
1999 $self->referral_cust_main($depth);
2002 =item credit AMOUNT, REASON
2004 Applies a credit to this customer. If there is an error, returns the error,
2005 otherwise returns false.
2010 my( $self, $amount, $reason ) = @_;
2011 my $cust_credit = new FS::cust_credit {
2012 'custnum' => $self->custnum,
2013 'amount' => $amount,
2014 'reason' => $reason,
2016 $cust_credit->insert;
2019 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2021 Creates a one-time charge for this customer. If there is an error, returns
2022 the error, otherwise returns false.
2027 my ( $self, $amount ) = ( shift, shift );
2028 my $pkg = @_ ? shift : 'One-time charge';
2029 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2030 my $taxclass = @_ ? shift : '';
2032 local $SIG{HUP} = 'IGNORE';
2033 local $SIG{INT} = 'IGNORE';
2034 local $SIG{QUIT} = 'IGNORE';
2035 local $SIG{TERM} = 'IGNORE';
2036 local $SIG{TSTP} = 'IGNORE';
2037 local $SIG{PIPE} = 'IGNORE';
2039 my $oldAutoCommit = $FS::UID::AutoCommit;
2040 local $FS::UID::AutoCommit = 0;
2043 my $part_pkg = new FS::part_pkg ( {
2045 'comment' => $comment,
2050 'taxclass' => $taxclass,
2053 my $error = $part_pkg->insert;
2055 $dbh->rollback if $oldAutoCommit;
2059 my $pkgpart = $part_pkg->pkgpart;
2060 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2061 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2062 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2063 $error = $type_pkgs->insert;
2065 $dbh->rollback if $oldAutoCommit;
2070 my $cust_pkg = new FS::cust_pkg ( {
2071 'custnum' => $self->custnum,
2072 'pkgpart' => $pkgpart,
2075 $error = $cust_pkg->insert;
2077 $dbh->rollback if $oldAutoCommit;
2081 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2088 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2094 sort { $a->_date <=> $b->_date }
2095 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2098 =item open_cust_bill
2100 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2105 sub open_cust_bill {
2107 grep { $_->owed > 0 } $self->cust_bill;
2116 =item check_and_rebuild_fuzzyfiles
2120 sub check_and_rebuild_fuzzyfiles {
2121 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2122 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2123 or &rebuild_fuzzyfiles;
2126 =item rebuild_fuzzyfiles
2130 sub rebuild_fuzzyfiles {
2132 use Fcntl qw(:flock);
2134 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2138 open(LASTLOCK,">>$dir/cust_main.last")
2139 or die "can't open $dir/cust_main.last: $!";
2140 flock(LASTLOCK,LOCK_EX)
2141 or die "can't lock $dir/cust_main.last: $!";
2143 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2145 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2146 if defined dbdef->table('cust_main')->column('ship_last');
2148 open (LASTCACHE,">$dir/cust_main.last.tmp")
2149 or die "can't open $dir/cust_main.last.tmp: $!";
2150 print LASTCACHE join("\n", @all_last), "\n";
2151 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2153 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2158 open(COMPANYLOCK,">>$dir/cust_main.company")
2159 or die "can't open $dir/cust_main.company: $!";
2160 flock(COMPANYLOCK,LOCK_EX)
2161 or die "can't lock $dir/cust_main.company: $!";
2163 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2165 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2166 if defined dbdef->table('cust_main')->column('ship_last');
2168 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2169 or die "can't open $dir/cust_main.company.tmp: $!";
2170 print COMPANYCACHE join("\n", @all_company), "\n";
2171 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2173 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2183 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2184 open(LASTCACHE,"<$dir/cust_main.last")
2185 or die "can't open $dir/cust_main.last: $!";
2186 my @array = map { chomp; $_; } <LASTCACHE>;
2196 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2197 open(COMPANYCACHE,"<$dir/cust_main.company")
2198 or die "can't open $dir/cust_main.last: $!";
2199 my @array = map { chomp; $_; } <COMPANYCACHE>;
2204 =item append_fuzzyfiles LASTNAME COMPANY
2208 sub append_fuzzyfiles {
2209 my( $last, $company ) = @_;
2211 &check_and_rebuild_fuzzyfiles;
2213 use Fcntl qw(:flock);
2215 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2219 open(LAST,">>$dir/cust_main.last")
2220 or die "can't open $dir/cust_main.last: $!";
2222 or die "can't lock $dir/cust_main.last: $!";
2224 print LAST "$last\n";
2227 or die "can't unlock $dir/cust_main.last: $!";
2233 open(COMPANY,">>$dir/cust_main.company")
2234 or die "can't open $dir/cust_main.company: $!";
2235 flock(COMPANY,LOCK_EX)
2236 or die "can't lock $dir/cust_main.company: $!";
2238 print COMPANY "$company\n";
2240 flock(COMPANY,LOCK_UN)
2241 or die "can't unlock $dir/cust_main.company: $!";
2255 #warn join('-',keys %$param);
2256 my $fh = $param->{filehandle};
2257 my $agentnum = $param->{agentnum};
2258 my $refnum = $param->{refnum};
2259 my $pkgpart = $param->{pkgpart};
2260 my @fields = @{$param->{fields}};
2262 eval "use Date::Parse;";
2264 eval "use Text::CSV_XS;";
2267 my $csv = new Text::CSV_XS;
2274 local $SIG{HUP} = 'IGNORE';
2275 local $SIG{INT} = 'IGNORE';
2276 local $SIG{QUIT} = 'IGNORE';
2277 local $SIG{TERM} = 'IGNORE';
2278 local $SIG{TSTP} = 'IGNORE';
2279 local $SIG{PIPE} = 'IGNORE';
2281 my $oldAutoCommit = $FS::UID::AutoCommit;
2282 local $FS::UID::AutoCommit = 0;
2285 #while ( $columns = $csv->getline($fh) ) {
2287 while ( defined($line=<$fh>) ) {
2289 $csv->parse($line) or do {
2290 $dbh->rollback if $oldAutoCommit;
2291 return "can't parse: ". $csv->error_input();
2294 my @columns = $csv->fields();
2295 #warn join('-',@columns);
2298 agentnum => $agentnum,
2300 country => 'US', #default
2301 payby => 'BILL', #default
2302 paydate => '12/2037', #default
2304 my $billtime = time;
2305 my %cust_pkg = ( pkgpart => $pkgpart );
2306 foreach my $field ( @fields ) {
2307 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2308 #$cust_pkg{$1} = str2time( shift @$columns );
2309 if ( $1 eq 'setup' ) {
2310 $billtime = str2time(shift @columns);
2312 $cust_pkg{$1} = str2time( shift @columns );
2315 #$cust_main{$field} = shift @$columns;
2316 $cust_main{$field} = shift @columns;
2320 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2321 my $cust_main = new FS::cust_main ( \%cust_main );
2323 tie my %hash, 'Tie::RefHash'; #this part is important
2324 $hash{$cust_pkg} = [] if $pkgpart;
2325 my $error = $cust_main->insert( \%hash );
2328 $dbh->rollback if $oldAutoCommit;
2329 return "can't insert customer for $line: $error";
2332 #false laziness w/bill.cgi
2333 $error = $cust_main->bill( 'time' => $billtime );
2335 $dbh->rollback if $oldAutoCommit;
2336 return "can't bill customer for $line: $error";
2339 $cust_main->apply_payments;
2340 $cust_main->apply_credits;
2342 $error = $cust_main->collect();
2344 $dbh->rollback if $oldAutoCommit;
2345 return "can't collect customer for $line: $error";
2351 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2353 return "Empty file!" unless $imported;
2365 #warn join('-',keys %$param);
2366 my $fh = $param->{filehandle};
2367 my @fields = @{$param->{fields}};
2369 eval "use Date::Parse;";
2371 eval "use Text::CSV_XS;";
2374 my $csv = new Text::CSV_XS;
2381 local $SIG{HUP} = 'IGNORE';
2382 local $SIG{INT} = 'IGNORE';
2383 local $SIG{QUIT} = 'IGNORE';
2384 local $SIG{TERM} = 'IGNORE';
2385 local $SIG{TSTP} = 'IGNORE';
2386 local $SIG{PIPE} = 'IGNORE';
2388 my $oldAutoCommit = $FS::UID::AutoCommit;
2389 local $FS::UID::AutoCommit = 0;
2392 #while ( $columns = $csv->getline($fh) ) {
2394 while ( defined($line=<$fh>) ) {
2396 $csv->parse($line) or do {
2397 $dbh->rollback if $oldAutoCommit;
2398 return "can't parse: ". $csv->error_input();
2401 my @columns = $csv->fields();
2402 #warn join('-',@columns);
2405 foreach my $field ( @fields ) {
2406 $row{$field} = shift @columns;
2409 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2410 unless ( $cust_main ) {
2411 $dbh->rollback if $oldAutoCommit;
2412 return "unknown custnum $row{'custnum'}";
2415 if ( $row{'amount'} > 0 ) {
2416 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2418 $dbh->rollback if $oldAutoCommit;
2422 } elsif ( $row{'amount'} < 0 ) {
2423 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2426 $dbh->rollback if $oldAutoCommit;
2436 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2438 return "Empty file!" unless $imported;
2450 The delete method should possibly take an FS::cust_main object reference
2451 instead of a scalar customer number.
2453 Bill and collect options should probably be passed as references instead of a
2456 There should probably be a configuration file with a list of allowed credit
2459 No multiple currency support (probably a larger project than just this module).
2463 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2464 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2465 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.