4 use vars qw( @ISA $conf $Debug $import );
7 BEGIN { eval "use Time::Local 1.05;" if $] < 5.006; };
8 use Time::Local qw(timelocal_nocheck);
11 use Business::CreditCard;
12 use FS::UID qw( getotaker dbh );
13 use FS::Record qw( qsearchs qsearch dbdef );
14 use FS::Misc qw( send_email );
17 use FS::cust_bill_pkg;
20 use FS::part_referral;
21 use FS::cust_main_county;
23 use FS::cust_main_invoice;
24 use FS::cust_credit_bill;
25 use FS::cust_bill_pay;
26 use FS::prepay_credit;
29 use FS::part_bill_event;
30 use FS::cust_bill_event;
31 use FS::cust_tax_exempt;
33 use FS::Msgcat qw(gettext);
35 @ISA = qw( FS::Record );
42 #ask FS::UID to run this stuff for us later
43 #$FS::UID::callback{'FS::cust_main'} = sub {
44 install_callback FS::UID sub {
46 #yes, need it for stuff below (prolly should be cached)
51 my ( $hashref, $cache ) = @_;
52 if ( exists $hashref->{'pkgnum'} ) {
53 # #@{ $self->{'_pkgnum'} } = ();
54 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
55 $self->{'_pkgnum'} = $subcache;
56 #push @{ $self->{'_pkgnum'} },
57 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
63 FS::cust_main - Object methods for cust_main records
69 $record = new FS::cust_main \%hash;
70 $record = new FS::cust_main { 'column' => 'value' };
72 $error = $record->insert;
74 $error = $new_record->replace($old_record);
76 $error = $record->delete;
78 $error = $record->check;
80 @cust_pkg = $record->all_pkgs;
82 @cust_pkg = $record->ncancelled_pkgs;
84 @cust_pkg = $record->suspended_pkgs;
86 $error = $record->bill;
87 $error = $record->bill %options;
88 $error = $record->bill 'time' => $time;
90 $error = $record->collect;
91 $error = $record->collect %options;
92 $error = $record->collect 'invoice_time' => $time,
93 'batch_card' => 'yes',
94 'report_badcard' => 'yes',
99 An FS::cust_main object represents a customer. FS::cust_main inherits from
100 FS::Record. The following fields are currently supported:
104 =item custnum - primary key (assigned automatically for new customers)
106 =item agentnum - agent (see L<FS::agent>)
108 =item refnum - Advertising source (see L<FS::part_referral>)
114 =item ss - social security number (optional)
116 =item company - (optional)
120 =item address2 - (optional)
124 =item county - (optional, see L<FS::cust_main_county>)
126 =item state - (see L<FS::cust_main_county>)
130 =item country - (see L<FS::cust_main_county>)
132 =item daytime - phone (optional)
134 =item night - phone (optional)
136 =item fax - phone (optional)
138 =item ship_first - name
140 =item ship_last - name
142 =item ship_company - (optional)
146 =item ship_address2 - (optional)
150 =item ship_county - (optional, see L<FS::cust_main_county>)
152 =item ship_state - (see L<FS::cust_main_county>)
156 =item ship_country - (see L<FS::cust_main_county>)
158 =item ship_daytime - phone (optional)
160 =item ship_night - phone (optional)
162 =item ship_fax - phone (optional)
164 =item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
166 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
168 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
170 =item payname - name on card or billing name
172 =item tax - tax exempt, empty or `Y'
174 =item otaker - order taker (assigned automatically, see L<FS::UID>)
176 =item comments - comments (optional)
178 =item referral_custnum - referring customer number
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 ] ]
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' ] );
229 my $cust_pkgs = @_ ? shift : {};
230 my $invoicing_list = @_ ? shift : '';
232 local $SIG{HUP} = 'IGNORE';
233 local $SIG{INT} = 'IGNORE';
234 local $SIG{QUIT} = 'IGNORE';
235 local $SIG{TERM} = 'IGNORE';
236 local $SIG{TSTP} = 'IGNORE';
237 local $SIG{PIPE} = 'IGNORE';
239 my $oldAutoCommit = $FS::UID::AutoCommit;
240 local $FS::UID::AutoCommit = 0;
245 if ( $self->payby eq 'PREPAY' ) {
246 $self->payby('BILL');
247 my $prepay_credit = qsearchs(
249 { 'identifier' => $self->payinfo },
253 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
254 unless $prepay_credit;
255 $amount = $prepay_credit->amount;
256 $seconds = $prepay_credit->seconds;
257 my $error = $prepay_credit->delete;
259 $dbh->rollback if $oldAutoCommit;
260 return "removing prepay_credit (transaction rolled back): $error";
264 my $error = $self->SUPER::insert;
266 $dbh->rollback if $oldAutoCommit;
267 #return "inserting cust_main record (transaction rolled back): $error";
272 if ( $invoicing_list ) {
273 $error = $self->check_invoicing_list( $invoicing_list );
275 $dbh->rollback if $oldAutoCommit;
276 return "checking invoicing_list (transaction rolled back): $error";
278 $self->invoicing_list( $invoicing_list );
282 $error = $self->order_pkgs($cust_pkgs, \$seconds);
284 $dbh->rollback if $oldAutoCommit;
289 $dbh->rollback if $oldAutoCommit;
290 return "No svc_acct record to apply pre-paid time";
294 my $cust_credit = new FS::cust_credit {
295 'custnum' => $self->custnum,
298 $error = $cust_credit->insert;
300 $dbh->rollback if $oldAutoCommit;
301 return "inserting credit (transaction rolled back): $error";
305 #false laziness with sub replace
306 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
307 $error = $queue->insert($self->getfield('last'), $self->company);
309 $dbh->rollback if $oldAutoCommit;
310 return "queueing job (transaction rolled back): $error";
313 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
314 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
315 $error = $queue->insert($self->getfield('last'), $self->company);
317 $dbh->rollback if $oldAutoCommit;
318 return "queueing job (transaction rolled back): $error";
323 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
330 document me. like ->insert(%cust_pkg) on an existing record
336 my $cust_pkgs = shift;
339 local $SIG{HUP} = 'IGNORE';
340 local $SIG{INT} = 'IGNORE';
341 local $SIG{QUIT} = 'IGNORE';
342 local $SIG{TERM} = 'IGNORE';
343 local $SIG{TSTP} = 'IGNORE';
344 local $SIG{PIPE} = 'IGNORE';
346 my $oldAutoCommit = $FS::UID::AutoCommit;
347 local $FS::UID::AutoCommit = 0;
350 foreach my $cust_pkg ( keys %$cust_pkgs ) {
351 $cust_pkg->custnum( $self->custnum );
352 my $error = $cust_pkg->insert;
354 $dbh->rollback if $oldAutoCommit;
355 return "inserting cust_pkg (transaction rolled back): $error";
357 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
358 $svc_something->pkgnum( $cust_pkg->pkgnum );
359 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
360 $svc_something->seconds( $svc_something->seconds + $$seconds );
363 $error = $svc_something->insert;
365 $dbh->rollback if $oldAutoCommit;
366 #return "inserting svc_ (transaction rolled back): $error";
372 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
376 =item delete NEW_CUSTNUM
378 This deletes the customer. If there is an error, returns the error, otherwise
381 This will completely remove all traces of the customer record. This is not
382 what you want when a customer cancels service; for that, cancel all of the
383 customer's packages (see L<FS::cust_pkg/cancel>).
385 If the customer has any uncancelled packages, you need to pass a new (valid)
386 customer number for those packages to be transferred to. Cancelled packages
387 will be deleted. Did I mention that this is NOT what you want when a customer
388 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
390 You can't delete a customer with invoices (see L<FS::cust_bill>),
391 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
392 refunds (see L<FS::cust_refund>).
399 local $SIG{HUP} = 'IGNORE';
400 local $SIG{INT} = 'IGNORE';
401 local $SIG{QUIT} = 'IGNORE';
402 local $SIG{TERM} = 'IGNORE';
403 local $SIG{TSTP} = 'IGNORE';
404 local $SIG{PIPE} = 'IGNORE';
406 my $oldAutoCommit = $FS::UID::AutoCommit;
407 local $FS::UID::AutoCommit = 0;
410 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
411 $dbh->rollback if $oldAutoCommit;
412 return "Can't delete a customer with invoices";
414 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
415 $dbh->rollback if $oldAutoCommit;
416 return "Can't delete a customer with credits";
418 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
419 $dbh->rollback if $oldAutoCommit;
420 return "Can't delete a customer with payments";
422 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
423 $dbh->rollback if $oldAutoCommit;
424 return "Can't delete a customer with refunds";
427 my @cust_pkg = $self->ncancelled_pkgs;
429 my $new_custnum = shift;
430 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
431 $dbh->rollback if $oldAutoCommit;
432 return "Invalid new customer number: $new_custnum";
434 foreach my $cust_pkg ( @cust_pkg ) {
435 my %hash = $cust_pkg->hash;
436 $hash{'custnum'} = $new_custnum;
437 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
438 my $error = $new_cust_pkg->replace($cust_pkg);
440 $dbh->rollback if $oldAutoCommit;
445 my @cancelled_cust_pkg = $self->all_pkgs;
446 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
447 my $error = $cust_pkg->delete;
449 $dbh->rollback if $oldAutoCommit;
454 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
455 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
457 my $error = $cust_main_invoice->delete;
459 $dbh->rollback if $oldAutoCommit;
464 my $error = $self->SUPER::delete;
466 $dbh->rollback if $oldAutoCommit;
470 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
475 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
477 Replaces the OLD_RECORD with this one in the database. If there is an error,
478 returns the error, otherwise returns false.
480 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
481 be set as the invoicing list (see L<"invoicing_list">). Errors return as
482 expected and rollback the entire transaction; it is not necessary to call
483 check_invoicing_list first. Here's an example:
485 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
494 local $SIG{HUP} = 'IGNORE';
495 local $SIG{INT} = 'IGNORE';
496 local $SIG{QUIT} = 'IGNORE';
497 local $SIG{TERM} = 'IGNORE';
498 local $SIG{TSTP} = 'IGNORE';
499 local $SIG{PIPE} = 'IGNORE';
501 my $oldAutoCommit = $FS::UID::AutoCommit;
502 local $FS::UID::AutoCommit = 0;
505 my $error = $self->SUPER::replace($old);
508 $dbh->rollback if $oldAutoCommit;
512 if ( @param ) { # INVOICING_LIST_ARYREF
513 my $invoicing_list = shift @param;
514 $error = $self->check_invoicing_list( $invoicing_list );
516 $dbh->rollback if $oldAutoCommit;
519 $self->invoicing_list( $invoicing_list );
522 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
523 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
524 # card/check info has changed, want to retry realtime_card invoice events
525 #false laziness w/collect
526 foreach my $cust_bill_event (
528 #$_->part_bill_event->plan eq 'realtime-card'
529 $_->part_bill_event->eventcode =~
530 /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
531 && $_->status eq 'done'
534 map { $_->cust_bill_event }
535 grep { $_->cust_bill_event }
536 $self->open_cust_bill
539 my $error = $cust_bill_event->retry;
541 $dbh->rollback if $oldAutoCommit;
542 return "error scheduling invoice events for retry: $error";
549 #false laziness with sub insert
550 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
551 $error = $queue->insert($self->getfield('last'), $self->company);
553 $dbh->rollback if $oldAutoCommit;
554 return "queueing job (transaction rolled back): $error";
557 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
558 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
559 $error = $queue->insert($self->getfield('last'), $self->company);
561 $dbh->rollback if $oldAutoCommit;
562 return "queueing job (transaction rolled back): $error";
567 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
574 Checks all fields to make sure this is a valid customer record. If there is
575 an error, returns the error, otherwise returns false. Called by the insert
583 #warn "BEFORE: \n". $self->_dump;
586 $self->ut_numbern('custnum')
587 || $self->ut_number('agentnum')
588 || $self->ut_number('refnum')
589 || $self->ut_name('last')
590 || $self->ut_name('first')
591 || $self->ut_textn('company')
592 || $self->ut_text('address1')
593 || $self->ut_textn('address2')
594 || $self->ut_text('city')
595 || $self->ut_textn('county')
596 || $self->ut_textn('state')
597 || $self->ut_country('country')
598 || $self->ut_anything('comments')
599 || $self->ut_numbern('referral_custnum')
601 #barf. need message catalogs. i18n. etc.
602 $error .= "Please select a advertising source."
603 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
604 return $error if $error;
606 return "Unknown agent"
607 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
609 return "Unknown refnum"
610 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
612 return "Unknown referring custnum ". $self->referral_custnum
613 unless ! $self->referral_custnum
614 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
616 if ( $self->ss eq '' ) {
621 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
622 or return "Illegal social security number: ". $self->ss;
623 $self->ss("$1-$2-$3");
627 # bad idea to disable, causes billing to fail because of no tax rates later
628 # unless ( $import ) {
629 unless ( qsearch('cust_main_county', {
630 'country' => $self->country,
633 return "Unknown state/county/country: ".
634 $self->state. "/". $self->county. "/". $self->country
635 unless qsearch('cust_main_county',{
636 'state' => $self->state,
637 'county' => $self->county,
638 'country' => $self->country,
644 $self->ut_phonen('daytime', $self->country)
645 || $self->ut_phonen('night', $self->country)
646 || $self->ut_phonen('fax', $self->country)
647 || $self->ut_zip('zip', $self->country)
649 return $error if $error;
652 last first company address1 address2 city county state zip
653 country daytime night fax
656 if ( defined $self->dbdef_table->column('ship_last') ) {
657 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
659 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
663 $self->ut_name('ship_last')
664 || $self->ut_name('ship_first')
665 || $self->ut_textn('ship_company')
666 || $self->ut_text('ship_address1')
667 || $self->ut_textn('ship_address2')
668 || $self->ut_text('ship_city')
669 || $self->ut_textn('ship_county')
670 || $self->ut_textn('ship_state')
671 || $self->ut_country('ship_country')
673 return $error if $error;
675 #false laziness with above
676 unless ( qsearchs('cust_main_county', {
677 'country' => $self->ship_country,
680 return "Unknown ship_state/ship_county/ship_country: ".
681 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
682 unless qsearchs('cust_main_county',{
683 'state' => $self->ship_state,
684 'county' => $self->ship_county,
685 'country' => $self->ship_country,
691 $self->ut_phonen('ship_daytime', $self->ship_country)
692 || $self->ut_phonen('ship_night', $self->ship_country)
693 || $self->ut_phonen('ship_fax', $self->ship_country)
694 || $self->ut_zip('ship_zip', $self->ship_country)
696 return $error if $error;
698 } else { # ship_ info eq billing info, so don't store dup info in database
699 $self->setfield("ship_$_", '')
700 foreach qw( last first company address1 address2 city county state zip
701 country daytime night fax );
705 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
706 or return "Illegal payby: ". $self->payby;
709 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
711 my $payinfo = $self->payinfo;
713 $payinfo =~ /^(\d{13,16})$/
714 or return gettext('invalid_card'); # . ": ". $self->payinfo;
716 $self->payinfo($payinfo);
718 or return gettext('invalid_card'); # . ": ". $self->payinfo;
719 return gettext('unknown_card_type')
720 if cardtype($self->payinfo) eq "Unknown";
722 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
724 my $payinfo = $self->payinfo;
725 $payinfo =~ s/[^\d\@]//g;
726 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
728 $self->payinfo($payinfo);
730 } elsif ( $self->payby eq 'LECB' ) {
732 my $payinfo = $self->payinfo;
734 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
736 $self->payinfo($payinfo);
738 } elsif ( $self->payby eq 'BILL' ) {
740 $error = $self->ut_textn('payinfo');
741 return "Illegal P.O. number: ". $self->payinfo if $error;
743 } elsif ( $self->payby eq 'COMP' ) {
745 $error = $self->ut_textn('payinfo');
746 return "Illegal comp account issuer: ". $self->payinfo if $error;
748 } elsif ( $self->payby eq 'PREPAY' ) {
750 my $payinfo = $self->payinfo;
751 $payinfo =~ s/\W//g; #anything else would just confuse things
752 $self->payinfo($payinfo);
753 $error = $self->ut_alpha('payinfo');
754 return "Illegal prepayment identifier: ". $self->payinfo if $error;
755 return "Unknown prepayment identifier"
756 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
760 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
761 return "Expriation date required"
762 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
766 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
767 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
768 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
769 ( $m, $y ) = ( $3, "20$2" );
771 return "Illegal expiration date: ". $self->paydate;
773 $self->paydate("$y-$m-01");
774 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
775 return gettext('expired_card')
776 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
779 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
780 ( ! $conf->exists('require_cardname')
781 || $self->payby !~ /^(CARD|DCRD)$/ )
783 $self->payname( $self->first. " ". $self->getfield('last') );
785 $self->payname =~ /^([\w \,\.\-\']+)$/
786 or return gettext('illegal_name'). " payname: ". $self->payname;
790 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
793 $self->otaker(getotaker);
795 #warn "AFTER: \n". $self->_dump;
802 Returns all packages (see L<FS::cust_pkg>) for this customer.
808 if ( $self->{'_pkgnum'} ) {
809 values %{ $self->{'_pkgnum'}->cache };
811 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
815 =item ncancelled_pkgs
817 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
821 sub ncancelled_pkgs {
823 if ( $self->{'_pkgnum'} ) {
824 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
826 @{ [ # force list context
827 qsearch( 'cust_pkg', {
828 'custnum' => $self->custnum,
831 qsearch( 'cust_pkg', {
832 'custnum' => $self->custnum,
841 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
847 grep { $_->susp } $self->ncancelled_pkgs;
850 =item unflagged_suspended_pkgs
852 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
853 customer (thouse packages without the `manual_flag' set).
857 sub unflagged_suspended_pkgs {
859 return $self->suspended_pkgs
860 unless dbdef->table('cust_pkg')->column('manual_flag');
861 grep { ! $_->manual_flag } $self->suspended_pkgs;
864 =item unsuspended_pkgs
866 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
871 sub unsuspended_pkgs {
873 grep { ! $_->susp } $self->ncancelled_pkgs;
878 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
879 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
880 on success or a list of errors.
886 grep { $_->unsuspend } $self->suspended_pkgs;
891 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
892 Always returns a list: an empty list on success or a list of errors.
898 grep { $_->suspend } $self->unsuspended_pkgs;
903 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
904 Always returns a list: an empty list on success or a list of errors.
910 grep { $_->cancel } $self->ncancelled_pkgs;
915 Returns the agent (see L<FS::agent>) for this customer.
921 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
926 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
927 conjunction with the collect method.
929 Options are passed as name-value pairs.
931 The only currently available option is `time', which bills the customer as if
932 it were that time. It is specified as a UNIX timestamp; see
933 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
934 functions. For example:
938 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
940 If there is an error, returns the error, otherwise returns false.
945 my( $self, %options ) = @_;
946 my $time = $options{'time'} || time;
951 local $SIG{HUP} = 'IGNORE';
952 local $SIG{INT} = 'IGNORE';
953 local $SIG{QUIT} = 'IGNORE';
954 local $SIG{TERM} = 'IGNORE';
955 local $SIG{TSTP} = 'IGNORE';
956 local $SIG{PIPE} = 'IGNORE';
958 my $oldAutoCommit = $FS::UID::AutoCommit;
959 local $FS::UID::AutoCommit = 0;
962 # find the packages which are due for billing, find out how much they are
963 # & generate invoice database.
965 my( $total_setup, $total_recur ) = ( 0, 0 );
966 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
967 my @cust_bill_pkg = ();
969 #my $taxable_charged = 0;##
974 foreach my $cust_pkg (
975 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
978 #NO!! next if $cust_pkg->cancel;
979 next if $cust_pkg->getfield('cancel');
981 #? to avoid use of uninitialized value errors... ?
982 $cust_pkg->setfield('bill', '')
983 unless defined($cust_pkg->bill);
985 my $part_pkg = $cust_pkg->part_pkg;
987 #so we don't modify cust_pkg record unnecessarily
988 my $cust_pkg_mod_flag = 0;
989 my %hash = $cust_pkg->hash;
990 my $old_cust_pkg = new FS::cust_pkg \%hash;
996 unless ( $cust_pkg->setup ) {
997 my $setup_prog = $part_pkg->getfield('setup');
998 $setup_prog =~ /^(.*)$/ or do {
999 $dbh->rollback if $oldAutoCommit;
1000 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1004 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1006 #my $cpt = new Safe;
1007 ##$cpt->permit(); #what is necessary?
1008 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1009 #$setup = $cpt->reval($setup_prog);
1010 $setup = eval $setup_prog;
1011 unless ( defined($setup) ) {
1012 $dbh->rollback if $oldAutoCommit;
1013 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1014 "(expression $setup_prog): $@";
1016 $cust_pkg->setfield('setup',$time);
1017 $cust_pkg_mod_flag=1;
1023 if ( $part_pkg->getfield('freq') > 0 &&
1024 ! $cust_pkg->getfield('susp') &&
1025 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1027 my $recur_prog = $part_pkg->getfield('recur');
1028 $recur_prog =~ /^(.*)$/ or do {
1029 $dbh->rollback if $oldAutoCommit;
1030 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1034 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1036 # shared with $recur_prog
1037 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1039 #my $cpt = new Safe;
1040 ##$cpt->permit(); #what is necessary?
1041 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1042 #$recur = $cpt->reval($recur_prog);
1043 $recur = eval $recur_prog;
1044 unless ( defined($recur) ) {
1045 $dbh->rollback if $oldAutoCommit;
1046 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1047 "(expression $recur_prog): $@";
1049 #change this bit to use Date::Manip? CAREFUL with timezones (see
1050 # mailing list archive)
1051 my ($sec,$min,$hour,$mday,$mon,$year) =
1052 (localtime($sdate) )[0,1,2,3,4,5];
1054 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1055 # only for figuring next bill date, nothing else, so, reset $sdate again
1057 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1058 $cust_pkg->last_bill($sdate)
1059 if $cust_pkg->dbdef_table->column('last_bill');
1061 $mon += $part_pkg->freq;
1062 until ( $mon < 12 ) { $mon -= 12; $year++; }
1063 $cust_pkg->setfield('bill',
1064 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1065 $cust_pkg_mod_flag = 1;
1068 warn "\$setup is undefined" unless defined($setup);
1069 warn "\$recur is undefined" unless defined($recur);
1070 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1072 my $taxable_charged = 0;
1073 if ( $cust_pkg_mod_flag ) {
1074 $error=$cust_pkg->replace($old_cust_pkg);
1075 if ( $error ) { #just in case
1076 $dbh->rollback if $oldAutoCommit;
1077 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1079 $setup = sprintf( "%.2f", $setup );
1080 $recur = sprintf( "%.2f", $recur );
1082 $dbh->rollback if $oldAutoCommit;
1083 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1086 $dbh->rollback if $oldAutoCommit;
1087 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1089 if ( $setup > 0 || $recur > 0 ) {
1090 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1091 'pkgnum' => $cust_pkg->pkgnum,
1095 'edate' => $cust_pkg->bill,
1096 'details' => \@details,
1098 push @cust_bill_pkg, $cust_bill_pkg;
1099 $total_setup += $setup;
1100 $total_recur += $recur;
1101 $taxable_charged += $setup
1102 unless $part_pkg->setuptax =~ /^Y$/i;
1103 $taxable_charged += $recur
1104 unless $part_pkg->recurtax =~ /^Y$/i;
1106 unless ( $self->tax =~ /Y/i
1107 || $self->payby eq 'COMP'
1108 || $taxable_charged == 0 ) {
1110 my $cust_main_county = qsearchs('cust_main_county',{
1111 'state' => $self->state,
1112 'county' => $self->county,
1113 'country' => $self->country,
1114 'taxclass' => $part_pkg->taxclass,
1116 $cust_main_county ||= qsearchs('cust_main_county',{
1117 'state' => $self->state,
1118 'county' => $self->county,
1119 'country' => $self->country,
1122 unless ( $cust_main_county ) {
1123 $dbh->rollback if $oldAutoCommit;
1125 "fatal: can't find tax rate for state/county/country/taxclass ".
1126 join('/', ( map $self->$_(), qw(state county country) ),
1127 $part_pkg->taxclass ). "\n";
1130 if ( $cust_main_county->exempt_amount ) {
1131 my ($mon,$year) = (localtime($sdate) )[4,5];
1133 my $freq = $part_pkg->freq || 1;
1134 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1135 foreach my $which_month ( 1 .. $freq ) {
1137 'custnum' => $self->custnum,
1138 'taxnum' => $cust_main_county->taxnum,
1139 'year' => 1900+$year,
1142 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1143 until ( $mon < 13 ) { $mon -= 12; $year++; }
1144 my $cust_tax_exempt =
1145 qsearchs('cust_tax_exempt', \%hash)
1146 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1147 my $remaining_exemption = sprintf("%.2f",
1148 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1149 if ( $remaining_exemption > 0 ) {
1150 my $addl = $remaining_exemption > $taxable_per_month
1151 ? $taxable_per_month
1152 : $remaining_exemption;
1153 $taxable_charged -= $addl;
1154 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1155 $cust_tax_exempt->hash,
1156 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1158 $error = $new_cust_tax_exempt->exemptnum
1159 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1160 : $new_cust_tax_exempt->insert;
1162 $dbh->rollback if $oldAutoCommit;
1163 return "fatal: can't update cust_tax_exempt: $error";
1166 } # if $remaining_exemption > 0
1168 } #foreach $which_month
1170 } #if $cust_main_county->exempt_amount
1172 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1174 #$tax += $taxable_charged * $cust_main_county->tax / 100
1175 $tax{ $cust_main_county->taxname || 'Tax' } +=
1176 $taxable_charged * $cust_main_county->tax / 100
1178 } #unless $self->tax =~ /Y/i
1179 # || $self->payby eq 'COMP'
1180 # || $taxable_charged == 0
1182 } #if $setup > 0 || $recur > 0
1184 } #if $cust_pkg_mod_flag
1186 } #foreach my $cust_pkg
1188 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1189 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1191 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1192 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1196 # unless ( $self->tax =~ /Y/i
1197 # || $self->payby eq 'COMP'
1198 # || $taxable_charged == 0 ) {
1199 # my $cust_main_county = qsearchs('cust_main_county',{
1200 # 'state' => $self->state,
1201 # 'county' => $self->county,
1202 # 'country' => $self->country,
1203 # } ) or die "fatal: can't find tax rate for state/county/country ".
1204 # $self->state. "/". $self->county. "/". $self->country. "\n";
1205 # my $tax = sprintf( "%.2f",
1206 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1209 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1210 my $tax = sprintf("%.2f", $tax{$taxname} );
1211 $charged = sprintf( "%.2f", $charged+$tax );
1213 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1219 'itemdesc' => $taxname,
1221 push @cust_bill_pkg, $cust_bill_pkg;
1225 my $cust_bill = new FS::cust_bill ( {
1226 'custnum' => $self->custnum,
1228 'charged' => $charged,
1230 $error = $cust_bill->insert;
1232 $dbh->rollback if $oldAutoCommit;
1233 return "can't create invoice for customer #". $self->custnum. ": $error";
1236 my $invnum = $cust_bill->invnum;
1238 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1240 $cust_bill_pkg->invnum($invnum);
1241 $error = $cust_bill_pkg->insert;
1243 $dbh->rollback if $oldAutoCommit;
1244 return "can't create invoice line item for customer #". $self->custnum.
1249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1253 =item collect OPTIONS
1255 (Attempt to) collect money for this customer's outstanding invoices (see
1256 L<FS::cust_bill>). Usually used after the bill method.
1258 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1259 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1260 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1262 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1263 and the invoice events web interface.
1265 If there is an error, returns the error, otherwise returns false.
1267 Options are passed as name-value pairs.
1269 Currently available options are:
1271 invoice_time - Use this time when deciding when to print invoices and
1272 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>
1273 for conversion functions.
1275 retry_card - Retry cards even when not scheduled by invoice events.
1277 batch_card - This option is deprecated. See the invoice events web interface
1278 to control whether cards are batched or run against a realtime gateway.
1280 report_badcard - This option is deprecated.
1282 force_print - This option is deprecated; see the invoice events web interface.
1287 my( $self, %options ) = @_;
1288 my $invoice_time = $options{'invoice_time'} || time;
1291 local $SIG{HUP} = 'IGNORE';
1292 local $SIG{INT} = 'IGNORE';
1293 local $SIG{QUIT} = 'IGNORE';
1294 local $SIG{TERM} = 'IGNORE';
1295 local $SIG{TSTP} = 'IGNORE';
1296 local $SIG{PIPE} = 'IGNORE';
1298 my $oldAutoCommit = $FS::UID::AutoCommit;
1299 local $FS::UID::AutoCommit = 0;
1302 my $balance = $self->balance;
1303 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1304 unless ( $balance > 0 ) { #redundant?????
1305 $dbh->rollback if $oldAutoCommit; #hmm
1309 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1310 #false laziness w/replace
1311 foreach my $cust_bill_event (
1313 #$_->part_bill_event->plan eq 'realtime-card'
1314 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1315 && $_->status eq 'done'
1318 map { $_->cust_bill_event }
1319 grep { $_->cust_bill_event }
1320 $self->open_cust_bill
1322 my $error = $cust_bill_event->retry;
1324 $dbh->rollback if $oldAutoCommit;
1325 return "error scheduling invoice events for retry: $error";
1331 foreach my $cust_bill ( $self->cust_bill ) {
1333 #this has to be before next's
1334 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1338 $balance = sprintf( "%.2f", $balance - $amount );
1340 next unless $cust_bill->owed > 0;
1342 # don't try to charge for the same invoice if it's already in a batch
1343 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1345 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1347 next unless $amount > 0;
1350 foreach my $part_bill_event (
1351 sort { $a->seconds <=> $b->seconds
1352 || $a->weight <=> $b->weight
1353 || $a->eventpart <=> $b->eventpart }
1354 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1355 && ! qsearchs( 'cust_bill_event', {
1356 'invnum' => $cust_bill->invnum,
1357 'eventpart' => $_->eventpart,
1361 qsearch('part_bill_event', { 'payby' => $self->payby,
1362 'disabled' => '', } )
1365 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1367 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1369 my $cust_main = $self; #for callback
1370 my $error = eval $part_bill_event->eventcode;
1373 my $statustext = '';
1377 } elsif ( $error ) {
1379 $statustext = $error;
1384 #add cust_bill_event
1385 my $cust_bill_event = new FS::cust_bill_event {
1386 'invnum' => $cust_bill->invnum,
1387 'eventpart' => $part_bill_event->eventpart,
1388 #'_date' => $invoice_time,
1390 'status' => $status,
1391 'statustext' => $statustext,
1393 $error = $cust_bill_event->insert;
1395 #$dbh->rollback if $oldAutoCommit;
1396 #return "error: $error";
1398 # gah, even with transactions.
1399 $dbh->commit if $oldAutoCommit; #well.
1400 my $e = 'WARNING: Event run but database not updated - '.
1401 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1402 ', eventpart '. $part_bill_event->eventpart.
1413 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1418 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1420 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1421 via a Business::OnlinePayment realtime gateway. See
1422 L<http://420.am/business-onlinepayment> for supported gateways.
1424 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1426 Available options are: I<description>, I<invnum>, I<quiet>
1428 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1429 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1430 if set, will override the value from the customer record.
1432 I<description> is a free-text field passed to the gateway. It defaults to
1433 "Internet services".
1435 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1436 specified invoice. If you don't specify an I<invnum> you might want to
1437 call the B<apply_payments> method.
1439 I<quiet> can be set true to surpress email decline notices.
1441 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1446 my( $self, $method, $amount, %options ) = @_;
1448 warn "$self $method $amount\n";
1449 warn " $_ => $options{$_}\n" foreach keys %options;
1452 $options{'description'} ||= 'Internet services';
1455 die "Real-time processing not enabled\n"
1456 unless $conf->exists('business-onlinepayment');
1457 eval "use Business::OnlinePayment";
1461 $self->set( $_ => $options{$_} )
1462 foreach grep { exists($options{$_}) }
1463 qw( payname address1 address2 city state zip payinfo paydate );
1466 my $bop_config = 'business-onlinepayment';
1467 $bop_config .= '-ach'
1468 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1469 my ( $processor, $login, $password, $action, @bop_options ) =
1470 $conf->config($bop_config);
1471 $action ||= 'normal authorization';
1472 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1476 my $address = $self->address1;
1477 $address .= ", ". $self->address2 if $self->address2;
1479 my($payname, $payfirst, $paylast);
1480 if ( $self->payname && $method ne 'ECHECK' ) {
1481 $payname = $self->payname;
1482 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1483 or return "Illegal payname $payname";
1484 ($payfirst, $paylast) = ($1, $2);
1486 $payfirst = $self->getfield('first');
1487 $paylast = $self->getfield('last');
1488 $payname = "$payfirst $paylast";
1491 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1492 if ( $conf->exists('emailinvoiceauto')
1493 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1494 push @invoicing_list, $self->all_emails;
1496 my $email = $invoicing_list[0];
1499 if ( $method eq 'CC' ) {
1500 $content{card_number} = $self->payinfo;
1501 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1502 $content{expiration} = "$2/$1";
1503 } elsif ( $method eq 'ECHECK' ) {
1504 my($account_number,$routing_code) = $self->payinfo;
1505 ( $content{account_number}, $content{routing_code} ) =
1506 split('@', $self->payinfo);
1507 $content{bank_name} = $self->payname;
1508 } elsif ( $method eq 'LEC' ) {
1509 $content{phone} = $self->payinfo;
1514 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1517 new Business::OnlinePayment( $processor, @bop_options );
1518 $transaction->content(
1521 'password' => $password,
1522 'action' => $action1,
1523 'description' => $options{'description'},
1524 'amount' => $amount,
1525 'invoice_number' => $options{'invnum'},
1526 'customer_id' => $self->custnum,
1527 'last_name' => $paylast,
1528 'first_name' => $payfirst,
1530 'address' => $address,
1531 'city' => $self->city,
1532 'state' => $self->state,
1533 'zip' => $self->zip,
1534 'country' => $self->country,
1535 'referer' => 'http://cleanwhisker.420.am/',
1537 'phone' => $self->daytime || $self->night,
1540 $transaction->submit();
1542 if ( $transaction->is_success() && $action2 ) {
1543 my $auth = $transaction->authorization;
1544 my $ordernum = $transaction->can('order_number')
1545 ? $transaction->order_number
1549 new Business::OnlinePayment( $processor, @bop_options );
1556 password => $password,
1557 order_number => $ordernum,
1559 authorization => $auth,
1560 description => $options{'description'},
1563 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1564 transaction_sequence_num local_transaction_date
1565 local_transaction_time AVS_result_code )) {
1566 $capture{$field} = $transaction->$field() if $transaction->can($field);
1569 $capture->content( %capture );
1573 unless ( $capture->is_success ) {
1574 my $e = "Authorization sucessful but capture failed, custnum #".
1575 $self->custnum. ': '. $capture->result_code.
1576 ": ". $capture->error_message;
1584 if ( $transaction->is_success() ) {
1586 my %method2payby = (
1592 my $cust_pay = new FS::cust_pay ( {
1593 'custnum' => $self->custnum,
1594 'invnum' => $options{'invnum'},
1597 'payby' => $method2payby{$method},
1598 'payinfo' => $self->payinfo,
1599 'paybatch' => "$processor:". $transaction->authorization,
1601 my $error = $cust_pay->insert;
1603 # gah, even with transactions.
1604 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1605 'error applying payment, invnum #' . $self->invnum.
1606 " ($processor): $error";
1615 my $perror = "$processor error: ". $transaction->error_message;
1617 if ( !$options{'quiet'} && $conf->exists('emaildecline')
1618 && grep { $_ ne 'POST' } $self->invoicing_list
1620 my @templ = $conf->config('declinetemplate');
1621 my $template = new Text::Template (
1623 SOURCE => [ map "$_\n", @templ ],
1624 ) or return "($perror) can't create template: $Text::Template::ERROR";
1625 $template->compile()
1626 or return "($perror) can't compile template: $Text::Template::ERROR";
1628 my $templ_hash = { error => $transaction->error_message };
1630 my $error = send_email(
1631 'from' => $conf->config('invoice_from'),
1632 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1633 'subject' => 'Your payment could not be processed',
1634 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1637 $perror .= " (also received error sending decline notification: $error)"
1649 Returns the total owed for this customer on all invoices
1650 (see L<FS::cust_bill/owed>).
1656 $self->total_owed_date(2145859200); #12/31/2037
1659 =item total_owed_date TIME
1661 Returns the total owed for this customer on all invoices with date earlier than
1662 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1663 see L<Time::Local> and L<Date::Parse> for conversion functions.
1667 sub total_owed_date {
1671 foreach my $cust_bill (
1672 grep { $_->_date <= $time }
1673 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1675 $total_bill += $cust_bill->owed;
1677 sprintf( "%.2f", $total_bill );
1682 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1683 to outstanding invoice balances in chronological order and returns the value
1684 of any remaining unapplied credits available for refund
1685 (see L<FS::cust_refund>).
1692 return 0 unless $self->total_credited;
1694 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1695 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1697 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1698 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1702 foreach my $cust_bill ( @invoices ) {
1705 if ( !defined($credit) || $credit->credited == 0) {
1706 $credit = pop @credits or last;
1709 if ($cust_bill->owed >= $credit->credited) {
1710 $amount=$credit->credited;
1712 $amount=$cust_bill->owed;
1715 my $cust_credit_bill = new FS::cust_credit_bill ( {
1716 'crednum' => $credit->crednum,
1717 'invnum' => $cust_bill->invnum,
1718 'amount' => $amount,
1720 my $error = $cust_credit_bill->insert;
1721 die $error if $error;
1723 redo if ($cust_bill->owed > 0);
1727 return $self->total_credited;
1730 =item apply_payments
1732 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1733 to outstanding invoice balances in chronological order.
1735 #and returns the value of any remaining unapplied payments.
1739 sub apply_payments {
1744 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1745 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1747 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1748 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1752 foreach my $cust_bill ( @invoices ) {
1755 if ( !defined($payment) || $payment->unapplied == 0 ) {
1756 $payment = pop @payments or last;
1759 if ( $cust_bill->owed >= $payment->unapplied ) {
1760 $amount = $payment->unapplied;
1762 $amount = $cust_bill->owed;
1765 my $cust_bill_pay = new FS::cust_bill_pay ( {
1766 'paynum' => $payment->paynum,
1767 'invnum' => $cust_bill->invnum,
1768 'amount' => $amount,
1770 my $error = $cust_bill_pay->insert;
1771 die $error if $error;
1773 redo if ( $cust_bill->owed > 0);
1777 return $self->total_unapplied_payments;
1780 =item total_credited
1782 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1783 customer. See L<FS::cust_credit/credited>.
1787 sub total_credited {
1789 my $total_credit = 0;
1790 foreach my $cust_credit ( qsearch('cust_credit', {
1791 'custnum' => $self->custnum,
1793 $total_credit += $cust_credit->credited;
1795 sprintf( "%.2f", $total_credit );
1798 =item total_unapplied_payments
1800 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1801 See L<FS::cust_pay/unapplied>.
1805 sub total_unapplied_payments {
1807 my $total_unapplied = 0;
1808 foreach my $cust_pay ( qsearch('cust_pay', {
1809 'custnum' => $self->custnum,
1811 $total_unapplied += $cust_pay->unapplied;
1813 sprintf( "%.2f", $total_unapplied );
1818 Returns the balance for this customer (total_owed minus total_credited
1819 minus total_unapplied_payments).
1826 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1830 =item balance_date TIME
1832 Returns the balance for this customer, only considering invoices with date
1833 earlier than TIME (total_owed_date minus total_credited minus
1834 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1835 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1844 $self->total_owed_date($time)
1845 - $self->total_credited
1846 - $self->total_unapplied_payments
1850 =item invoicing_list [ ARRAYREF ]
1852 If an arguement is given, sets these email addresses as invoice recipients
1853 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1854 (except as warnings), so use check_invoicing_list first.
1856 Returns a list of email addresses (with svcnum entries expanded).
1858 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1859 check it without disturbing anything by passing nothing.
1861 This interface may change in the future.
1865 sub invoicing_list {
1866 my( $self, $arrayref ) = @_;
1868 my @cust_main_invoice;
1869 if ( $self->custnum ) {
1870 @cust_main_invoice =
1871 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1873 @cust_main_invoice = ();
1875 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1876 #warn $cust_main_invoice->destnum;
1877 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1878 #warn $cust_main_invoice->destnum;
1879 my $error = $cust_main_invoice->delete;
1880 warn $error if $error;
1883 if ( $self->custnum ) {
1884 @cust_main_invoice =
1885 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1887 @cust_main_invoice = ();
1889 my %seen = map { $_->address => 1 } @cust_main_invoice;
1890 foreach my $address ( @{$arrayref} ) {
1891 next if exists $seen{$address} && $seen{$address};
1892 $seen{$address} = 1;
1893 my $cust_main_invoice = new FS::cust_main_invoice ( {
1894 'custnum' => $self->custnum,
1897 my $error = $cust_main_invoice->insert;
1898 warn $error if $error;
1901 if ( $self->custnum ) {
1903 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1909 =item check_invoicing_list ARRAYREF
1911 Checks these arguements as valid input for the invoicing_list method. If there
1912 is an error, returns the error, otherwise returns false.
1916 sub check_invoicing_list {
1917 my( $self, $arrayref ) = @_;
1918 foreach my $address ( @{$arrayref} ) {
1919 my $cust_main_invoice = new FS::cust_main_invoice ( {
1920 'custnum' => $self->custnum,
1923 my $error = $self->custnum
1924 ? $cust_main_invoice->check
1925 : $cust_main_invoice->checkdest
1927 return $error if $error;
1932 =item set_default_invoicing_list
1934 Sets the invoicing list to all accounts associated with this customer,
1935 overwriting any previous invoicing list.
1939 sub set_default_invoicing_list {
1941 $self->invoicing_list($self->all_emails);
1946 Returns the email addresses of all accounts provisioned for this customer.
1953 foreach my $cust_pkg ( $self->all_pkgs ) {
1954 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1956 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1957 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1959 $list{$_}=1 foreach map { $_->email } @svc_acct;
1964 =item invoicing_list_addpost
1966 Adds postal invoicing to this customer. If this customer is already configured
1967 to receive postal invoices, does nothing.
1971 sub invoicing_list_addpost {
1973 return if grep { $_ eq 'POST' } $self->invoicing_list;
1974 my @invoicing_list = $self->invoicing_list;
1975 push @invoicing_list, 'POST';
1976 $self->invoicing_list(\@invoicing_list);
1979 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1981 Returns an array of customers referred by this customer (referral_custnum set
1982 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1983 customers referred by customers referred by this customer and so on, inclusive.
1984 The default behavior is DEPTH 1 (no recursion).
1988 sub referral_cust_main {
1990 my $depth = @_ ? shift : 1;
1991 my $exclude = @_ ? shift : {};
1994 map { $exclude->{$_->custnum}++; $_; }
1995 grep { ! $exclude->{ $_->custnum } }
1996 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2000 map { $_->referral_cust_main($depth-1, $exclude) }
2007 =item referral_cust_main_ncancelled
2009 Same as referral_cust_main, except only returns customers with uncancelled
2014 sub referral_cust_main_ncancelled {
2016 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2019 =item referral_cust_pkg [ DEPTH ]
2021 Like referral_cust_main, except returns a flat list of all unsuspended (and
2022 uncancelled) packages for each customer. The number of items in this list may
2023 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2027 sub referral_cust_pkg {
2029 my $depth = @_ ? shift : 1;
2031 map { $_->unsuspended_pkgs }
2032 grep { $_->unsuspended_pkgs }
2033 $self->referral_cust_main($depth);
2036 =item credit AMOUNT, REASON
2038 Applies a credit to this customer. If there is an error, returns the error,
2039 otherwise returns false.
2044 my( $self, $amount, $reason ) = @_;
2045 my $cust_credit = new FS::cust_credit {
2046 'custnum' => $self->custnum,
2047 'amount' => $amount,
2048 'reason' => $reason,
2050 $cust_credit->insert;
2053 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2055 Creates a one-time charge for this customer. If there is an error, returns
2056 the error, otherwise returns false.
2061 my ( $self, $amount ) = ( shift, shift );
2062 my $pkg = @_ ? shift : 'One-time charge';
2063 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2064 my $taxclass = @_ ? shift : '';
2066 local $SIG{HUP} = 'IGNORE';
2067 local $SIG{INT} = 'IGNORE';
2068 local $SIG{QUIT} = 'IGNORE';
2069 local $SIG{TERM} = 'IGNORE';
2070 local $SIG{TSTP} = 'IGNORE';
2071 local $SIG{PIPE} = 'IGNORE';
2073 my $oldAutoCommit = $FS::UID::AutoCommit;
2074 local $FS::UID::AutoCommit = 0;
2077 my $part_pkg = new FS::part_pkg ( {
2079 'comment' => $comment,
2084 'taxclass' => $taxclass,
2087 my $error = $part_pkg->insert;
2089 $dbh->rollback if $oldAutoCommit;
2093 my $pkgpart = $part_pkg->pkgpart;
2094 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2095 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2096 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2097 $error = $type_pkgs->insert;
2099 $dbh->rollback if $oldAutoCommit;
2104 my $cust_pkg = new FS::cust_pkg ( {
2105 'custnum' => $self->custnum,
2106 'pkgpart' => $pkgpart,
2109 $error = $cust_pkg->insert;
2111 $dbh->rollback if $oldAutoCommit;
2115 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2122 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2128 sort { $a->_date <=> $b->_date }
2129 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2132 =item open_cust_bill
2134 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2139 sub open_cust_bill {
2141 grep { $_->owed > 0 } $self->cust_bill;
2150 =item check_and_rebuild_fuzzyfiles
2154 sub check_and_rebuild_fuzzyfiles {
2155 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2156 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2157 or &rebuild_fuzzyfiles;
2160 =item rebuild_fuzzyfiles
2164 sub rebuild_fuzzyfiles {
2166 use Fcntl qw(:flock);
2168 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2172 open(LASTLOCK,">>$dir/cust_main.last")
2173 or die "can't open $dir/cust_main.last: $!";
2174 flock(LASTLOCK,LOCK_EX)
2175 or die "can't lock $dir/cust_main.last: $!";
2177 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2179 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2180 if defined dbdef->table('cust_main')->column('ship_last');
2182 open (LASTCACHE,">$dir/cust_main.last.tmp")
2183 or die "can't open $dir/cust_main.last.tmp: $!";
2184 print LASTCACHE join("\n", @all_last), "\n";
2185 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2187 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2192 open(COMPANYLOCK,">>$dir/cust_main.company")
2193 or die "can't open $dir/cust_main.company: $!";
2194 flock(COMPANYLOCK,LOCK_EX)
2195 or die "can't lock $dir/cust_main.company: $!";
2197 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2199 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2200 if defined dbdef->table('cust_main')->column('ship_last');
2202 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2203 or die "can't open $dir/cust_main.company.tmp: $!";
2204 print COMPANYCACHE join("\n", @all_company), "\n";
2205 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2207 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2217 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2218 open(LASTCACHE,"<$dir/cust_main.last")
2219 or die "can't open $dir/cust_main.last: $!";
2220 my @array = map { chomp; $_; } <LASTCACHE>;
2230 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2231 open(COMPANYCACHE,"<$dir/cust_main.company")
2232 or die "can't open $dir/cust_main.last: $!";
2233 my @array = map { chomp; $_; } <COMPANYCACHE>;
2238 =item append_fuzzyfiles LASTNAME COMPANY
2242 sub append_fuzzyfiles {
2243 my( $last, $company ) = @_;
2245 &check_and_rebuild_fuzzyfiles;
2247 use Fcntl qw(:flock);
2249 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2253 open(LAST,">>$dir/cust_main.last")
2254 or die "can't open $dir/cust_main.last: $!";
2256 or die "can't lock $dir/cust_main.last: $!";
2258 print LAST "$last\n";
2261 or die "can't unlock $dir/cust_main.last: $!";
2267 open(COMPANY,">>$dir/cust_main.company")
2268 or die "can't open $dir/cust_main.company: $!";
2269 flock(COMPANY,LOCK_EX)
2270 or die "can't lock $dir/cust_main.company: $!";
2272 print COMPANY "$company\n";
2274 flock(COMPANY,LOCK_UN)
2275 or die "can't unlock $dir/cust_main.company: $!";
2289 #warn join('-',keys %$param);
2290 my $fh = $param->{filehandle};
2291 my $agentnum = $param->{agentnum};
2292 my $refnum = $param->{refnum};
2293 my $pkgpart = $param->{pkgpart};
2294 my @fields = @{$param->{fields}};
2296 eval "use Date::Parse;";
2298 eval "use Text::CSV_XS;";
2301 my $csv = new Text::CSV_XS;
2308 local $SIG{HUP} = 'IGNORE';
2309 local $SIG{INT} = 'IGNORE';
2310 local $SIG{QUIT} = 'IGNORE';
2311 local $SIG{TERM} = 'IGNORE';
2312 local $SIG{TSTP} = 'IGNORE';
2313 local $SIG{PIPE} = 'IGNORE';
2315 my $oldAutoCommit = $FS::UID::AutoCommit;
2316 local $FS::UID::AutoCommit = 0;
2319 #while ( $columns = $csv->getline($fh) ) {
2321 while ( defined($line=<$fh>) ) {
2323 $csv->parse($line) or do {
2324 $dbh->rollback if $oldAutoCommit;
2325 return "can't parse: ". $csv->error_input();
2328 my @columns = $csv->fields();
2329 #warn join('-',@columns);
2332 agentnum => $agentnum,
2334 country => 'US', #default
2335 payby => 'BILL', #default
2336 paydate => '12/2037', #default
2338 my $billtime = time;
2339 my %cust_pkg = ( pkgpart => $pkgpart );
2340 foreach my $field ( @fields ) {
2341 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2342 #$cust_pkg{$1} = str2time( shift @$columns );
2343 if ( $1 eq 'setup' ) {
2344 $billtime = str2time(shift @columns);
2346 $cust_pkg{$1} = str2time( shift @columns );
2349 #$cust_main{$field} = shift @$columns;
2350 $cust_main{$field} = shift @columns;
2354 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2355 my $cust_main = new FS::cust_main ( \%cust_main );
2357 tie my %hash, 'Tie::RefHash'; #this part is important
2358 $hash{$cust_pkg} = [] if $pkgpart;
2359 my $error = $cust_main->insert( \%hash );
2362 $dbh->rollback if $oldAutoCommit;
2363 return "can't insert customer for $line: $error";
2366 #false laziness w/bill.cgi
2367 $error = $cust_main->bill( 'time' => $billtime );
2369 $dbh->rollback if $oldAutoCommit;
2370 return "can't bill customer for $line: $error";
2373 $cust_main->apply_payments;
2374 $cust_main->apply_credits;
2376 $error = $cust_main->collect();
2378 $dbh->rollback if $oldAutoCommit;
2379 return "can't collect customer for $line: $error";
2385 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2387 return "Empty file!" unless $imported;
2399 #warn join('-',keys %$param);
2400 my $fh = $param->{filehandle};
2401 my @fields = @{$param->{fields}};
2403 eval "use Date::Parse;";
2405 eval "use Text::CSV_XS;";
2408 my $csv = new Text::CSV_XS;
2415 local $SIG{HUP} = 'IGNORE';
2416 local $SIG{INT} = 'IGNORE';
2417 local $SIG{QUIT} = 'IGNORE';
2418 local $SIG{TERM} = 'IGNORE';
2419 local $SIG{TSTP} = 'IGNORE';
2420 local $SIG{PIPE} = 'IGNORE';
2422 my $oldAutoCommit = $FS::UID::AutoCommit;
2423 local $FS::UID::AutoCommit = 0;
2426 #while ( $columns = $csv->getline($fh) ) {
2428 while ( defined($line=<$fh>) ) {
2430 $csv->parse($line) or do {
2431 $dbh->rollback if $oldAutoCommit;
2432 return "can't parse: ". $csv->error_input();
2435 my @columns = $csv->fields();
2436 #warn join('-',@columns);
2439 foreach my $field ( @fields ) {
2440 $row{$field} = shift @columns;
2443 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2444 unless ( $cust_main ) {
2445 $dbh->rollback if $oldAutoCommit;
2446 return "unknown custnum $row{'custnum'}";
2449 if ( $row{'amount'} > 0 ) {
2450 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2452 $dbh->rollback if $oldAutoCommit;
2456 } elsif ( $row{'amount'} < 0 ) {
2457 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2460 $dbh->rollback if $oldAutoCommit;
2470 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2472 return "Empty file!" unless $imported;
2484 The delete method should possibly take an FS::cust_main object reference
2485 instead of a scalar customer number.
2487 Bill and collect options should probably be passed as references instead of a
2490 There should probably be a configuration file with a list of allowed credit
2493 No multiple currency support (probably a larger project than just this module).
2497 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2498 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2499 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.