4 use vars qw( @ISA $conf $Debug $import );
8 eval "use Time::Local;";
9 die "Time::Local version 1.05 with Perl versions before 5.6"
10 if $] < 5.006 && !defined($Time::Local::VERSION);
11 eval "use Time::Local qw(timelocal_nocheck);";
15 use Business::CreditCard;
16 use FS::UID qw( getotaker dbh );
17 use FS::Record qw( qsearchs qsearch dbdef );
18 use FS::Misc qw( send_email );
21 use FS::cust_bill_pkg;
24 use FS::part_referral;
25 use FS::cust_main_county;
27 use FS::cust_main_invoice;
28 use FS::cust_credit_bill;
29 use FS::cust_bill_pay;
30 use FS::prepay_credit;
33 use FS::part_bill_event;
34 use FS::cust_bill_event;
35 use FS::cust_tax_exempt;
37 use FS::Msgcat qw(gettext);
39 @ISA = qw( FS::Record );
46 #ask FS::UID to run this stuff for us later
47 #$FS::UID::callback{'FS::cust_main'} = sub {
48 install_callback FS::UID sub {
50 #yes, need it for stuff below (prolly should be cached)
55 my ( $hashref, $cache ) = @_;
56 if ( exists $hashref->{'pkgnum'} ) {
57 # #@{ $self->{'_pkgnum'} } = ();
58 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
59 $self->{'_pkgnum'} = $subcache;
60 #push @{ $self->{'_pkgnum'} },
61 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
67 FS::cust_main - Object methods for cust_main records
73 $record = new FS::cust_main \%hash;
74 $record = new FS::cust_main { 'column' => 'value' };
76 $error = $record->insert;
78 $error = $new_record->replace($old_record);
80 $error = $record->delete;
82 $error = $record->check;
84 @cust_pkg = $record->all_pkgs;
86 @cust_pkg = $record->ncancelled_pkgs;
88 @cust_pkg = $record->suspended_pkgs;
90 $error = $record->bill;
91 $error = $record->bill %options;
92 $error = $record->bill 'time' => $time;
94 $error = $record->collect;
95 $error = $record->collect %options;
96 $error = $record->collect 'invoice_time' => $time,
97 'batch_card' => 'yes',
98 'report_badcard' => 'yes',
103 An FS::cust_main object represents a customer. FS::cust_main inherits from
104 FS::Record. The following fields are currently supported:
108 =item custnum - primary key (assigned automatically for new customers)
110 =item agentnum - agent (see L<FS::agent>)
112 =item refnum - Advertising source (see L<FS::part_referral>)
118 =item ss - social security number (optional)
120 =item company - (optional)
124 =item address2 - (optional)
128 =item county - (optional, see L<FS::cust_main_county>)
130 =item state - (see L<FS::cust_main_county>)
134 =item country - (see L<FS::cust_main_county>)
136 =item daytime - phone (optional)
138 =item night - phone (optional)
140 =item fax - phone (optional)
142 =item ship_first - name
144 =item ship_last - name
146 =item ship_company - (optional)
150 =item ship_address2 - (optional)
154 =item ship_county - (optional, see L<FS::cust_main_county>)
156 =item ship_state - (see L<FS::cust_main_county>)
160 =item ship_country - (see L<FS::cust_main_county>)
162 =item ship_daytime - phone (optional)
164 =item ship_night - phone (optional)
166 =item ship_fax - phone (optional)
168 =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>)
170 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
172 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
174 =item payname - name on card or billing name
176 =item tax - tax exempt, empty or `Y'
178 =item otaker - order taker (assigned automatically, see L<FS::UID>)
180 =item comments - comments (optional)
182 =item referral_custnum - referring customer number
192 Creates a new customer. To add the customer to the database, see L<"insert">.
194 Note that this stores the hash reference, not a distinct copy of the hash it
195 points to. You can ask the object for a copy with the I<hash> method.
199 sub table { 'cust_main'; }
201 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
203 Adds this customer to the database. If there is an error, returns the error,
204 otherwise returns false.
206 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
207 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
208 are inserted atomicly, or the transaction is rolled back. Passing an empty
209 hash reference is equivalent to not supplying this parameter. There should be
210 a better explanation of this, but until then, here's an example:
213 tie %hash, 'Tie::RefHash'; #this part is important
215 $cust_pkg => [ $svc_acct ],
218 $cust_main->insert( \%hash );
220 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
221 be set as the invoicing list (see L<"invoicing_list">). Errors return as
222 expected and rollback the entire transaction; it is not necessary to call
223 check_invoicing_list first. The invoicing_list is set after the records in the
224 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
225 invoicing_list destination to the newly-created svc_acct. Here's an example:
227 $cust_main->insert( {}, [ $email, 'POST' ] );
233 my $cust_pkgs = @_ ? shift : {};
234 my $invoicing_list = @_ ? shift : '';
236 local $SIG{HUP} = 'IGNORE';
237 local $SIG{INT} = 'IGNORE';
238 local $SIG{QUIT} = 'IGNORE';
239 local $SIG{TERM} = 'IGNORE';
240 local $SIG{TSTP} = 'IGNORE';
241 local $SIG{PIPE} = 'IGNORE';
243 my $oldAutoCommit = $FS::UID::AutoCommit;
244 local $FS::UID::AutoCommit = 0;
249 if ( $self->payby eq 'PREPAY' ) {
250 $self->payby('BILL');
251 my $prepay_credit = qsearchs(
253 { 'identifier' => $self->payinfo },
257 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
258 unless $prepay_credit;
259 $amount = $prepay_credit->amount;
260 $seconds = $prepay_credit->seconds;
261 my $error = $prepay_credit->delete;
263 $dbh->rollback if $oldAutoCommit;
264 return "removing prepay_credit (transaction rolled back): $error";
268 my $error = $self->SUPER::insert;
270 $dbh->rollback if $oldAutoCommit;
271 #return "inserting cust_main record (transaction rolled back): $error";
276 if ( $invoicing_list ) {
277 $error = $self->check_invoicing_list( $invoicing_list );
279 $dbh->rollback if $oldAutoCommit;
280 return "checking invoicing_list (transaction rolled back): $error";
282 $self->invoicing_list( $invoicing_list );
286 $error = $self->order_pkgs($cust_pkgs, \$seconds);
288 $dbh->rollback if $oldAutoCommit;
293 $dbh->rollback if $oldAutoCommit;
294 return "No svc_acct record to apply pre-paid time";
298 my $cust_credit = new FS::cust_credit {
299 'custnum' => $self->custnum,
302 $error = $cust_credit->insert;
304 $dbh->rollback if $oldAutoCommit;
305 return "inserting credit (transaction rolled back): $error";
309 #false laziness with sub replace
310 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
311 $error = $queue->insert($self->getfield('last'), $self->company);
313 $dbh->rollback if $oldAutoCommit;
314 return "queueing job (transaction rolled back): $error";
317 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
318 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
319 $error = $queue->insert($self->getfield('last'), $self->company);
321 $dbh->rollback if $oldAutoCommit;
322 return "queueing job (transaction rolled back): $error";
327 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
334 document me. like ->insert(%cust_pkg) on an existing record
340 my $cust_pkgs = shift;
343 local $SIG{HUP} = 'IGNORE';
344 local $SIG{INT} = 'IGNORE';
345 local $SIG{QUIT} = 'IGNORE';
346 local $SIG{TERM} = 'IGNORE';
347 local $SIG{TSTP} = 'IGNORE';
348 local $SIG{PIPE} = 'IGNORE';
350 my $oldAutoCommit = $FS::UID::AutoCommit;
351 local $FS::UID::AutoCommit = 0;
354 foreach my $cust_pkg ( keys %$cust_pkgs ) {
355 $cust_pkg->custnum( $self->custnum );
356 my $error = $cust_pkg->insert;
358 $dbh->rollback if $oldAutoCommit;
359 return "inserting cust_pkg (transaction rolled back): $error";
361 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
362 $svc_something->pkgnum( $cust_pkg->pkgnum );
363 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
364 $svc_something->seconds( $svc_something->seconds + $$seconds );
367 $error = $svc_something->insert;
369 $dbh->rollback if $oldAutoCommit;
370 #return "inserting svc_ (transaction rolled back): $error";
376 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
380 =item delete NEW_CUSTNUM
382 This deletes the customer. If there is an error, returns the error, otherwise
385 This will completely remove all traces of the customer record. This is not
386 what you want when a customer cancels service; for that, cancel all of the
387 customer's packages (see L<FS::cust_pkg/cancel>).
389 If the customer has any uncancelled packages, you need to pass a new (valid)
390 customer number for those packages to be transferred to. Cancelled packages
391 will be deleted. Did I mention that this is NOT what you want when a customer
392 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
394 You can't delete a customer with invoices (see L<FS::cust_bill>),
395 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
396 refunds (see L<FS::cust_refund>).
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 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
415 $dbh->rollback if $oldAutoCommit;
416 return "Can't delete a customer with invoices";
418 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
419 $dbh->rollback if $oldAutoCommit;
420 return "Can't delete a customer with credits";
422 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
423 $dbh->rollback if $oldAutoCommit;
424 return "Can't delete a customer with payments";
426 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
427 $dbh->rollback if $oldAutoCommit;
428 return "Can't delete a customer with refunds";
431 my @cust_pkg = $self->ncancelled_pkgs;
433 my $new_custnum = shift;
434 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
435 $dbh->rollback if $oldAutoCommit;
436 return "Invalid new customer number: $new_custnum";
438 foreach my $cust_pkg ( @cust_pkg ) {
439 my %hash = $cust_pkg->hash;
440 $hash{'custnum'} = $new_custnum;
441 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
442 my $error = $new_cust_pkg->replace($cust_pkg);
444 $dbh->rollback if $oldAutoCommit;
449 my @cancelled_cust_pkg = $self->all_pkgs;
450 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
451 my $error = $cust_pkg->delete;
453 $dbh->rollback if $oldAutoCommit;
458 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
459 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
461 my $error = $cust_main_invoice->delete;
463 $dbh->rollback if $oldAutoCommit;
468 my $error = $self->SUPER::delete;
470 $dbh->rollback if $oldAutoCommit;
474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
479 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
481 Replaces the OLD_RECORD with this one in the database. If there is an error,
482 returns the error, otherwise returns false.
484 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
485 be set as the invoicing list (see L<"invoicing_list">). Errors return as
486 expected and rollback the entire transaction; it is not necessary to call
487 check_invoicing_list first. Here's an example:
489 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
498 local $SIG{HUP} = 'IGNORE';
499 local $SIG{INT} = 'IGNORE';
500 local $SIG{QUIT} = 'IGNORE';
501 local $SIG{TERM} = 'IGNORE';
502 local $SIG{TSTP} = 'IGNORE';
503 local $SIG{PIPE} = 'IGNORE';
505 my $oldAutoCommit = $FS::UID::AutoCommit;
506 local $FS::UID::AutoCommit = 0;
509 my $error = $self->SUPER::replace($old);
512 $dbh->rollback if $oldAutoCommit;
516 if ( @param ) { # INVOICING_LIST_ARYREF
517 my $invoicing_list = shift @param;
518 $error = $self->check_invoicing_list( $invoicing_list );
520 $dbh->rollback if $oldAutoCommit;
523 $self->invoicing_list( $invoicing_list );
526 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
527 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
528 # card/check info has changed, want to retry realtime_card invoice events
529 #false laziness w/collect
530 foreach my $cust_bill_event (
532 #$_->part_bill_event->plan eq 'realtime-card'
533 $_->part_bill_event->eventcode =~
534 /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
535 && $_->status eq 'done'
538 map { $_->cust_bill_event }
539 grep { $_->cust_bill_event }
540 $self->open_cust_bill
543 my $error = $cust_bill_event->retry;
545 $dbh->rollback if $oldAutoCommit;
546 return "error scheduling invoice events for retry: $error";
553 #false laziness with sub insert
554 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
555 $error = $queue->insert($self->getfield('last'), $self->company);
557 $dbh->rollback if $oldAutoCommit;
558 return "queueing job (transaction rolled back): $error";
561 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
562 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
563 $error = $queue->insert($self->getfield('last'), $self->company);
565 $dbh->rollback if $oldAutoCommit;
566 return "queueing job (transaction rolled back): $error";
571 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
578 Checks all fields to make sure this is a valid customer record. If there is
579 an error, returns the error, otherwise returns false. Called by the insert
587 #warn "BEFORE: \n". $self->_dump;
590 $self->ut_numbern('custnum')
591 || $self->ut_number('agentnum')
592 || $self->ut_number('refnum')
593 || $self->ut_name('last')
594 || $self->ut_name('first')
595 || $self->ut_textn('company')
596 || $self->ut_text('address1')
597 || $self->ut_textn('address2')
598 || $self->ut_text('city')
599 || $self->ut_textn('county')
600 || $self->ut_textn('state')
601 || $self->ut_country('country')
602 || $self->ut_anything('comments')
603 || $self->ut_numbern('referral_custnum')
605 #barf. need message catalogs. i18n. etc.
606 $error .= "Please select a advertising source."
607 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
608 return $error if $error;
610 return "Unknown agent"
611 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
613 return "Unknown refnum"
614 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
616 return "Unknown referring custnum ". $self->referral_custnum
617 unless ! $self->referral_custnum
618 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
620 if ( $self->ss eq '' ) {
625 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
626 or return "Illegal social security number: ". $self->ss;
627 $self->ss("$1-$2-$3");
631 # bad idea to disable, causes billing to fail because of no tax rates later
632 # unless ( $import ) {
633 unless ( qsearch('cust_main_county', {
634 'country' => $self->country,
637 return "Unknown state/county/country: ".
638 $self->state. "/". $self->county. "/". $self->country
639 unless qsearch('cust_main_county',{
640 'state' => $self->state,
641 'county' => $self->county,
642 'country' => $self->country,
648 $self->ut_phonen('daytime', $self->country)
649 || $self->ut_phonen('night', $self->country)
650 || $self->ut_phonen('fax', $self->country)
651 || $self->ut_zip('zip', $self->country)
653 return $error if $error;
656 last first company address1 address2 city county state zip
657 country daytime night fax
660 if ( defined $self->dbdef_table->column('ship_last') ) {
661 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
663 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
667 $self->ut_name('ship_last')
668 || $self->ut_name('ship_first')
669 || $self->ut_textn('ship_company')
670 || $self->ut_text('ship_address1')
671 || $self->ut_textn('ship_address2')
672 || $self->ut_text('ship_city')
673 || $self->ut_textn('ship_county')
674 || $self->ut_textn('ship_state')
675 || $self->ut_country('ship_country')
677 return $error if $error;
679 #false laziness with above
680 unless ( qsearchs('cust_main_county', {
681 'country' => $self->ship_country,
684 return "Unknown ship_state/ship_county/ship_country: ".
685 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
686 unless qsearchs('cust_main_county',{
687 'state' => $self->ship_state,
688 'county' => $self->ship_county,
689 'country' => $self->ship_country,
695 $self->ut_phonen('ship_daytime', $self->ship_country)
696 || $self->ut_phonen('ship_night', $self->ship_country)
697 || $self->ut_phonen('ship_fax', $self->ship_country)
698 || $self->ut_zip('ship_zip', $self->ship_country)
700 return $error if $error;
702 } else { # ship_ info eq billing info, so don't store dup info in database
703 $self->setfield("ship_$_", '')
704 foreach qw( last first company address1 address2 city county state zip
705 country daytime night fax );
709 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
710 or return "Illegal payby: ". $self->payby;
713 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
715 my $payinfo = $self->payinfo;
717 $payinfo =~ /^(\d{13,16})$/
718 or return gettext('invalid_card'); # . ": ". $self->payinfo;
720 $self->payinfo($payinfo);
722 or return gettext('invalid_card'); # . ": ". $self->payinfo;
723 return gettext('unknown_card_type')
724 if cardtype($self->payinfo) eq "Unknown";
726 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
728 my $payinfo = $self->payinfo;
729 $payinfo =~ s/[^\d\@]//g;
730 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
732 $self->payinfo($payinfo);
734 } elsif ( $self->payby eq 'LECB' ) {
736 my $payinfo = $self->payinfo;
738 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
740 $self->payinfo($payinfo);
742 } elsif ( $self->payby eq 'BILL' ) {
744 $error = $self->ut_textn('payinfo');
745 return "Illegal P.O. number: ". $self->payinfo if $error;
747 } elsif ( $self->payby eq 'COMP' ) {
749 $error = $self->ut_textn('payinfo');
750 return "Illegal comp account issuer: ". $self->payinfo if $error;
752 } elsif ( $self->payby eq 'PREPAY' ) {
754 my $payinfo = $self->payinfo;
755 $payinfo =~ s/\W//g; #anything else would just confuse things
756 $self->payinfo($payinfo);
757 $error = $self->ut_alpha('payinfo');
758 return "Illegal prepayment identifier: ". $self->payinfo if $error;
759 return "Unknown prepayment identifier"
760 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
764 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
765 return "Expriation date required"
766 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
770 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
771 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
772 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
773 ( $m, $y ) = ( $3, "20$2" );
775 return "Illegal expiration date: ". $self->paydate;
777 $self->paydate("$y-$m-01");
778 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
779 return gettext('expired_card')
780 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
783 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
784 ( ! $conf->exists('require_cardname')
785 || $self->payby !~ /^(CARD|DCRD)$/ )
787 $self->payname( $self->first. " ". $self->getfield('last') );
789 $self->payname =~ /^([\w \,\.\-\']+)$/
790 or return gettext('illegal_name'). " payname: ". $self->payname;
794 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
797 $self->otaker(getotaker);
799 #warn "AFTER: \n". $self->_dump;
806 Returns all packages (see L<FS::cust_pkg>) for this customer.
812 if ( $self->{'_pkgnum'} ) {
813 values %{ $self->{'_pkgnum'}->cache };
815 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
819 =item ncancelled_pkgs
821 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
825 sub ncancelled_pkgs {
827 if ( $self->{'_pkgnum'} ) {
828 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
830 @{ [ # force list context
831 qsearch( 'cust_pkg', {
832 'custnum' => $self->custnum,
835 qsearch( 'cust_pkg', {
836 'custnum' => $self->custnum,
845 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
851 grep { $_->susp } $self->ncancelled_pkgs;
854 =item unflagged_suspended_pkgs
856 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
857 customer (thouse packages without the `manual_flag' set).
861 sub unflagged_suspended_pkgs {
863 return $self->suspended_pkgs
864 unless dbdef->table('cust_pkg')->column('manual_flag');
865 grep { ! $_->manual_flag } $self->suspended_pkgs;
868 =item unsuspended_pkgs
870 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
875 sub unsuspended_pkgs {
877 grep { ! $_->susp } $self->ncancelled_pkgs;
882 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
883 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
884 on success or a list of errors.
890 grep { $_->unsuspend } $self->suspended_pkgs;
895 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
896 Always returns a list: an empty list on success or a list of errors.
902 grep { $_->suspend } $self->unsuspended_pkgs;
907 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
908 Always returns a list: an empty list on success or a list of errors.
914 grep { $_->cancel } $self->ncancelled_pkgs;
919 Returns the agent (see L<FS::agent>) for this customer.
925 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
930 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
931 conjunction with the collect method.
933 Options are passed as name-value pairs.
935 The only currently available option is `time', which bills the customer as if
936 it were that time. It is specified as a UNIX timestamp; see
937 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
938 functions. For example:
942 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
944 If there is an error, returns the error, otherwise returns false.
949 my( $self, %options ) = @_;
950 my $time = $options{'time'} || time;
955 local $SIG{HUP} = 'IGNORE';
956 local $SIG{INT} = 'IGNORE';
957 local $SIG{QUIT} = 'IGNORE';
958 local $SIG{TERM} = 'IGNORE';
959 local $SIG{TSTP} = 'IGNORE';
960 local $SIG{PIPE} = 'IGNORE';
962 my $oldAutoCommit = $FS::UID::AutoCommit;
963 local $FS::UID::AutoCommit = 0;
966 # find the packages which are due for billing, find out how much they are
967 # & generate invoice database.
969 my( $total_setup, $total_recur ) = ( 0, 0 );
970 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
971 my @cust_bill_pkg = ();
973 #my $taxable_charged = 0;##
978 foreach my $cust_pkg (
979 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
982 #NO!! next if $cust_pkg->cancel;
983 next if $cust_pkg->getfield('cancel');
985 #? to avoid use of uninitialized value errors... ?
986 $cust_pkg->setfield('bill', '')
987 unless defined($cust_pkg->bill);
989 my $part_pkg = $cust_pkg->part_pkg;
991 #so we don't modify cust_pkg record unnecessarily
992 my $cust_pkg_mod_flag = 0;
993 my %hash = $cust_pkg->hash;
994 my $old_cust_pkg = new FS::cust_pkg \%hash;
1000 unless ( $cust_pkg->setup ) {
1001 my $setup_prog = $part_pkg->getfield('setup');
1002 $setup_prog =~ /^(.*)$/ or do {
1003 $dbh->rollback if $oldAutoCommit;
1004 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1008 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1010 #my $cpt = new Safe;
1011 ##$cpt->permit(); #what is necessary?
1012 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1013 #$setup = $cpt->reval($setup_prog);
1014 $setup = eval $setup_prog;
1015 unless ( defined($setup) ) {
1016 $dbh->rollback if $oldAutoCommit;
1017 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1018 "(expression $setup_prog): $@";
1020 $cust_pkg->setfield('setup',$time);
1021 $cust_pkg_mod_flag=1;
1027 if ( $part_pkg->getfield('freq') > 0 &&
1028 ! $cust_pkg->getfield('susp') &&
1029 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1031 my $recur_prog = $part_pkg->getfield('recur');
1032 $recur_prog =~ /^(.*)$/ or do {
1033 $dbh->rollback if $oldAutoCommit;
1034 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1038 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1040 # shared with $recur_prog
1041 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1043 #my $cpt = new Safe;
1044 ##$cpt->permit(); #what is necessary?
1045 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1046 #$recur = $cpt->reval($recur_prog);
1047 $recur = eval $recur_prog;
1048 unless ( defined($recur) ) {
1049 $dbh->rollback if $oldAutoCommit;
1050 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1051 "(expression $recur_prog): $@";
1053 #change this bit to use Date::Manip? CAREFUL with timezones (see
1054 # mailing list archive)
1055 my ($sec,$min,$hour,$mday,$mon,$year) =
1056 (localtime($sdate) )[0,1,2,3,4,5];
1058 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1059 # only for figuring next bill date, nothing else, so, reset $sdate again
1061 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1062 $cust_pkg->last_bill($sdate)
1063 if $cust_pkg->dbdef_table->column('last_bill');
1065 $mon += $part_pkg->freq;
1066 until ( $mon < 12 ) { $mon -= 12; $year++; }
1067 $cust_pkg->setfield('bill',
1068 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1069 $cust_pkg_mod_flag = 1;
1072 warn "\$setup is undefined" unless defined($setup);
1073 warn "\$recur is undefined" unless defined($recur);
1074 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1076 my $taxable_charged = 0;
1077 if ( $cust_pkg_mod_flag ) {
1078 $error=$cust_pkg->replace($old_cust_pkg);
1079 if ( $error ) { #just in case
1080 $dbh->rollback if $oldAutoCommit;
1081 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1083 $setup = sprintf( "%.2f", $setup );
1084 $recur = sprintf( "%.2f", $recur );
1086 $dbh->rollback if $oldAutoCommit;
1087 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1090 $dbh->rollback if $oldAutoCommit;
1091 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1093 if ( $setup > 0 || $recur > 0 ) {
1094 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1095 'pkgnum' => $cust_pkg->pkgnum,
1099 'edate' => $cust_pkg->bill,
1100 'details' => \@details,
1102 push @cust_bill_pkg, $cust_bill_pkg;
1103 $total_setup += $setup;
1104 $total_recur += $recur;
1105 $taxable_charged += $setup
1106 unless $part_pkg->setuptax =~ /^Y$/i;
1107 $taxable_charged += $recur
1108 unless $part_pkg->recurtax =~ /^Y$/i;
1110 unless ( $self->tax =~ /Y/i
1111 || $self->payby eq 'COMP'
1112 || $taxable_charged == 0 ) {
1114 my $cust_main_county = qsearchs('cust_main_county',{
1115 'state' => $self->state,
1116 'county' => $self->county,
1117 'country' => $self->country,
1118 'taxclass' => $part_pkg->taxclass,
1120 $cust_main_county ||= qsearchs('cust_main_county',{
1121 'state' => $self->state,
1122 'county' => $self->county,
1123 'country' => $self->country,
1126 unless ( $cust_main_county ) {
1127 $dbh->rollback if $oldAutoCommit;
1129 "fatal: can't find tax rate for state/county/country/taxclass ".
1130 join('/', ( map $self->$_(), qw(state county country) ),
1131 $part_pkg->taxclass ). "\n";
1134 if ( $cust_main_county->exempt_amount ) {
1135 my ($mon,$year) = (localtime($sdate) )[4,5];
1137 my $freq = $part_pkg->freq || 1;
1138 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1139 foreach my $which_month ( 1 .. $freq ) {
1141 'custnum' => $self->custnum,
1142 'taxnum' => $cust_main_county->taxnum,
1143 'year' => 1900+$year,
1146 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1147 until ( $mon < 13 ) { $mon -= 12; $year++; }
1148 my $cust_tax_exempt =
1149 qsearchs('cust_tax_exempt', \%hash)
1150 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1151 my $remaining_exemption = sprintf("%.2f",
1152 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1153 if ( $remaining_exemption > 0 ) {
1154 my $addl = $remaining_exemption > $taxable_per_month
1155 ? $taxable_per_month
1156 : $remaining_exemption;
1157 $taxable_charged -= $addl;
1158 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1159 $cust_tax_exempt->hash,
1160 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1162 $error = $new_cust_tax_exempt->exemptnum
1163 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1164 : $new_cust_tax_exempt->insert;
1166 $dbh->rollback if $oldAutoCommit;
1167 return "fatal: can't update cust_tax_exempt: $error";
1170 } # if $remaining_exemption > 0
1172 } #foreach $which_month
1174 } #if $cust_main_county->exempt_amount
1176 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1178 #$tax += $taxable_charged * $cust_main_county->tax / 100
1179 $tax{ $cust_main_county->taxname || 'Tax' } +=
1180 $taxable_charged * $cust_main_county->tax / 100
1182 } #unless $self->tax =~ /Y/i
1183 # || $self->payby eq 'COMP'
1184 # || $taxable_charged == 0
1186 } #if $setup > 0 || $recur > 0
1188 } #if $cust_pkg_mod_flag
1190 } #foreach my $cust_pkg
1192 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1193 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1195 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1200 # unless ( $self->tax =~ /Y/i
1201 # || $self->payby eq 'COMP'
1202 # || $taxable_charged == 0 ) {
1203 # my $cust_main_county = qsearchs('cust_main_county',{
1204 # 'state' => $self->state,
1205 # 'county' => $self->county,
1206 # 'country' => $self->country,
1207 # } ) or die "fatal: can't find tax rate for state/county/country ".
1208 # $self->state. "/". $self->county. "/". $self->country. "\n";
1209 # my $tax = sprintf( "%.2f",
1210 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1213 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1214 my $tax = sprintf("%.2f", $tax{$taxname} );
1215 $charged = sprintf( "%.2f", $charged+$tax );
1217 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1223 'itemdesc' => $taxname,
1225 push @cust_bill_pkg, $cust_bill_pkg;
1229 my $cust_bill = new FS::cust_bill ( {
1230 'custnum' => $self->custnum,
1232 'charged' => $charged,
1234 $error = $cust_bill->insert;
1236 $dbh->rollback if $oldAutoCommit;
1237 return "can't create invoice for customer #". $self->custnum. ": $error";
1240 my $invnum = $cust_bill->invnum;
1242 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1244 $cust_bill_pkg->invnum($invnum);
1245 $error = $cust_bill_pkg->insert;
1247 $dbh->rollback if $oldAutoCommit;
1248 return "can't create invoice line item for customer #". $self->custnum.
1253 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1257 =item collect OPTIONS
1259 (Attempt to) collect money for this customer's outstanding invoices (see
1260 L<FS::cust_bill>). Usually used after the bill method.
1262 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1263 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1264 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1266 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1267 and the invoice events web interface.
1269 If there is an error, returns the error, otherwise returns false.
1271 Options are passed as name-value pairs.
1273 Currently available options are:
1275 invoice_time - Use this time when deciding when to print invoices and
1276 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>
1277 for conversion functions.
1279 retry_card - Retry cards even when not scheduled by invoice events.
1281 batch_card - This option is deprecated. See the invoice events web interface
1282 to control whether cards are batched or run against a realtime gateway.
1284 report_badcard - This option is deprecated.
1286 force_print - This option is deprecated; see the invoice events web interface.
1291 my( $self, %options ) = @_;
1292 my $invoice_time = $options{'invoice_time'} || time;
1295 local $SIG{HUP} = 'IGNORE';
1296 local $SIG{INT} = 'IGNORE';
1297 local $SIG{QUIT} = 'IGNORE';
1298 local $SIG{TERM} = 'IGNORE';
1299 local $SIG{TSTP} = 'IGNORE';
1300 local $SIG{PIPE} = 'IGNORE';
1302 my $oldAutoCommit = $FS::UID::AutoCommit;
1303 local $FS::UID::AutoCommit = 0;
1306 my $balance = $self->balance;
1307 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1308 unless ( $balance > 0 ) { #redundant?????
1309 $dbh->rollback if $oldAutoCommit; #hmm
1313 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1314 #false laziness w/replace
1315 foreach my $cust_bill_event (
1317 #$_->part_bill_event->plan eq 'realtime-card'
1318 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1319 && $_->status eq 'done'
1322 map { $_->cust_bill_event }
1323 grep { $_->cust_bill_event }
1324 $self->open_cust_bill
1326 my $error = $cust_bill_event->retry;
1328 $dbh->rollback if $oldAutoCommit;
1329 return "error scheduling invoice events for retry: $error";
1335 foreach my $cust_bill ( $self->cust_bill ) {
1337 #this has to be before next's
1338 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1342 $balance = sprintf( "%.2f", $balance - $amount );
1344 next unless $cust_bill->owed > 0;
1346 # don't try to charge for the same invoice if it's already in a batch
1347 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1349 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1351 next unless $amount > 0;
1354 foreach my $part_bill_event (
1355 sort { $a->seconds <=> $b->seconds
1356 || $a->weight <=> $b->weight
1357 || $a->eventpart <=> $b->eventpart }
1358 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1359 && ! qsearchs( 'cust_bill_event', {
1360 'invnum' => $cust_bill->invnum,
1361 'eventpart' => $_->eventpart,
1365 qsearch('part_bill_event', { 'payby' => $self->payby,
1366 'disabled' => '', } )
1369 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1371 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1373 my $cust_main = $self; #for callback
1374 my $error = eval $part_bill_event->eventcode;
1377 my $statustext = '';
1381 } elsif ( $error ) {
1383 $statustext = $error;
1388 #add cust_bill_event
1389 my $cust_bill_event = new FS::cust_bill_event {
1390 'invnum' => $cust_bill->invnum,
1391 'eventpart' => $part_bill_event->eventpart,
1392 #'_date' => $invoice_time,
1394 'status' => $status,
1395 'statustext' => $statustext,
1397 $error = $cust_bill_event->insert;
1399 #$dbh->rollback if $oldAutoCommit;
1400 #return "error: $error";
1402 # gah, even with transactions.
1403 $dbh->commit if $oldAutoCommit; #well.
1404 my $e = 'WARNING: Event run but database not updated - '.
1405 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1406 ', eventpart '. $part_bill_event->eventpart.
1417 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1422 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1424 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1425 via a Business::OnlinePayment realtime gateway. See
1426 L<http://420.am/business-onlinepayment> for supported gateways.
1428 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1430 Available options are: I<description>, I<invnum>, I<quiet>
1432 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1433 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1434 if set, will override the value from the customer record.
1436 I<description> is a free-text field passed to the gateway. It defaults to
1437 "Internet services".
1439 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1440 specified invoice. If you don't specify an I<invnum> you might want to
1441 call the B<apply_payments> method.
1443 I<quiet> can be set true to surpress email decline notices.
1445 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1450 my( $self, $method, $amount, %options ) = @_;
1452 warn "$self $method $amount\n";
1453 warn " $_ => $options{$_}\n" foreach keys %options;
1456 $options{'description'} ||= 'Internet services';
1459 die "Real-time processing not enabled\n"
1460 unless $conf->exists('business-onlinepayment');
1461 eval "use Business::OnlinePayment";
1465 $self->set( $_ => $options{$_} )
1466 foreach grep { exists($options{$_}) }
1467 qw( payname address1 address2 city state zip payinfo paydate );
1470 my $bop_config = 'business-onlinepayment';
1471 $bop_config .= '-ach'
1472 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1473 my ( $processor, $login, $password, $action, @bop_options ) =
1474 $conf->config($bop_config);
1475 $action ||= 'normal authorization';
1476 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1480 my $address = $self->address1;
1481 $address .= ", ". $self->address2 if $self->address2;
1483 my($payname, $payfirst, $paylast);
1484 if ( $self->payname && $method ne 'ECHECK' ) {
1485 $payname = $self->payname;
1486 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1487 or return "Illegal payname $payname";
1488 ($payfirst, $paylast) = ($1, $2);
1490 $payfirst = $self->getfield('first');
1491 $paylast = $self->getfield('last');
1492 $payname = "$payfirst $paylast";
1495 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1496 if ( $conf->exists('emailinvoiceauto')
1497 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1498 push @invoicing_list, $self->all_emails;
1500 my $email = $invoicing_list[0];
1503 if ( $method eq 'CC' ) {
1504 $content{card_number} = $self->payinfo;
1505 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1506 $content{expiration} = "$2/$1";
1507 } elsif ( $method eq 'ECHECK' ) {
1508 my($account_number,$routing_code) = $self->payinfo;
1509 ( $content{account_number}, $content{routing_code} ) =
1510 split('@', $self->payinfo);
1511 $content{bank_name} = $self->payname;
1512 } elsif ( $method eq 'LEC' ) {
1513 $content{phone} = $self->payinfo;
1518 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1521 new Business::OnlinePayment( $processor, @bop_options );
1522 $transaction->content(
1525 'password' => $password,
1526 'action' => $action1,
1527 'description' => $options{'description'},
1528 'amount' => $amount,
1529 'invoice_number' => $options{'invnum'},
1530 'customer_id' => $self->custnum,
1531 'last_name' => $paylast,
1532 'first_name' => $payfirst,
1534 'address' => $address,
1535 'city' => $self->city,
1536 'state' => $self->state,
1537 'zip' => $self->zip,
1538 'country' => $self->country,
1539 'referer' => 'http://cleanwhisker.420.am/',
1541 'phone' => $self->daytime || $self->night,
1544 $transaction->submit();
1546 if ( $transaction->is_success() && $action2 ) {
1547 my $auth = $transaction->authorization;
1548 my $ordernum = $transaction->can('order_number')
1549 ? $transaction->order_number
1553 new Business::OnlinePayment( $processor, @bop_options );
1560 password => $password,
1561 order_number => $ordernum,
1563 authorization => $auth,
1564 description => $options{'description'},
1567 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1568 transaction_sequence_num local_transaction_date
1569 local_transaction_time AVS_result_code )) {
1570 $capture{$field} = $transaction->$field() if $transaction->can($field);
1573 $capture->content( %capture );
1577 unless ( $capture->is_success ) {
1578 my $e = "Authorization sucessful but capture failed, custnum #".
1579 $self->custnum. ': '. $capture->result_code.
1580 ": ". $capture->error_message;
1588 if ( $transaction->is_success() ) {
1590 my %method2payby = (
1596 my $cust_pay = new FS::cust_pay ( {
1597 'custnum' => $self->custnum,
1598 'invnum' => $options{'invnum'},
1601 'payby' => $method2payby{$method},
1602 'payinfo' => $self->payinfo,
1603 'paybatch' => "$processor:". $transaction->authorization,
1605 my $error = $cust_pay->insert;
1607 # gah, even with transactions.
1608 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1609 'error applying payment, invnum #' . $self->invnum.
1610 " ($processor): $error";
1619 my $perror = "$processor error: ". $transaction->error_message;
1621 if ( !$options{'quiet'} && $conf->exists('emaildecline')
1622 && grep { $_ ne 'POST' } $self->invoicing_list
1624 my @templ = $conf->config('declinetemplate');
1625 my $template = new Text::Template (
1627 SOURCE => [ map "$_\n", @templ ],
1628 ) or return "($perror) can't create template: $Text::Template::ERROR";
1629 $template->compile()
1630 or return "($perror) can't compile template: $Text::Template::ERROR";
1632 my $templ_hash = { error => $transaction->error_message };
1634 my $error = send_email(
1635 'from' => $conf->config('invoice_from'),
1636 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1637 'subject' => 'Your payment could not be processed',
1638 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1641 $perror .= " (also received error sending decline notification: $error)"
1653 Returns the total owed for this customer on all invoices
1654 (see L<FS::cust_bill/owed>).
1660 $self->total_owed_date(2145859200); #12/31/2037
1663 =item total_owed_date TIME
1665 Returns the total owed for this customer on all invoices with date earlier than
1666 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1667 see L<Time::Local> and L<Date::Parse> for conversion functions.
1671 sub total_owed_date {
1675 foreach my $cust_bill (
1676 grep { $_->_date <= $time }
1677 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1679 $total_bill += $cust_bill->owed;
1681 sprintf( "%.2f", $total_bill );
1686 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1687 to outstanding invoice balances in chronological order and returns the value
1688 of any remaining unapplied credits available for refund
1689 (see L<FS::cust_refund>).
1696 return 0 unless $self->total_credited;
1698 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1699 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1701 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1702 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1706 foreach my $cust_bill ( @invoices ) {
1709 if ( !defined($credit) || $credit->credited == 0) {
1710 $credit = pop @credits or last;
1713 if ($cust_bill->owed >= $credit->credited) {
1714 $amount=$credit->credited;
1716 $amount=$cust_bill->owed;
1719 my $cust_credit_bill = new FS::cust_credit_bill ( {
1720 'crednum' => $credit->crednum,
1721 'invnum' => $cust_bill->invnum,
1722 'amount' => $amount,
1724 my $error = $cust_credit_bill->insert;
1725 die $error if $error;
1727 redo if ($cust_bill->owed > 0);
1731 return $self->total_credited;
1734 =item apply_payments
1736 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1737 to outstanding invoice balances in chronological order.
1739 #and returns the value of any remaining unapplied payments.
1743 sub apply_payments {
1748 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1749 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1751 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1752 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1756 foreach my $cust_bill ( @invoices ) {
1759 if ( !defined($payment) || $payment->unapplied == 0 ) {
1760 $payment = pop @payments or last;
1763 if ( $cust_bill->owed >= $payment->unapplied ) {
1764 $amount = $payment->unapplied;
1766 $amount = $cust_bill->owed;
1769 my $cust_bill_pay = new FS::cust_bill_pay ( {
1770 'paynum' => $payment->paynum,
1771 'invnum' => $cust_bill->invnum,
1772 'amount' => $amount,
1774 my $error = $cust_bill_pay->insert;
1775 die $error if $error;
1777 redo if ( $cust_bill->owed > 0);
1781 return $self->total_unapplied_payments;
1784 =item total_credited
1786 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1787 customer. See L<FS::cust_credit/credited>.
1791 sub total_credited {
1793 my $total_credit = 0;
1794 foreach my $cust_credit ( qsearch('cust_credit', {
1795 'custnum' => $self->custnum,
1797 $total_credit += $cust_credit->credited;
1799 sprintf( "%.2f", $total_credit );
1802 =item total_unapplied_payments
1804 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1805 See L<FS::cust_pay/unapplied>.
1809 sub total_unapplied_payments {
1811 my $total_unapplied = 0;
1812 foreach my $cust_pay ( qsearch('cust_pay', {
1813 'custnum' => $self->custnum,
1815 $total_unapplied += $cust_pay->unapplied;
1817 sprintf( "%.2f", $total_unapplied );
1822 Returns the balance for this customer (total_owed minus total_credited
1823 minus total_unapplied_payments).
1830 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1834 =item balance_date TIME
1836 Returns the balance for this customer, only considering invoices with date
1837 earlier than TIME (total_owed_date minus total_credited minus
1838 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1839 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1848 $self->total_owed_date($time)
1849 - $self->total_credited
1850 - $self->total_unapplied_payments
1854 =item invoicing_list [ ARRAYREF ]
1856 If an arguement is given, sets these email addresses as invoice recipients
1857 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1858 (except as warnings), so use check_invoicing_list first.
1860 Returns a list of email addresses (with svcnum entries expanded).
1862 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1863 check it without disturbing anything by passing nothing.
1865 This interface may change in the future.
1869 sub invoicing_list {
1870 my( $self, $arrayref ) = @_;
1872 my @cust_main_invoice;
1873 if ( $self->custnum ) {
1874 @cust_main_invoice =
1875 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1877 @cust_main_invoice = ();
1879 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1880 #warn $cust_main_invoice->destnum;
1881 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1882 #warn $cust_main_invoice->destnum;
1883 my $error = $cust_main_invoice->delete;
1884 warn $error if $error;
1887 if ( $self->custnum ) {
1888 @cust_main_invoice =
1889 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1891 @cust_main_invoice = ();
1893 my %seen = map { $_->address => 1 } @cust_main_invoice;
1894 foreach my $address ( @{$arrayref} ) {
1895 next if exists $seen{$address} && $seen{$address};
1896 $seen{$address} = 1;
1897 my $cust_main_invoice = new FS::cust_main_invoice ( {
1898 'custnum' => $self->custnum,
1901 my $error = $cust_main_invoice->insert;
1902 warn $error if $error;
1905 if ( $self->custnum ) {
1907 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1913 =item check_invoicing_list ARRAYREF
1915 Checks these arguements as valid input for the invoicing_list method. If there
1916 is an error, returns the error, otherwise returns false.
1920 sub check_invoicing_list {
1921 my( $self, $arrayref ) = @_;
1922 foreach my $address ( @{$arrayref} ) {
1923 my $cust_main_invoice = new FS::cust_main_invoice ( {
1924 'custnum' => $self->custnum,
1927 my $error = $self->custnum
1928 ? $cust_main_invoice->check
1929 : $cust_main_invoice->checkdest
1931 return $error if $error;
1936 =item set_default_invoicing_list
1938 Sets the invoicing list to all accounts associated with this customer,
1939 overwriting any previous invoicing list.
1943 sub set_default_invoicing_list {
1945 $self->invoicing_list($self->all_emails);
1950 Returns the email addresses of all accounts provisioned for this customer.
1957 foreach my $cust_pkg ( $self->all_pkgs ) {
1958 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1960 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1961 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1963 $list{$_}=1 foreach map { $_->email } @svc_acct;
1968 =item invoicing_list_addpost
1970 Adds postal invoicing to this customer. If this customer is already configured
1971 to receive postal invoices, does nothing.
1975 sub invoicing_list_addpost {
1977 return if grep { $_ eq 'POST' } $self->invoicing_list;
1978 my @invoicing_list = $self->invoicing_list;
1979 push @invoicing_list, 'POST';
1980 $self->invoicing_list(\@invoicing_list);
1983 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1985 Returns an array of customers referred by this customer (referral_custnum set
1986 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1987 customers referred by customers referred by this customer and so on, inclusive.
1988 The default behavior is DEPTH 1 (no recursion).
1992 sub referral_cust_main {
1994 my $depth = @_ ? shift : 1;
1995 my $exclude = @_ ? shift : {};
1998 map { $exclude->{$_->custnum}++; $_; }
1999 grep { ! $exclude->{ $_->custnum } }
2000 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2004 map { $_->referral_cust_main($depth-1, $exclude) }
2011 =item referral_cust_main_ncancelled
2013 Same as referral_cust_main, except only returns customers with uncancelled
2018 sub referral_cust_main_ncancelled {
2020 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2023 =item referral_cust_pkg [ DEPTH ]
2025 Like referral_cust_main, except returns a flat list of all unsuspended (and
2026 uncancelled) packages for each customer. The number of items in this list may
2027 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2031 sub referral_cust_pkg {
2033 my $depth = @_ ? shift : 1;
2035 map { $_->unsuspended_pkgs }
2036 grep { $_->unsuspended_pkgs }
2037 $self->referral_cust_main($depth);
2040 =item credit AMOUNT, REASON
2042 Applies a credit to this customer. If there is an error, returns the error,
2043 otherwise returns false.
2048 my( $self, $amount, $reason ) = @_;
2049 my $cust_credit = new FS::cust_credit {
2050 'custnum' => $self->custnum,
2051 'amount' => $amount,
2052 'reason' => $reason,
2054 $cust_credit->insert;
2057 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2059 Creates a one-time charge for this customer. If there is an error, returns
2060 the error, otherwise returns false.
2065 my ( $self, $amount ) = ( shift, shift );
2066 my $pkg = @_ ? shift : 'One-time charge';
2067 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2068 my $taxclass = @_ ? shift : '';
2070 local $SIG{HUP} = 'IGNORE';
2071 local $SIG{INT} = 'IGNORE';
2072 local $SIG{QUIT} = 'IGNORE';
2073 local $SIG{TERM} = 'IGNORE';
2074 local $SIG{TSTP} = 'IGNORE';
2075 local $SIG{PIPE} = 'IGNORE';
2077 my $oldAutoCommit = $FS::UID::AutoCommit;
2078 local $FS::UID::AutoCommit = 0;
2081 my $part_pkg = new FS::part_pkg ( {
2083 'comment' => $comment,
2088 'taxclass' => $taxclass,
2091 my $error = $part_pkg->insert;
2093 $dbh->rollback if $oldAutoCommit;
2097 my $pkgpart = $part_pkg->pkgpart;
2098 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2099 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2100 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2101 $error = $type_pkgs->insert;
2103 $dbh->rollback if $oldAutoCommit;
2108 my $cust_pkg = new FS::cust_pkg ( {
2109 'custnum' => $self->custnum,
2110 'pkgpart' => $pkgpart,
2113 $error = $cust_pkg->insert;
2115 $dbh->rollback if $oldAutoCommit;
2119 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2126 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2132 sort { $a->_date <=> $b->_date }
2133 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2136 =item open_cust_bill
2138 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2143 sub open_cust_bill {
2145 grep { $_->owed > 0 } $self->cust_bill;
2154 =item check_and_rebuild_fuzzyfiles
2158 sub check_and_rebuild_fuzzyfiles {
2159 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2160 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2161 or &rebuild_fuzzyfiles;
2164 =item rebuild_fuzzyfiles
2168 sub rebuild_fuzzyfiles {
2170 use Fcntl qw(:flock);
2172 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2176 open(LASTLOCK,">>$dir/cust_main.last")
2177 or die "can't open $dir/cust_main.last: $!";
2178 flock(LASTLOCK,LOCK_EX)
2179 or die "can't lock $dir/cust_main.last: $!";
2181 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2183 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2184 if defined dbdef->table('cust_main')->column('ship_last');
2186 open (LASTCACHE,">$dir/cust_main.last.tmp")
2187 or die "can't open $dir/cust_main.last.tmp: $!";
2188 print LASTCACHE join("\n", @all_last), "\n";
2189 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2191 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2196 open(COMPANYLOCK,">>$dir/cust_main.company")
2197 or die "can't open $dir/cust_main.company: $!";
2198 flock(COMPANYLOCK,LOCK_EX)
2199 or die "can't lock $dir/cust_main.company: $!";
2201 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2203 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2204 if defined dbdef->table('cust_main')->column('ship_last');
2206 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2207 or die "can't open $dir/cust_main.company.tmp: $!";
2208 print COMPANYCACHE join("\n", @all_company), "\n";
2209 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2211 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2221 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2222 open(LASTCACHE,"<$dir/cust_main.last")
2223 or die "can't open $dir/cust_main.last: $!";
2224 my @array = map { chomp; $_; } <LASTCACHE>;
2234 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2235 open(COMPANYCACHE,"<$dir/cust_main.company")
2236 or die "can't open $dir/cust_main.last: $!";
2237 my @array = map { chomp; $_; } <COMPANYCACHE>;
2242 =item append_fuzzyfiles LASTNAME COMPANY
2246 sub append_fuzzyfiles {
2247 my( $last, $company ) = @_;
2249 &check_and_rebuild_fuzzyfiles;
2251 use Fcntl qw(:flock);
2253 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2257 open(LAST,">>$dir/cust_main.last")
2258 or die "can't open $dir/cust_main.last: $!";
2260 or die "can't lock $dir/cust_main.last: $!";
2262 print LAST "$last\n";
2265 or die "can't unlock $dir/cust_main.last: $!";
2271 open(COMPANY,">>$dir/cust_main.company")
2272 or die "can't open $dir/cust_main.company: $!";
2273 flock(COMPANY,LOCK_EX)
2274 or die "can't lock $dir/cust_main.company: $!";
2276 print COMPANY "$company\n";
2278 flock(COMPANY,LOCK_UN)
2279 or die "can't unlock $dir/cust_main.company: $!";
2293 #warn join('-',keys %$param);
2294 my $fh = $param->{filehandle};
2295 my $agentnum = $param->{agentnum};
2296 my $refnum = $param->{refnum};
2297 my $pkgpart = $param->{pkgpart};
2298 my @fields = @{$param->{fields}};
2300 eval "use Date::Parse;";
2302 eval "use Text::CSV_XS;";
2305 my $csv = new Text::CSV_XS;
2312 local $SIG{HUP} = 'IGNORE';
2313 local $SIG{INT} = 'IGNORE';
2314 local $SIG{QUIT} = 'IGNORE';
2315 local $SIG{TERM} = 'IGNORE';
2316 local $SIG{TSTP} = 'IGNORE';
2317 local $SIG{PIPE} = 'IGNORE';
2319 my $oldAutoCommit = $FS::UID::AutoCommit;
2320 local $FS::UID::AutoCommit = 0;
2323 #while ( $columns = $csv->getline($fh) ) {
2325 while ( defined($line=<$fh>) ) {
2327 $csv->parse($line) or do {
2328 $dbh->rollback if $oldAutoCommit;
2329 return "can't parse: ". $csv->error_input();
2332 my @columns = $csv->fields();
2333 #warn join('-',@columns);
2336 agentnum => $agentnum,
2338 country => 'US', #default
2339 payby => 'BILL', #default
2340 paydate => '12/2037', #default
2342 my $billtime = time;
2343 my %cust_pkg = ( pkgpart => $pkgpart );
2344 foreach my $field ( @fields ) {
2345 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2346 #$cust_pkg{$1} = str2time( shift @$columns );
2347 if ( $1 eq 'setup' ) {
2348 $billtime = str2time(shift @columns);
2350 $cust_pkg{$1} = str2time( shift @columns );
2353 #$cust_main{$field} = shift @$columns;
2354 $cust_main{$field} = shift @columns;
2358 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2359 my $cust_main = new FS::cust_main ( \%cust_main );
2361 tie my %hash, 'Tie::RefHash'; #this part is important
2362 $hash{$cust_pkg} = [] if $pkgpart;
2363 my $error = $cust_main->insert( \%hash );
2366 $dbh->rollback if $oldAutoCommit;
2367 return "can't insert customer for $line: $error";
2370 #false laziness w/bill.cgi
2371 $error = $cust_main->bill( 'time' => $billtime );
2373 $dbh->rollback if $oldAutoCommit;
2374 return "can't bill customer for $line: $error";
2377 $cust_main->apply_payments;
2378 $cust_main->apply_credits;
2380 $error = $cust_main->collect();
2382 $dbh->rollback if $oldAutoCommit;
2383 return "can't collect customer for $line: $error";
2389 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2391 return "Empty file!" unless $imported;
2403 #warn join('-',keys %$param);
2404 my $fh = $param->{filehandle};
2405 my @fields = @{$param->{fields}};
2407 eval "use Date::Parse;";
2409 eval "use Text::CSV_XS;";
2412 my $csv = new Text::CSV_XS;
2419 local $SIG{HUP} = 'IGNORE';
2420 local $SIG{INT} = 'IGNORE';
2421 local $SIG{QUIT} = 'IGNORE';
2422 local $SIG{TERM} = 'IGNORE';
2423 local $SIG{TSTP} = 'IGNORE';
2424 local $SIG{PIPE} = 'IGNORE';
2426 my $oldAutoCommit = $FS::UID::AutoCommit;
2427 local $FS::UID::AutoCommit = 0;
2430 #while ( $columns = $csv->getline($fh) ) {
2432 while ( defined($line=<$fh>) ) {
2434 $csv->parse($line) or do {
2435 $dbh->rollback if $oldAutoCommit;
2436 return "can't parse: ". $csv->error_input();
2439 my @columns = $csv->fields();
2440 #warn join('-',@columns);
2443 foreach my $field ( @fields ) {
2444 $row{$field} = shift @columns;
2447 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2448 unless ( $cust_main ) {
2449 $dbh->rollback if $oldAutoCommit;
2450 return "unknown custnum $row{'custnum'}";
2453 if ( $row{'amount'} > 0 ) {
2454 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2456 $dbh->rollback if $oldAutoCommit;
2460 } elsif ( $row{'amount'} < 0 ) {
2461 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2464 $dbh->rollback if $oldAutoCommit;
2474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2476 return "Empty file!" unless $imported;
2488 The delete method should possibly take an FS::cust_main object reference
2489 instead of a scalar customer number.
2491 Bill and collect options should probably be passed as references instead of a
2494 There should probably be a configuration file with a list of allowed credit
2497 No multiple currency support (probably a larger project than just this module).
2501 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2502 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2503 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.