4 use vars qw( @ISA $conf $Debug $import );
7 use Time::Local qw(timelocal_nocheck);
10 use Business::CreditCard;
11 use FS::UID qw( getotaker dbh );
12 use FS::Record qw( qsearchs qsearch dbdef );
13 use FS::Misc qw( send_email );
16 use FS::cust_bill_pkg;
19 use FS::part_referral;
20 use FS::cust_main_county;
22 use FS::cust_main_invoice;
23 use FS::cust_credit_bill;
24 use FS::cust_bill_pay;
25 use FS::prepay_credit;
28 use FS::part_bill_event;
29 use FS::cust_bill_event;
30 use FS::cust_tax_exempt;
32 use FS::Msgcat qw(gettext);
34 @ISA = qw( FS::Record );
41 #ask FS::UID to run this stuff for us later
42 #$FS::UID::callback{'FS::cust_main'} = sub {
43 install_callback FS::UID sub {
45 #yes, need it for stuff below (prolly should be cached)
50 my ( $hashref, $cache ) = @_;
51 if ( exists $hashref->{'pkgnum'} ) {
52 # #@{ $self->{'_pkgnum'} } = ();
53 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
54 $self->{'_pkgnum'} = $subcache;
55 #push @{ $self->{'_pkgnum'} },
56 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
62 FS::cust_main - Object methods for cust_main records
68 $record = new FS::cust_main \%hash;
69 $record = new FS::cust_main { 'column' => 'value' };
71 $error = $record->insert;
73 $error = $new_record->replace($old_record);
75 $error = $record->delete;
77 $error = $record->check;
79 @cust_pkg = $record->all_pkgs;
81 @cust_pkg = $record->ncancelled_pkgs;
83 @cust_pkg = $record->suspended_pkgs;
85 $error = $record->bill;
86 $error = $record->bill %options;
87 $error = $record->bill 'time' => $time;
89 $error = $record->collect;
90 $error = $record->collect %options;
91 $error = $record->collect 'invoice_time' => $time,
92 'batch_card' => 'yes',
93 'report_badcard' => 'yes',
98 An FS::cust_main object represents a customer. FS::cust_main inherits from
99 FS::Record. The following fields are currently supported:
103 =item custnum - primary key (assigned automatically for new customers)
105 =item agentnum - agent (see L<FS::agent>)
107 =item refnum - Advertising source (see L<FS::part_referral>)
113 =item ss - social security number (optional)
115 =item company - (optional)
119 =item address2 - (optional)
123 =item county - (optional, see L<FS::cust_main_county>)
125 =item state - (see L<FS::cust_main_county>)
129 =item country - (see L<FS::cust_main_county>)
131 =item daytime - phone (optional)
133 =item night - phone (optional)
135 =item fax - phone (optional)
137 =item ship_first - name
139 =item ship_last - name
141 =item ship_company - (optional)
145 =item ship_address2 - (optional)
149 =item ship_county - (optional, see L<FS::cust_main_county>)
151 =item ship_state - (see L<FS::cust_main_county>)
155 =item ship_country - (see L<FS::cust_main_county>)
157 =item ship_daytime - phone (optional)
159 =item ship_night - phone (optional)
161 =item ship_fax - phone (optional)
163 =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>)
165 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
167 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
169 =item payname - name on card or billing name
171 =item tax - tax exempt, empty or `Y'
173 =item otaker - order taker (assigned automatically, see L<FS::UID>)
175 =item comments - comments (optional)
177 =item referral_custnum - referring customer number
187 Creates a new customer. To add the customer to the database, see L<"insert">.
189 Note that this stores the hash reference, not a distinct copy of the hash it
190 points to. You can ask the object for a copy with the I<hash> method.
194 sub table { 'cust_main'; }
196 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
198 Adds this customer to the database. If there is an error, returns the error,
199 otherwise returns false.
201 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
202 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
203 are inserted atomicly, or the transaction is rolled back. Passing an empty
204 hash reference is equivalent to not supplying this parameter. There should be
205 a better explanation of this, but until then, here's an example:
208 tie %hash, 'Tie::RefHash'; #this part is important
210 $cust_pkg => [ $svc_acct ],
213 $cust_main->insert( \%hash );
215 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
216 be set as the invoicing list (see L<"invoicing_list">). Errors return as
217 expected and rollback the entire transaction; it is not necessary to call
218 check_invoicing_list first. The invoicing_list is set after the records in the
219 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
220 invoicing_list destination to the newly-created svc_acct. Here's an example:
222 $cust_main->insert( {}, [ $email, 'POST' ] );
228 my $cust_pkgs = @_ ? shift : {};
229 my $invoicing_list = @_ ? shift : '';
231 local $SIG{HUP} = 'IGNORE';
232 local $SIG{INT} = 'IGNORE';
233 local $SIG{QUIT} = 'IGNORE';
234 local $SIG{TERM} = 'IGNORE';
235 local $SIG{TSTP} = 'IGNORE';
236 local $SIG{PIPE} = 'IGNORE';
238 my $oldAutoCommit = $FS::UID::AutoCommit;
239 local $FS::UID::AutoCommit = 0;
244 if ( $self->payby eq 'PREPAY' ) {
245 $self->payby('BILL');
246 my $prepay_credit = qsearchs(
248 { 'identifier' => $self->payinfo },
252 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
253 unless $prepay_credit;
254 $amount = $prepay_credit->amount;
255 $seconds = $prepay_credit->seconds;
256 my $error = $prepay_credit->delete;
258 $dbh->rollback if $oldAutoCommit;
259 return "removing prepay_credit (transaction rolled back): $error";
263 my $error = $self->SUPER::insert;
265 $dbh->rollback if $oldAutoCommit;
266 #return "inserting cust_main record (transaction rolled back): $error";
271 if ( $invoicing_list ) {
272 $error = $self->check_invoicing_list( $invoicing_list );
274 $dbh->rollback if $oldAutoCommit;
275 return "checking invoicing_list (transaction rolled back): $error";
277 $self->invoicing_list( $invoicing_list );
281 $error = $self->order_pkgs($cust_pkgs, \$seconds);
283 $dbh->rollback if $oldAutoCommit;
288 $dbh->rollback if $oldAutoCommit;
289 return "No svc_acct record to apply pre-paid time";
293 my $cust_credit = new FS::cust_credit {
294 'custnum' => $self->custnum,
297 $error = $cust_credit->insert;
299 $dbh->rollback if $oldAutoCommit;
300 return "inserting credit (transaction rolled back): $error";
304 #false laziness with sub replace
305 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
306 $error = $queue->insert($self->getfield('last'), $self->company);
308 $dbh->rollback if $oldAutoCommit;
309 return "queueing job (transaction rolled back): $error";
312 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
313 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
314 $error = $queue->insert($self->getfield('last'), $self->company);
316 $dbh->rollback if $oldAutoCommit;
317 return "queueing job (transaction rolled back): $error";
322 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
329 document me. like ->insert(%cust_pkg) on an existing record
335 my $cust_pkgs = shift;
338 local $SIG{HUP} = 'IGNORE';
339 local $SIG{INT} = 'IGNORE';
340 local $SIG{QUIT} = 'IGNORE';
341 local $SIG{TERM} = 'IGNORE';
342 local $SIG{TSTP} = 'IGNORE';
343 local $SIG{PIPE} = 'IGNORE';
345 my $oldAutoCommit = $FS::UID::AutoCommit;
346 local $FS::UID::AutoCommit = 0;
349 foreach my $cust_pkg ( keys %$cust_pkgs ) {
350 $cust_pkg->custnum( $self->custnum );
351 my $error = $cust_pkg->insert;
353 $dbh->rollback if $oldAutoCommit;
354 return "inserting cust_pkg (transaction rolled back): $error";
356 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
357 $svc_something->pkgnum( $cust_pkg->pkgnum );
358 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
359 $svc_something->seconds( $svc_something->seconds + $$seconds );
362 $error = $svc_something->insert;
364 $dbh->rollback if $oldAutoCommit;
365 #return "inserting svc_ (transaction rolled back): $error";
371 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
375 =item delete NEW_CUSTNUM
377 This deletes the customer. If there is an error, returns the error, otherwise
380 This will completely remove all traces of the customer record. This is not
381 what you want when a customer cancels service; for that, cancel all of the
382 customer's packages (see L<FS::cust_pkg/cancel>).
384 If the customer has any uncancelled packages, you need to pass a new (valid)
385 customer number for those packages to be transferred to. Cancelled packages
386 will be deleted. Did I mention that this is NOT what you want when a customer
387 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
389 You can't delete a customer with invoices (see L<FS::cust_bill>),
390 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
391 refunds (see L<FS::cust_refund>).
398 local $SIG{HUP} = 'IGNORE';
399 local $SIG{INT} = 'IGNORE';
400 local $SIG{QUIT} = 'IGNORE';
401 local $SIG{TERM} = 'IGNORE';
402 local $SIG{TSTP} = 'IGNORE';
403 local $SIG{PIPE} = 'IGNORE';
405 my $oldAutoCommit = $FS::UID::AutoCommit;
406 local $FS::UID::AutoCommit = 0;
409 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
410 $dbh->rollback if $oldAutoCommit;
411 return "Can't delete a customer with invoices";
413 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
414 $dbh->rollback if $oldAutoCommit;
415 return "Can't delete a customer with credits";
417 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
418 $dbh->rollback if $oldAutoCommit;
419 return "Can't delete a customer with payments";
421 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
422 $dbh->rollback if $oldAutoCommit;
423 return "Can't delete a customer with refunds";
426 my @cust_pkg = $self->ncancelled_pkgs;
428 my $new_custnum = shift;
429 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
430 $dbh->rollback if $oldAutoCommit;
431 return "Invalid new customer number: $new_custnum";
433 foreach my $cust_pkg ( @cust_pkg ) {
434 my %hash = $cust_pkg->hash;
435 $hash{'custnum'} = $new_custnum;
436 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
437 my $error = $new_cust_pkg->replace($cust_pkg);
439 $dbh->rollback if $oldAutoCommit;
444 my @cancelled_cust_pkg = $self->all_pkgs;
445 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
446 my $error = $cust_pkg->delete;
448 $dbh->rollback if $oldAutoCommit;
453 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
454 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
456 my $error = $cust_main_invoice->delete;
458 $dbh->rollback if $oldAutoCommit;
463 my $error = $self->SUPER::delete;
465 $dbh->rollback if $oldAutoCommit;
469 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
474 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
476 Replaces the OLD_RECORD with this one in the database. If there is an error,
477 returns the error, otherwise returns false.
479 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
480 be set as the invoicing list (see L<"invoicing_list">). Errors return as
481 expected and rollback the entire transaction; it is not necessary to call
482 check_invoicing_list first. Here's an example:
484 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
493 local $SIG{HUP} = 'IGNORE';
494 local $SIG{INT} = 'IGNORE';
495 local $SIG{QUIT} = 'IGNORE';
496 local $SIG{TERM} = 'IGNORE';
497 local $SIG{TSTP} = 'IGNORE';
498 local $SIG{PIPE} = 'IGNORE';
500 my $oldAutoCommit = $FS::UID::AutoCommit;
501 local $FS::UID::AutoCommit = 0;
504 my $error = $self->SUPER::replace($old);
507 $dbh->rollback if $oldAutoCommit;
511 if ( @param ) { # INVOICING_LIST_ARYREF
512 my $invoicing_list = shift @param;
513 $error = $self->check_invoicing_list( $invoicing_list );
515 $dbh->rollback if $oldAutoCommit;
518 $self->invoicing_list( $invoicing_list );
521 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
522 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
523 # card/check info has changed, want to retry realtime_card invoice events
524 #false laziness w/collect
525 foreach my $cust_bill_event (
527 #$_->part_bill_event->plan eq 'realtime-card'
528 $_->part_bill_event->eventcode =~
529 /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
530 && $_->status eq 'done'
533 map { $_->cust_bill_event }
534 grep { $_->cust_bill_event }
535 $self->open_cust_bill
538 my $error = $cust_bill_event->retry;
540 $dbh->rollback if $oldAutoCommit;
541 return "error scheduling invoice events for retry: $error";
548 #false laziness with sub insert
549 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
550 $error = $queue->insert($self->getfield('last'), $self->company);
552 $dbh->rollback if $oldAutoCommit;
553 return "queueing job (transaction rolled back): $error";
556 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
557 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
558 $error = $queue->insert($self->getfield('last'), $self->company);
560 $dbh->rollback if $oldAutoCommit;
561 return "queueing job (transaction rolled back): $error";
566 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
573 Checks all fields to make sure this is a valid customer record. If there is
574 an error, returns the error, otherwise returns false. Called by the insert
582 #warn "BEFORE: \n". $self->_dump;
585 $self->ut_numbern('custnum')
586 || $self->ut_number('agentnum')
587 || $self->ut_number('refnum')
588 || $self->ut_name('last')
589 || $self->ut_name('first')
590 || $self->ut_textn('company')
591 || $self->ut_text('address1')
592 || $self->ut_textn('address2')
593 || $self->ut_text('city')
594 || $self->ut_textn('county')
595 || $self->ut_textn('state')
596 || $self->ut_country('country')
597 || $self->ut_anything('comments')
598 || $self->ut_numbern('referral_custnum')
600 #barf. need message catalogs. i18n. etc.
601 $error .= "Please select a advertising source."
602 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
603 return $error if $error;
605 return "Unknown agent"
606 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
608 return "Unknown refnum"
609 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
611 return "Unknown referring custnum ". $self->referral_custnum
612 unless ! $self->referral_custnum
613 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
615 if ( $self->ss eq '' ) {
620 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
621 or return "Illegal social security number: ". $self->ss;
622 $self->ss("$1-$2-$3");
626 # bad idea to disable, causes billing to fail because of no tax rates later
627 # unless ( $import ) {
628 unless ( qsearch('cust_main_county', {
629 'country' => $self->country,
632 return "Unknown state/county/country: ".
633 $self->state. "/". $self->county. "/". $self->country
634 unless qsearch('cust_main_county',{
635 'state' => $self->state,
636 'county' => $self->county,
637 'country' => $self->country,
643 $self->ut_phonen('daytime', $self->country)
644 || $self->ut_phonen('night', $self->country)
645 || $self->ut_phonen('fax', $self->country)
646 || $self->ut_zip('zip', $self->country)
648 return $error if $error;
651 last first company address1 address2 city county state zip
652 country daytime night fax
655 if ( defined $self->dbdef_table->column('ship_last') ) {
656 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
658 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
662 $self->ut_name('ship_last')
663 || $self->ut_name('ship_first')
664 || $self->ut_textn('ship_company')
665 || $self->ut_text('ship_address1')
666 || $self->ut_textn('ship_address2')
667 || $self->ut_text('ship_city')
668 || $self->ut_textn('ship_county')
669 || $self->ut_textn('ship_state')
670 || $self->ut_country('ship_country')
672 return $error if $error;
674 #false laziness with above
675 unless ( qsearchs('cust_main_county', {
676 'country' => $self->ship_country,
679 return "Unknown ship_state/ship_county/ship_country: ".
680 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
681 unless qsearchs('cust_main_county',{
682 'state' => $self->ship_state,
683 'county' => $self->ship_county,
684 'country' => $self->ship_country,
690 $self->ut_phonen('ship_daytime', $self->ship_country)
691 || $self->ut_phonen('ship_night', $self->ship_country)
692 || $self->ut_phonen('ship_fax', $self->ship_country)
693 || $self->ut_zip('ship_zip', $self->ship_country)
695 return $error if $error;
697 } else { # ship_ info eq billing info, so don't store dup info in database
698 $self->setfield("ship_$_", '')
699 foreach qw( last first company address1 address2 city county state zip
700 country daytime night fax );
704 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
705 or return "Illegal payby: ". $self->payby;
708 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
710 my $payinfo = $self->payinfo;
712 $payinfo =~ /^(\d{13,16})$/
713 or return gettext('invalid_card'); # . ": ". $self->payinfo;
715 $self->payinfo($payinfo);
717 or return gettext('invalid_card'); # . ": ". $self->payinfo;
718 return gettext('unknown_card_type')
719 if cardtype($self->payinfo) eq "Unknown";
721 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
723 my $payinfo = $self->payinfo;
724 $payinfo =~ s/[^\d\@]//g;
725 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
727 $self->payinfo($payinfo);
729 } elsif ( $self->payby eq 'LECB' ) {
731 my $payinfo = $self->payinfo;
733 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
735 $self->payinfo($payinfo);
737 } elsif ( $self->payby eq 'BILL' ) {
739 $error = $self->ut_textn('payinfo');
740 return "Illegal P.O. number: ". $self->payinfo if $error;
742 } elsif ( $self->payby eq 'COMP' ) {
744 $error = $self->ut_textn('payinfo');
745 return "Illegal comp account issuer: ". $self->payinfo if $error;
747 } elsif ( $self->payby eq 'PREPAY' ) {
749 my $payinfo = $self->payinfo;
750 $payinfo =~ s/\W//g; #anything else would just confuse things
751 $self->payinfo($payinfo);
752 $error = $self->ut_alpha('payinfo');
753 return "Illegal prepayment identifier: ". $self->payinfo if $error;
754 return "Unknown prepayment identifier"
755 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
759 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
760 return "Expriation date required"
761 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
764 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
765 or return "Illegal expiration date: ". $self->paydate;
766 my $y = length($2) == 4 ? $2 : "20$2";
767 $self->paydate("$y-$1-01");
768 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
769 return gettext('expired_card')
770 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
773 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
774 ( ! $conf->exists('require_cardname')
775 || $self->payby !~ /^(CARD|DCRD)$/ )
777 $self->payname( $self->first. " ". $self->getfield('last') );
779 $self->payname =~ /^([\w \,\.\-\']+)$/
780 or return gettext('illegal_name'). " payname: ". $self->payname;
784 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
787 $self->otaker(getotaker);
789 #warn "AFTER: \n". $self->_dump;
796 Returns all packages (see L<FS::cust_pkg>) for this customer.
802 if ( $self->{'_pkgnum'} ) {
803 values %{ $self->{'_pkgnum'}->cache };
805 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
809 =item ncancelled_pkgs
811 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
815 sub ncancelled_pkgs {
817 if ( $self->{'_pkgnum'} ) {
818 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
820 @{ [ # force list context
821 qsearch( 'cust_pkg', {
822 'custnum' => $self->custnum,
825 qsearch( 'cust_pkg', {
826 'custnum' => $self->custnum,
835 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
841 grep { $_->susp } $self->ncancelled_pkgs;
844 =item unflagged_suspended_pkgs
846 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
847 customer (thouse packages without the `manual_flag' set).
851 sub unflagged_suspended_pkgs {
853 return $self->suspended_pkgs
854 unless dbdef->table('cust_pkg')->column('manual_flag');
855 grep { ! $_->manual_flag } $self->suspended_pkgs;
858 =item unsuspended_pkgs
860 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
865 sub unsuspended_pkgs {
867 grep { ! $_->susp } $self->ncancelled_pkgs;
872 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
873 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
874 on success or a list of errors.
880 grep { $_->unsuspend } $self->suspended_pkgs;
885 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
886 Always returns a list: an empty list on success or a list of errors.
892 grep { $_->suspend } $self->unsuspended_pkgs;
897 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
898 Always returns a list: an empty list on success or a list of errors.
904 grep { $_->cancel } $self->ncancelled_pkgs;
909 Returns the agent (see L<FS::agent>) for this customer.
915 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
920 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
921 conjunction with the collect method.
923 Options are passed as name-value pairs.
925 The only currently available option is `time', which bills the customer as if
926 it were that time. It is specified as a UNIX timestamp; see
927 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
928 functions. For example:
932 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
934 If there is an error, returns the error, otherwise returns false.
939 my( $self, %options ) = @_;
940 my $time = $options{'time'} || time;
945 local $SIG{HUP} = 'IGNORE';
946 local $SIG{INT} = 'IGNORE';
947 local $SIG{QUIT} = 'IGNORE';
948 local $SIG{TERM} = 'IGNORE';
949 local $SIG{TSTP} = 'IGNORE';
950 local $SIG{PIPE} = 'IGNORE';
952 my $oldAutoCommit = $FS::UID::AutoCommit;
953 local $FS::UID::AutoCommit = 0;
956 # find the packages which are due for billing, find out how much they are
957 # & generate invoice database.
959 my( $total_setup, $total_recur ) = ( 0, 0 );
960 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
961 my @cust_bill_pkg = ();
963 #my $taxable_charged = 0;##
968 foreach my $cust_pkg (
969 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
972 #NO!! next if $cust_pkg->cancel;
973 next if $cust_pkg->getfield('cancel');
975 #? to avoid use of uninitialized value errors... ?
976 $cust_pkg->setfield('bill', '')
977 unless defined($cust_pkg->bill);
979 my $part_pkg = $cust_pkg->part_pkg;
981 #so we don't modify cust_pkg record unnecessarily
982 my $cust_pkg_mod_flag = 0;
983 my %hash = $cust_pkg->hash;
984 my $old_cust_pkg = new FS::cust_pkg \%hash;
990 unless ( $cust_pkg->setup ) {
991 my $setup_prog = $part_pkg->getfield('setup');
992 $setup_prog =~ /^(.*)$/ or do {
993 $dbh->rollback if $oldAutoCommit;
994 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
998 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1000 #my $cpt = new Safe;
1001 ##$cpt->permit(); #what is necessary?
1002 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1003 #$setup = $cpt->reval($setup_prog);
1004 $setup = eval $setup_prog;
1005 unless ( defined($setup) ) {
1006 $dbh->rollback if $oldAutoCommit;
1007 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1008 "(expression $setup_prog): $@";
1010 $cust_pkg->setfield('setup',$time);
1011 $cust_pkg_mod_flag=1;
1017 if ( $part_pkg->getfield('freq') > 0 &&
1018 ! $cust_pkg->getfield('susp') &&
1019 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1021 my $recur_prog = $part_pkg->getfield('recur');
1022 $recur_prog =~ /^(.*)$/ or do {
1023 $dbh->rollback if $oldAutoCommit;
1024 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1028 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1030 # shared with $recur_prog
1031 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1033 #my $cpt = new Safe;
1034 ##$cpt->permit(); #what is necessary?
1035 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1036 #$recur = $cpt->reval($recur_prog);
1037 $recur = eval $recur_prog;
1038 unless ( defined($recur) ) {
1039 $dbh->rollback if $oldAutoCommit;
1040 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1041 "(expression $recur_prog): $@";
1043 #change this bit to use Date::Manip? CAREFUL with timezones (see
1044 # mailing list archive)
1045 my ($sec,$min,$hour,$mday,$mon,$year) =
1046 (localtime($sdate) )[0,1,2,3,4,5];
1048 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1049 # only for figuring next bill date, nothing else, so, reset $sdate again
1051 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1052 $cust_pkg->last_bill($sdate)
1053 if $cust_pkg->dbdef_table->column('last_bill');
1055 $mon += $part_pkg->freq;
1056 until ( $mon < 12 ) { $mon -= 12; $year++; }
1057 $cust_pkg->setfield('bill',
1058 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1059 $cust_pkg_mod_flag = 1;
1062 warn "\$setup is undefined" unless defined($setup);
1063 warn "\$recur is undefined" unless defined($recur);
1064 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1066 my $taxable_charged = 0;
1067 if ( $cust_pkg_mod_flag ) {
1068 $error=$cust_pkg->replace($old_cust_pkg);
1069 if ( $error ) { #just in case
1070 $dbh->rollback if $oldAutoCommit;
1071 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1073 $setup = sprintf( "%.2f", $setup );
1074 $recur = sprintf( "%.2f", $recur );
1076 $dbh->rollback if $oldAutoCommit;
1077 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1080 $dbh->rollback if $oldAutoCommit;
1081 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1083 if ( $setup > 0 || $recur > 0 ) {
1084 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1085 'pkgnum' => $cust_pkg->pkgnum,
1089 'edate' => $cust_pkg->bill,
1090 'details' => \@details,
1092 push @cust_bill_pkg, $cust_bill_pkg;
1093 $total_setup += $setup;
1094 $total_recur += $recur;
1095 $taxable_charged += $setup
1096 unless $part_pkg->setuptax =~ /^Y$/i;
1097 $taxable_charged += $recur
1098 unless $part_pkg->recurtax =~ /^Y$/i;
1100 unless ( $self->tax =~ /Y/i
1101 || $self->payby eq 'COMP'
1102 || $taxable_charged == 0 ) {
1104 my $cust_main_county = qsearchs('cust_main_county',{
1105 'state' => $self->state,
1106 'county' => $self->county,
1107 'country' => $self->country,
1108 'taxclass' => $part_pkg->taxclass,
1110 $cust_main_county ||= qsearchs('cust_main_county',{
1111 'state' => $self->state,
1112 'county' => $self->county,
1113 'country' => $self->country,
1116 unless ( $cust_main_county ) {
1117 $dbh->rollback if $oldAutoCommit;
1119 "fatal: can't find tax rate for state/county/country/taxclass ".
1120 join('/', ( map $self->$_(), qw(state county country) ),
1121 $part_pkg->taxclass ). "\n";
1124 if ( $cust_main_county->exempt_amount ) {
1125 my ($mon,$year) = (localtime($sdate) )[4,5];
1127 my $freq = $part_pkg->freq || 1;
1128 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1129 foreach my $which_month ( 1 .. $freq ) {
1131 'custnum' => $self->custnum,
1132 'taxnum' => $cust_main_county->taxnum,
1133 'year' => 1900+$year,
1136 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1137 until ( $mon < 13 ) { $mon -= 12; $year++; }
1138 my $cust_tax_exempt =
1139 qsearchs('cust_tax_exempt', \%hash)
1140 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1141 my $remaining_exemption = sprintf("%.2f",
1142 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1143 if ( $remaining_exemption > 0 ) {
1144 my $addl = $remaining_exemption > $taxable_per_month
1145 ? $taxable_per_month
1146 : $remaining_exemption;
1147 $taxable_charged -= $addl;
1148 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1149 $cust_tax_exempt->hash,
1150 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1152 $error = $new_cust_tax_exempt->exemptnum
1153 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1154 : $new_cust_tax_exempt->insert;
1156 $dbh->rollback if $oldAutoCommit;
1157 return "fatal: can't update cust_tax_exempt: $error";
1160 } # if $remaining_exemption > 0
1162 } #foreach $which_month
1164 } #if $cust_main_county->exempt_amount
1166 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1168 #$tax += $taxable_charged * $cust_main_county->tax / 100
1169 $tax{ $cust_main_county->taxname || 'Tax' } +=
1170 $taxable_charged * $cust_main_county->tax / 100
1172 } #unless $self->tax =~ /Y/i
1173 # || $self->payby eq 'COMP'
1174 # || $taxable_charged == 0
1176 } #if $setup > 0 || $recur > 0
1178 } #if $cust_pkg_mod_flag
1180 } #foreach my $cust_pkg
1182 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1183 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1185 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1190 # unless ( $self->tax =~ /Y/i
1191 # || $self->payby eq 'COMP'
1192 # || $taxable_charged == 0 ) {
1193 # my $cust_main_county = qsearchs('cust_main_county',{
1194 # 'state' => $self->state,
1195 # 'county' => $self->county,
1196 # 'country' => $self->country,
1197 # } ) or die "fatal: can't find tax rate for state/county/country ".
1198 # $self->state. "/". $self->county. "/". $self->country. "\n";
1199 # my $tax = sprintf( "%.2f",
1200 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1203 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1204 my $tax = sprintf("%.2f", $tax{$taxname} );
1205 $charged = sprintf( "%.2f", $charged+$tax );
1207 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1213 'itemdesc' => $taxname,
1215 push @cust_bill_pkg, $cust_bill_pkg;
1219 my $cust_bill = new FS::cust_bill ( {
1220 'custnum' => $self->custnum,
1222 'charged' => $charged,
1224 $error = $cust_bill->insert;
1226 $dbh->rollback if $oldAutoCommit;
1227 return "can't create invoice for customer #". $self->custnum. ": $error";
1230 my $invnum = $cust_bill->invnum;
1232 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1234 $cust_bill_pkg->invnum($invnum);
1235 $error = $cust_bill_pkg->insert;
1237 $dbh->rollback if $oldAutoCommit;
1238 return "can't create invoice line item for customer #". $self->custnum.
1243 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1247 =item collect OPTIONS
1249 (Attempt to) collect money for this customer's outstanding invoices (see
1250 L<FS::cust_bill>). Usually used after the bill method.
1252 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1253 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1254 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1256 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1257 and the invoice events web interface.
1259 If there is an error, returns the error, otherwise returns false.
1261 Options are passed as name-value pairs.
1263 Currently available options are:
1265 invoice_time - Use this time when deciding when to print invoices and
1266 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>
1267 for conversion functions.
1269 retry_card - Retry cards even when not scheduled by invoice events.
1271 batch_card - This option is deprecated. See the invoice events web interface
1272 to control whether cards are batched or run against a realtime gateway.
1274 report_badcard - This option is deprecated.
1276 force_print - This option is deprecated; see the invoice events web interface.
1281 my( $self, %options ) = @_;
1282 my $invoice_time = $options{'invoice_time'} || time;
1285 local $SIG{HUP} = 'IGNORE';
1286 local $SIG{INT} = 'IGNORE';
1287 local $SIG{QUIT} = 'IGNORE';
1288 local $SIG{TERM} = 'IGNORE';
1289 local $SIG{TSTP} = 'IGNORE';
1290 local $SIG{PIPE} = 'IGNORE';
1292 my $oldAutoCommit = $FS::UID::AutoCommit;
1293 local $FS::UID::AutoCommit = 0;
1296 my $balance = $self->balance;
1297 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1298 unless ( $balance > 0 ) { #redundant?????
1299 $dbh->rollback if $oldAutoCommit; #hmm
1303 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1304 #false laziness w/replace
1305 foreach my $cust_bill_event (
1307 #$_->part_bill_event->plan eq 'realtime-card'
1308 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1309 && $_->status eq 'done'
1312 map { $_->cust_bill_event }
1313 grep { $_->cust_bill_event }
1314 $self->open_cust_bill
1316 my $error = $cust_bill_event->retry;
1318 $dbh->rollback if $oldAutoCommit;
1319 return "error scheduling invoice events for retry: $error";
1325 foreach my $cust_bill ( $self->cust_bill ) {
1327 #this has to be before next's
1328 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1332 $balance = sprintf( "%.2f", $balance - $amount );
1334 next unless $cust_bill->owed > 0;
1336 # don't try to charge for the same invoice if it's already in a batch
1337 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1339 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1341 next unless $amount > 0;
1344 foreach my $part_bill_event (
1345 sort { $a->seconds <=> $b->seconds
1346 || $a->weight <=> $b->weight
1347 || $a->eventpart <=> $b->eventpart }
1348 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1349 && ! qsearchs( 'cust_bill_event', {
1350 'invnum' => $cust_bill->invnum,
1351 'eventpart' => $_->eventpart,
1355 qsearch('part_bill_event', { 'payby' => $self->payby,
1356 'disabled' => '', } )
1359 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1361 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1363 my $cust_main = $self; #for callback
1364 my $error = eval $part_bill_event->eventcode;
1367 my $statustext = '';
1371 } elsif ( $error ) {
1373 $statustext = $error;
1378 #add cust_bill_event
1379 my $cust_bill_event = new FS::cust_bill_event {
1380 'invnum' => $cust_bill->invnum,
1381 'eventpart' => $part_bill_event->eventpart,
1382 #'_date' => $invoice_time,
1384 'status' => $status,
1385 'statustext' => $statustext,
1387 $error = $cust_bill_event->insert;
1389 #$dbh->rollback if $oldAutoCommit;
1390 #return "error: $error";
1392 # gah, even with transactions.
1393 $dbh->commit if $oldAutoCommit; #well.
1394 my $e = 'WARNING: Event run but database not updated - '.
1395 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1396 ', eventpart '. $part_bill_event->eventpart.
1407 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1412 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1414 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1415 via a Business::OnlinePayment realtime gateway. See
1416 L<http://420.am/business-onlinepayment> for supported gateways.
1418 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1420 Available options are: I<description>, I<invnum>, I<quiet>
1422 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1423 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1424 if set, will override the value from the customer record.
1426 I<description> is a free-text field passed to the gateway. It defaults to
1427 "Internet services".
1429 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1430 specified invoice. If you don't specify an I<invnum> you might want to
1431 call the B<apply_payments> method.
1433 I<quiet> can be set true to surpress email decline notices.
1435 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1440 my( $self, $method, $amount, %options ) = @_;
1441 $options{'description'} ||= 'Internet services';
1444 die "Real-time processing not enabled\n"
1445 unless $conf->exists('business-onlinepayment');
1446 eval "use Business::OnlinePayment";
1450 $self->set( $_ => $options{$_} )
1451 foreach grep { exists($options{$_}) }
1452 qw( payname address1 address2 city state zip payinfo paydate );
1455 my $bop_config = 'business-onlinepayment';
1456 $bop_config .= '-ach'
1457 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1458 my ( $processor, $login, $password, $action, @bop_options ) =
1459 $conf->config($bop_config);
1460 $action ||= 'normal authorization';
1461 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1465 my $address = $self->address1;
1466 $address .= ", ". $self->address2 if $self->address2;
1468 my($payname, $payfirst, $paylast);
1469 if ( $self->payname && $method ne 'ECHECK' ) {
1470 $payname = $self->payname;
1471 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1472 or return "Illegal payname $payname";
1473 ($payfirst, $paylast) = ($1, $2);
1475 $payfirst = $self->getfield('first');
1476 $paylast = $self->getfield('last');
1477 $payname = "$payfirst $paylast";
1480 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1481 if ( $conf->exists('emailinvoiceauto')
1482 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1483 push @invoicing_list, $self->all_emails;
1485 my $email = $invoicing_list[0];
1488 if ( $method eq 'CC' ) {
1489 $content{card_number} = $self->payinfo;
1490 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1491 $content{expiration} = "$2/$1";
1492 } elsif ( $method eq 'ECHECK' ) {
1493 my($account_number,$routing_code) = $self->payinfo;
1494 ( $content{account_number}, $content{routing_code} ) =
1495 split('@', $self->payinfo);
1496 $content{bank_name} = $self->payname;
1497 } elsif ( $method eq 'LEC' ) {
1498 $content{phone} = $self->payinfo;
1503 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1506 new Business::OnlinePayment( $processor, @bop_options );
1507 $transaction->content(
1510 'password' => $password,
1511 'action' => $action1,
1512 'description' => $options{'description'},
1513 'amount' => $amount,
1514 'invoice_number' => $options{'invnum'},
1515 'customer_id' => $self->custnum,
1516 'last_name' => $paylast,
1517 'first_name' => $payfirst,
1519 'address' => $address,
1520 'city' => $self->city,
1521 'state' => $self->state,
1522 'zip' => $self->zip,
1523 'country' => $self->country,
1524 'referer' => 'http://cleanwhisker.420.am/',
1526 'phone' => $self->daytime || $self->night,
1529 $transaction->submit();
1531 if ( $transaction->is_success() && $action2 ) {
1532 my $auth = $transaction->authorization;
1533 my $ordernum = $transaction->can('order_number')
1534 ? $transaction->order_number
1538 new Business::OnlinePayment( $processor, @bop_options );
1545 password => $password,
1546 order_number => $ordernum,
1548 authorization => $auth,
1549 description => $options{'description'},
1552 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1553 transaction_sequence_num local_transaction_date
1554 local_transaction_time AVS_result_code )) {
1555 $capture{$field} = $transaction->$field() if $transaction->can($field);
1558 $capture->content( %capture );
1562 unless ( $capture->is_success ) {
1563 my $e = "Authorization sucessful but capture failed, custnum #".
1564 $self->custnum. ': '. $capture->result_code.
1565 ": ". $capture->error_message;
1573 if ( $transaction->is_success() ) {
1575 my %method2payby = (
1581 my $cust_pay = new FS::cust_pay ( {
1582 'custnum' => $self->custnum,
1583 'invnum' => $options{'invnum'},
1586 'payby' => $method2payby{$method},
1587 'payinfo' => $self->payinfo,
1588 'paybatch' => "$processor:". $transaction->authorization,
1590 my $error = $cust_pay->insert;
1592 # gah, even with transactions.
1593 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1594 'error applying payment, invnum #' . $self->invnum.
1595 " ($processor): $error";
1604 my $perror = "$processor error: ". $transaction->error_message;
1606 if ( !$options{'quiet'} && $conf->exists('emaildecline')
1607 && grep { $_ ne 'POST' } $self->invoicing_list
1609 my @templ = $conf->config('declinetemplate');
1610 my $template = new Text::Template (
1612 SOURCE => [ map "$_\n", @templ ],
1613 ) or return "($perror) can't create template: $Text::Template::ERROR";
1614 $template->compile()
1615 or return "($perror) can't compile template: $Text::Template::ERROR";
1617 my $templ_hash = { error => $transaction->error_message };
1619 my $error = send_email(
1620 'from' => $conf->config('invoice_from'),
1621 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1622 'subject' => 'Your payment could not be processed',
1623 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1626 $perror .= " (also received error sending decline notification: $error)"
1638 Returns the total owed for this customer on all invoices
1639 (see L<FS::cust_bill/owed>).
1645 $self->total_owed_date(2145859200); #12/31/2037
1648 =item total_owed_date TIME
1650 Returns the total owed for this customer on all invoices with date earlier than
1651 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1652 see L<Time::Local> and L<Date::Parse> for conversion functions.
1656 sub total_owed_date {
1660 foreach my $cust_bill (
1661 grep { $_->_date <= $time }
1662 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1664 $total_bill += $cust_bill->owed;
1666 sprintf( "%.2f", $total_bill );
1671 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1672 to outstanding invoice balances in chronological order and returns the value
1673 of any remaining unapplied credits available for refund
1674 (see L<FS::cust_refund>).
1681 return 0 unless $self->total_credited;
1683 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1684 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1686 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1687 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1691 foreach my $cust_bill ( @invoices ) {
1694 if ( !defined($credit) || $credit->credited == 0) {
1695 $credit = pop @credits or last;
1698 if ($cust_bill->owed >= $credit->credited) {
1699 $amount=$credit->credited;
1701 $amount=$cust_bill->owed;
1704 my $cust_credit_bill = new FS::cust_credit_bill ( {
1705 'crednum' => $credit->crednum,
1706 'invnum' => $cust_bill->invnum,
1707 'amount' => $amount,
1709 my $error = $cust_credit_bill->insert;
1710 die $error if $error;
1712 redo if ($cust_bill->owed > 0);
1716 return $self->total_credited;
1719 =item apply_payments
1721 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1722 to outstanding invoice balances in chronological order.
1724 #and returns the value of any remaining unapplied payments.
1728 sub apply_payments {
1733 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1734 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1736 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1737 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1741 foreach my $cust_bill ( @invoices ) {
1744 if ( !defined($payment) || $payment->unapplied == 0 ) {
1745 $payment = pop @payments or last;
1748 if ( $cust_bill->owed >= $payment->unapplied ) {
1749 $amount = $payment->unapplied;
1751 $amount = $cust_bill->owed;
1754 my $cust_bill_pay = new FS::cust_bill_pay ( {
1755 'paynum' => $payment->paynum,
1756 'invnum' => $cust_bill->invnum,
1757 'amount' => $amount,
1759 my $error = $cust_bill_pay->insert;
1760 die $error if $error;
1762 redo if ( $cust_bill->owed > 0);
1766 return $self->total_unapplied_payments;
1769 =item total_credited
1771 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1772 customer. See L<FS::cust_credit/credited>.
1776 sub total_credited {
1778 my $total_credit = 0;
1779 foreach my $cust_credit ( qsearch('cust_credit', {
1780 'custnum' => $self->custnum,
1782 $total_credit += $cust_credit->credited;
1784 sprintf( "%.2f", $total_credit );
1787 =item total_unapplied_payments
1789 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1790 See L<FS::cust_pay/unapplied>.
1794 sub total_unapplied_payments {
1796 my $total_unapplied = 0;
1797 foreach my $cust_pay ( qsearch('cust_pay', {
1798 'custnum' => $self->custnum,
1800 $total_unapplied += $cust_pay->unapplied;
1802 sprintf( "%.2f", $total_unapplied );
1807 Returns the balance for this customer (total_owed minus total_credited
1808 minus total_unapplied_payments).
1815 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1819 =item balance_date TIME
1821 Returns the balance for this customer, only considering invoices with date
1822 earlier than TIME (total_owed_date minus total_credited minus
1823 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1824 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1833 $self->total_owed_date($time)
1834 - $self->total_credited
1835 - $self->total_unapplied_payments
1839 =item invoicing_list [ ARRAYREF ]
1841 If an arguement is given, sets these email addresses as invoice recipients
1842 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1843 (except as warnings), so use check_invoicing_list first.
1845 Returns a list of email addresses (with svcnum entries expanded).
1847 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1848 check it without disturbing anything by passing nothing.
1850 This interface may change in the future.
1854 sub invoicing_list {
1855 my( $self, $arrayref ) = @_;
1857 my @cust_main_invoice;
1858 if ( $self->custnum ) {
1859 @cust_main_invoice =
1860 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1862 @cust_main_invoice = ();
1864 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1865 #warn $cust_main_invoice->destnum;
1866 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1867 #warn $cust_main_invoice->destnum;
1868 my $error = $cust_main_invoice->delete;
1869 warn $error if $error;
1872 if ( $self->custnum ) {
1873 @cust_main_invoice =
1874 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1876 @cust_main_invoice = ();
1878 my %seen = map { $_->address => 1 } @cust_main_invoice;
1879 foreach my $address ( @{$arrayref} ) {
1880 next if exists $seen{$address} && $seen{$address};
1881 $seen{$address} = 1;
1882 my $cust_main_invoice = new FS::cust_main_invoice ( {
1883 'custnum' => $self->custnum,
1886 my $error = $cust_main_invoice->insert;
1887 warn $error if $error;
1890 if ( $self->custnum ) {
1892 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1898 =item check_invoicing_list ARRAYREF
1900 Checks these arguements as valid input for the invoicing_list method. If there
1901 is an error, returns the error, otherwise returns false.
1905 sub check_invoicing_list {
1906 my( $self, $arrayref ) = @_;
1907 foreach my $address ( @{$arrayref} ) {
1908 my $cust_main_invoice = new FS::cust_main_invoice ( {
1909 'custnum' => $self->custnum,
1912 my $error = $self->custnum
1913 ? $cust_main_invoice->check
1914 : $cust_main_invoice->checkdest
1916 return $error if $error;
1921 =item set_default_invoicing_list
1923 Sets the invoicing list to all accounts associated with this customer,
1924 overwriting any previous invoicing list.
1928 sub set_default_invoicing_list {
1930 $self->invoicing_list($self->all_emails);
1935 Returns the email addresses of all accounts provisioned for this customer.
1942 foreach my $cust_pkg ( $self->all_pkgs ) {
1943 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1945 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1946 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1948 $list{$_}=1 foreach map { $_->email } @svc_acct;
1953 =item invoicing_list_addpost
1955 Adds postal invoicing to this customer. If this customer is already configured
1956 to receive postal invoices, does nothing.
1960 sub invoicing_list_addpost {
1962 return if grep { $_ eq 'POST' } $self->invoicing_list;
1963 my @invoicing_list = $self->invoicing_list;
1964 push @invoicing_list, 'POST';
1965 $self->invoicing_list(\@invoicing_list);
1968 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1970 Returns an array of customers referred by this customer (referral_custnum set
1971 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1972 customers referred by customers referred by this customer and so on, inclusive.
1973 The default behavior is DEPTH 1 (no recursion).
1977 sub referral_cust_main {
1979 my $depth = @_ ? shift : 1;
1980 my $exclude = @_ ? shift : {};
1983 map { $exclude->{$_->custnum}++; $_; }
1984 grep { ! $exclude->{ $_->custnum } }
1985 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1989 map { $_->referral_cust_main($depth-1, $exclude) }
1996 =item referral_cust_main_ncancelled
1998 Same as referral_cust_main, except only returns customers with uncancelled
2003 sub referral_cust_main_ncancelled {
2005 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2008 =item referral_cust_pkg [ DEPTH ]
2010 Like referral_cust_main, except returns a flat list of all unsuspended (and
2011 uncancelled) packages for each customer. The number of items in this list may
2012 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2016 sub referral_cust_pkg {
2018 my $depth = @_ ? shift : 1;
2020 map { $_->unsuspended_pkgs }
2021 grep { $_->unsuspended_pkgs }
2022 $self->referral_cust_main($depth);
2025 =item credit AMOUNT, REASON
2027 Applies a credit to this customer. If there is an error, returns the error,
2028 otherwise returns false.
2033 my( $self, $amount, $reason ) = @_;
2034 my $cust_credit = new FS::cust_credit {
2035 'custnum' => $self->custnum,
2036 'amount' => $amount,
2037 'reason' => $reason,
2039 $cust_credit->insert;
2042 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2044 Creates a one-time charge for this customer. If there is an error, returns
2045 the error, otherwise returns false.
2050 my ( $self, $amount ) = ( shift, shift );
2051 my $pkg = @_ ? shift : 'One-time charge';
2052 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2053 my $taxclass = @_ ? shift : '';
2055 local $SIG{HUP} = 'IGNORE';
2056 local $SIG{INT} = 'IGNORE';
2057 local $SIG{QUIT} = 'IGNORE';
2058 local $SIG{TERM} = 'IGNORE';
2059 local $SIG{TSTP} = 'IGNORE';
2060 local $SIG{PIPE} = 'IGNORE';
2062 my $oldAutoCommit = $FS::UID::AutoCommit;
2063 local $FS::UID::AutoCommit = 0;
2066 my $part_pkg = new FS::part_pkg ( {
2068 'comment' => $comment,
2073 'taxclass' => $taxclass,
2076 my $error = $part_pkg->insert;
2078 $dbh->rollback if $oldAutoCommit;
2082 my $pkgpart = $part_pkg->pkgpart;
2083 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2084 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2085 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2086 $error = $type_pkgs->insert;
2088 $dbh->rollback if $oldAutoCommit;
2093 my $cust_pkg = new FS::cust_pkg ( {
2094 'custnum' => $self->custnum,
2095 'pkgpart' => $pkgpart,
2098 $error = $cust_pkg->insert;
2100 $dbh->rollback if $oldAutoCommit;
2104 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2111 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2117 sort { $a->_date <=> $b->_date }
2118 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2121 =item open_cust_bill
2123 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2128 sub open_cust_bill {
2130 grep { $_->owed > 0 } $self->cust_bill;
2139 =item check_and_rebuild_fuzzyfiles
2143 sub check_and_rebuild_fuzzyfiles {
2144 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2145 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2146 or &rebuild_fuzzyfiles;
2149 =item rebuild_fuzzyfiles
2153 sub rebuild_fuzzyfiles {
2155 use Fcntl qw(:flock);
2157 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2161 open(LASTLOCK,">>$dir/cust_main.last")
2162 or die "can't open $dir/cust_main.last: $!";
2163 flock(LASTLOCK,LOCK_EX)
2164 or die "can't lock $dir/cust_main.last: $!";
2166 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2168 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2169 if defined dbdef->table('cust_main')->column('ship_last');
2171 open (LASTCACHE,">$dir/cust_main.last.tmp")
2172 or die "can't open $dir/cust_main.last.tmp: $!";
2173 print LASTCACHE join("\n", @all_last), "\n";
2174 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2176 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2181 open(COMPANYLOCK,">>$dir/cust_main.company")
2182 or die "can't open $dir/cust_main.company: $!";
2183 flock(COMPANYLOCK,LOCK_EX)
2184 or die "can't lock $dir/cust_main.company: $!";
2186 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2188 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2189 if defined dbdef->table('cust_main')->column('ship_last');
2191 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2192 or die "can't open $dir/cust_main.company.tmp: $!";
2193 print COMPANYCACHE join("\n", @all_company), "\n";
2194 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2196 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2206 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2207 open(LASTCACHE,"<$dir/cust_main.last")
2208 or die "can't open $dir/cust_main.last: $!";
2209 my @array = map { chomp; $_; } <LASTCACHE>;
2219 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2220 open(COMPANYCACHE,"<$dir/cust_main.company")
2221 or die "can't open $dir/cust_main.last: $!";
2222 my @array = map { chomp; $_; } <COMPANYCACHE>;
2227 =item append_fuzzyfiles LASTNAME COMPANY
2231 sub append_fuzzyfiles {
2232 my( $last, $company ) = @_;
2234 &check_and_rebuild_fuzzyfiles;
2236 use Fcntl qw(:flock);
2238 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2242 open(LAST,">>$dir/cust_main.last")
2243 or die "can't open $dir/cust_main.last: $!";
2245 or die "can't lock $dir/cust_main.last: $!";
2247 print LAST "$last\n";
2250 or die "can't unlock $dir/cust_main.last: $!";
2256 open(COMPANY,">>$dir/cust_main.company")
2257 or die "can't open $dir/cust_main.company: $!";
2258 flock(COMPANY,LOCK_EX)
2259 or die "can't lock $dir/cust_main.company: $!";
2261 print COMPANY "$company\n";
2263 flock(COMPANY,LOCK_UN)
2264 or die "can't unlock $dir/cust_main.company: $!";
2278 #warn join('-',keys %$param);
2279 my $fh = $param->{filehandle};
2280 my $agentnum = $param->{agentnum};
2281 my $refnum = $param->{refnum};
2282 my $pkgpart = $param->{pkgpart};
2283 my @fields = @{$param->{fields}};
2285 eval "use Date::Parse;";
2287 eval "use Text::CSV_XS;";
2290 my $csv = new Text::CSV_XS;
2297 local $SIG{HUP} = 'IGNORE';
2298 local $SIG{INT} = 'IGNORE';
2299 local $SIG{QUIT} = 'IGNORE';
2300 local $SIG{TERM} = 'IGNORE';
2301 local $SIG{TSTP} = 'IGNORE';
2302 local $SIG{PIPE} = 'IGNORE';
2304 my $oldAutoCommit = $FS::UID::AutoCommit;
2305 local $FS::UID::AutoCommit = 0;
2308 #while ( $columns = $csv->getline($fh) ) {
2310 while ( defined($line=<$fh>) ) {
2312 $csv->parse($line) or do {
2313 $dbh->rollback if $oldAutoCommit;
2314 return "can't parse: ". $csv->error_input();
2317 my @columns = $csv->fields();
2318 #warn join('-',@columns);
2321 agentnum => $agentnum,
2323 country => 'US', #default
2324 payby => 'BILL', #default
2325 paydate => '12/2037', #default
2327 my $billtime = time;
2328 my %cust_pkg = ( pkgpart => $pkgpart );
2329 foreach my $field ( @fields ) {
2330 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2331 #$cust_pkg{$1} = str2time( shift @$columns );
2332 if ( $1 eq 'setup' ) {
2333 $billtime = str2time(shift @columns);
2335 $cust_pkg{$1} = str2time( shift @columns );
2338 #$cust_main{$field} = shift @$columns;
2339 $cust_main{$field} = shift @columns;
2343 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2344 my $cust_main = new FS::cust_main ( \%cust_main );
2346 tie my %hash, 'Tie::RefHash'; #this part is important
2347 $hash{$cust_pkg} = [] if $pkgpart;
2348 my $error = $cust_main->insert( \%hash );
2351 $dbh->rollback if $oldAutoCommit;
2352 return "can't insert customer for $line: $error";
2355 #false laziness w/bill.cgi
2356 $error = $cust_main->bill( 'time' => $billtime );
2358 $dbh->rollback if $oldAutoCommit;
2359 return "can't bill customer for $line: $error";
2362 $cust_main->apply_payments;
2363 $cust_main->apply_credits;
2365 $error = $cust_main->collect();
2367 $dbh->rollback if $oldAutoCommit;
2368 return "can't collect customer for $line: $error";
2374 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2376 return "Empty file!" unless $imported;
2388 #warn join('-',keys %$param);
2389 my $fh = $param->{filehandle};
2390 my @fields = @{$param->{fields}};
2392 eval "use Date::Parse;";
2394 eval "use Text::CSV_XS;";
2397 my $csv = new Text::CSV_XS;
2404 local $SIG{HUP} = 'IGNORE';
2405 local $SIG{INT} = 'IGNORE';
2406 local $SIG{QUIT} = 'IGNORE';
2407 local $SIG{TERM} = 'IGNORE';
2408 local $SIG{TSTP} = 'IGNORE';
2409 local $SIG{PIPE} = 'IGNORE';
2411 my $oldAutoCommit = $FS::UID::AutoCommit;
2412 local $FS::UID::AutoCommit = 0;
2415 #while ( $columns = $csv->getline($fh) ) {
2417 while ( defined($line=<$fh>) ) {
2419 $csv->parse($line) or do {
2420 $dbh->rollback if $oldAutoCommit;
2421 return "can't parse: ". $csv->error_input();
2424 my @columns = $csv->fields();
2425 #warn join('-',@columns);
2428 foreach my $field ( @fields ) {
2429 $row{$field} = shift @columns;
2432 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2433 unless ( $cust_main ) {
2434 $dbh->rollback if $oldAutoCommit;
2435 return "unknown custnum $row{'custnum'}";
2438 if ( $row{'amount'} > 0 ) {
2439 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2441 $dbh->rollback if $oldAutoCommit;
2445 } elsif ( $row{'amount'} < 0 ) {
2446 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2449 $dbh->rollback if $oldAutoCommit;
2459 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2461 return "Empty file!" unless $imported;
2473 The delete method should possibly take an FS::cust_main object reference
2474 instead of a scalar customer number.
2476 Bill and collect options should probably be passed as references instead of a
2479 There should probably be a configuration file with a list of allowed credit
2482 No multiple currency support (probably a larger project than just this module).
2486 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2487 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2488 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.