4 use vars qw( @ISA $conf $Debug $import );
8 eval "use Time::Local;";
9 die "Time::Local version 1.05 required with Perl versions before 5.6"
10 if $] < 5.006 && !defined($Time::Local::VERSION);
11 eval "use Time::Local qw(timelocal_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 $error = $self->queue_fuzzyfiles_update;
311 $dbh->rollback if $oldAutoCommit;
312 return "updating fuzzy search cache: $error";
315 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
322 document me. like ->insert(%cust_pkg) on an existing record
328 my $cust_pkgs = shift;
331 local $SIG{HUP} = 'IGNORE';
332 local $SIG{INT} = 'IGNORE';
333 local $SIG{QUIT} = 'IGNORE';
334 local $SIG{TERM} = 'IGNORE';
335 local $SIG{TSTP} = 'IGNORE';
336 local $SIG{PIPE} = 'IGNORE';
338 my $oldAutoCommit = $FS::UID::AutoCommit;
339 local $FS::UID::AutoCommit = 0;
342 foreach my $cust_pkg ( keys %$cust_pkgs ) {
343 $cust_pkg->custnum( $self->custnum );
344 my $error = $cust_pkg->insert;
346 $dbh->rollback if $oldAutoCommit;
347 return "inserting cust_pkg (transaction rolled back): $error";
349 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
350 $svc_something->pkgnum( $cust_pkg->pkgnum );
351 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
352 $svc_something->seconds( $svc_something->seconds + $$seconds );
355 $error = $svc_something->insert;
357 $dbh->rollback if $oldAutoCommit;
358 #return "inserting svc_ (transaction rolled back): $error";
364 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
368 =item delete NEW_CUSTNUM
370 This deletes the customer. If there is an error, returns the error, otherwise
373 This will completely remove all traces of the customer record. This is not
374 what you want when a customer cancels service; for that, cancel all of the
375 customer's packages (see L<FS::cust_pkg/cancel>).
377 If the customer has any uncancelled packages, you need to pass a new (valid)
378 customer number for those packages to be transferred to. Cancelled packages
379 will be deleted. Did I mention that this is NOT what you want when a customer
380 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
382 You can't delete a customer with invoices (see L<FS::cust_bill>),
383 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
384 refunds (see L<FS::cust_refund>).
391 local $SIG{HUP} = 'IGNORE';
392 local $SIG{INT} = 'IGNORE';
393 local $SIG{QUIT} = 'IGNORE';
394 local $SIG{TERM} = 'IGNORE';
395 local $SIG{TSTP} = 'IGNORE';
396 local $SIG{PIPE} = 'IGNORE';
398 my $oldAutoCommit = $FS::UID::AutoCommit;
399 local $FS::UID::AutoCommit = 0;
402 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
403 $dbh->rollback if $oldAutoCommit;
404 return "Can't delete a customer with invoices";
406 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
407 $dbh->rollback if $oldAutoCommit;
408 return "Can't delete a customer with credits";
410 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
411 $dbh->rollback if $oldAutoCommit;
412 return "Can't delete a customer with payments";
414 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
415 $dbh->rollback if $oldAutoCommit;
416 return "Can't delete a customer with refunds";
419 my @cust_pkg = $self->ncancelled_pkgs;
421 my $new_custnum = shift;
422 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
423 $dbh->rollback if $oldAutoCommit;
424 return "Invalid new customer number: $new_custnum";
426 foreach my $cust_pkg ( @cust_pkg ) {
427 my %hash = $cust_pkg->hash;
428 $hash{'custnum'} = $new_custnum;
429 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
430 my $error = $new_cust_pkg->replace($cust_pkg);
432 $dbh->rollback if $oldAutoCommit;
437 my @cancelled_cust_pkg = $self->all_pkgs;
438 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
439 my $error = $cust_pkg->delete;
441 $dbh->rollback if $oldAutoCommit;
446 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
447 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
449 my $error = $cust_main_invoice->delete;
451 $dbh->rollback if $oldAutoCommit;
456 my $error = $self->SUPER::delete;
458 $dbh->rollback if $oldAutoCommit;
462 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
467 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
469 Replaces the OLD_RECORD with this one in the database. If there is an error,
470 returns the error, otherwise returns false.
472 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
473 be set as the invoicing list (see L<"invoicing_list">). Errors return as
474 expected and rollback the entire transaction; it is not necessary to call
475 check_invoicing_list first. Here's an example:
477 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
486 local $SIG{HUP} = 'IGNORE';
487 local $SIG{INT} = 'IGNORE';
488 local $SIG{QUIT} = 'IGNORE';
489 local $SIG{TERM} = 'IGNORE';
490 local $SIG{TSTP} = 'IGNORE';
491 local $SIG{PIPE} = 'IGNORE';
493 my $oldAutoCommit = $FS::UID::AutoCommit;
494 local $FS::UID::AutoCommit = 0;
497 my $error = $self->SUPER::replace($old);
500 $dbh->rollback if $oldAutoCommit;
504 if ( @param ) { # INVOICING_LIST_ARYREF
505 my $invoicing_list = shift @param;
506 $error = $self->check_invoicing_list( $invoicing_list );
508 $dbh->rollback if $oldAutoCommit;
511 $self->invoicing_list( $invoicing_list );
514 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
515 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
516 # card/check/lec info has changed, want to retry realtime_ invoice events
517 my $error = $self->retry_realtime;
519 $dbh->rollback if $oldAutoCommit;
524 $error = $self->queue_fuzzyfiles_update;
526 $dbh->rollback if $oldAutoCommit;
527 return "updating fuzzy search cache: $error";
530 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
535 =item queue_fuzzyfiles_update
537 Used by insert & replace to update the fuzzy search cache
541 sub queue_fuzzyfiles_update {
544 local $SIG{HUP} = 'IGNORE';
545 local $SIG{INT} = 'IGNORE';
546 local $SIG{QUIT} = 'IGNORE';
547 local $SIG{TERM} = 'IGNORE';
548 local $SIG{TSTP} = 'IGNORE';
549 local $SIG{PIPE} = 'IGNORE';
551 my $oldAutoCommit = $FS::UID::AutoCommit;
552 local $FS::UID::AutoCommit = 0;
555 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
556 my $error = $queue->insert($self->getfield('last'), $self->company);
558 $dbh->rollback if $oldAutoCommit;
559 return "queueing job (transaction rolled back): $error";
562 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
563 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
564 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
566 $dbh->rollback if $oldAutoCommit;
567 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 - Retry card/echeck/LEC transactions even when not scheduled by invoice
1282 retry_card - Deprecated alias for 'retry'
1284 batch_card - This option is deprecated. See the invoice events web interface
1285 to control whether cards are batched or run against a realtime gateway.
1287 report_badcard - This option is deprecated.
1289 force_print - This option is deprecated; see the invoice events web interface.
1294 my( $self, %options ) = @_;
1295 my $invoice_time = $options{'invoice_time'} || time;
1298 local $SIG{HUP} = 'IGNORE';
1299 local $SIG{INT} = 'IGNORE';
1300 local $SIG{QUIT} = 'IGNORE';
1301 local $SIG{TERM} = 'IGNORE';
1302 local $SIG{TSTP} = 'IGNORE';
1303 local $SIG{PIPE} = 'IGNORE';
1305 my $oldAutoCommit = $FS::UID::AutoCommit;
1306 local $FS::UID::AutoCommit = 0;
1309 my $balance = $self->balance;
1310 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1311 unless ( $balance > 0 ) { #redundant?????
1312 $dbh->rollback if $oldAutoCommit; #hmm
1316 if ( exists($options{'retry_card'}) ) {
1317 carp 'retry_card option passed to collect is deprecated; use retry';
1318 $options{'retry'} ||= $options{'retry_card'};
1320 if ( exists($options{'retry'}) && $options{'retry'} ) {
1321 my $error = $self->retry_realtime;
1323 $dbh->rollback if $oldAutoCommit;
1328 foreach my $cust_bill ( $self->cust_bill ) {
1330 #this has to be before next's
1331 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1335 $balance = sprintf( "%.2f", $balance - $amount );
1337 next unless $cust_bill->owed > 0;
1339 # don't try to charge for the same invoice if it's already in a batch
1340 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1342 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1344 next unless $amount > 0;
1347 foreach my $part_bill_event (
1348 sort { $a->seconds <=> $b->seconds
1349 || $a->weight <=> $b->weight
1350 || $a->eventpart <=> $b->eventpart }
1351 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1352 && ! qsearchs( 'cust_bill_event', {
1353 'invnum' => $cust_bill->invnum,
1354 'eventpart' => $_->eventpart,
1358 qsearch('part_bill_event', { 'payby' => $self->payby,
1359 'disabled' => '', } )
1362 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1364 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1366 my $cust_main = $self; #for callback
1367 my $error = eval $part_bill_event->eventcode;
1370 my $statustext = '';
1374 } elsif ( $error ) {
1376 $statustext = $error;
1381 #add cust_bill_event
1382 my $cust_bill_event = new FS::cust_bill_event {
1383 'invnum' => $cust_bill->invnum,
1384 'eventpart' => $part_bill_event->eventpart,
1385 #'_date' => $invoice_time,
1387 'status' => $status,
1388 'statustext' => $statustext,
1390 $error = $cust_bill_event->insert;
1392 #$dbh->rollback if $oldAutoCommit;
1393 #return "error: $error";
1395 # gah, even with transactions.
1396 $dbh->commit if $oldAutoCommit; #well.
1397 my $e = 'WARNING: Event run but database not updated - '.
1398 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1399 ', eventpart '. $part_bill_event->eventpart.
1410 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1415 =item retry_realtime
1417 Schedules realtime credit card / electronic check / LEC billing events for
1418 for retry. Useful if card information has changed or manual retry is desired.
1419 The 'collect' method must be called to actually retry the transaction.
1421 Implementation details: For each of this customer's open invoices, changes
1422 the status of the first "done" (with statustext error) realtime processing
1427 sub retry_realtime {
1430 local $SIG{HUP} = 'IGNORE';
1431 local $SIG{INT} = 'IGNORE';
1432 local $SIG{QUIT} = 'IGNORE';
1433 local $SIG{TERM} = 'IGNORE';
1434 local $SIG{TSTP} = 'IGNORE';
1435 local $SIG{PIPE} = 'IGNORE';
1437 my $oldAutoCommit = $FS::UID::AutoCommit;
1438 local $FS::UID::AutoCommit = 0;
1441 foreach my $cust_bill (
1442 grep { $_->cust_bill_event }
1443 $self->open_cust_bill
1445 my @cust_bill_event =
1446 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1448 #$_->part_bill_event->plan eq 'realtime-card'
1449 $_->part_bill_event->eventcode =~
1450 /\$cust_bill\->realtime_(card|ach|lec)$/
1451 && $_->status eq 'done'
1454 $_->cust_bill_event;
1455 next unless @cust_bill_event;
1456 my $error = $cust_bill_event[0]->retry;
1458 $dbh->rollback if $oldAutoCommit;
1459 return "error scheduling invoice event for retry: $error";
1464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1469 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1471 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1472 via a Business::OnlinePayment realtime gateway. See
1473 L<http://420.am/business-onlinepayment> for supported gateways.
1475 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1477 Available options are: I<description>, I<invnum>, I<quiet>
1479 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1480 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1481 if set, will override the value from the customer record.
1483 I<description> is a free-text field passed to the gateway. It defaults to
1484 "Internet services".
1486 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1487 specified invoice. If you don't specify an I<invnum> you might want to
1488 call the B<apply_payments> method.
1490 I<quiet> can be set true to surpress email decline notices.
1492 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1497 my( $self, $method, $amount, %options ) = @_;
1499 warn "$self $method $amount\n";
1500 warn " $_ => $options{$_}\n" foreach keys %options;
1503 $options{'description'} ||= 'Internet services';
1506 die "Real-time processing not enabled\n"
1507 unless $conf->exists('business-onlinepayment');
1508 eval "use Business::OnlinePayment";
1512 $self->set( $_ => $options{$_} )
1513 foreach grep { exists($options{$_}) }
1514 qw( payname address1 address2 city state zip payinfo paydate );
1517 my $bop_config = 'business-onlinepayment';
1518 $bop_config .= '-ach'
1519 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1520 my ( $processor, $login, $password, $action, @bop_options ) =
1521 $conf->config($bop_config);
1522 $action ||= 'normal authorization';
1523 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1527 my $address = $self->address1;
1528 $address .= ", ". $self->address2 if $self->address2;
1530 my($payname, $payfirst, $paylast);
1531 if ( $self->payname && $method ne 'ECHECK' ) {
1532 $payname = $self->payname;
1533 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1534 or return "Illegal payname $payname";
1535 ($payfirst, $paylast) = ($1, $2);
1537 $payfirst = $self->getfield('first');
1538 $paylast = $self->getfield('last');
1539 $payname = "$payfirst $paylast";
1542 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1543 if ( $conf->exists('emailinvoiceauto')
1544 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1545 push @invoicing_list, $self->all_emails;
1547 my $email = $invoicing_list[0];
1550 if ( $method eq 'CC' ) {
1551 $content{card_number} = $self->payinfo;
1552 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1553 $content{expiration} = "$2/$1";
1554 } elsif ( $method eq 'ECHECK' ) {
1555 my($account_number,$routing_code) = $self->payinfo;
1556 ( $content{account_number}, $content{routing_code} ) =
1557 split('@', $self->payinfo);
1558 $content{bank_name} = $self->payname;
1559 } elsif ( $method eq 'LEC' ) {
1560 $content{phone} = $self->payinfo;
1565 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1568 new Business::OnlinePayment( $processor, @bop_options );
1569 $transaction->content(
1572 'password' => $password,
1573 'action' => $action1,
1574 'description' => $options{'description'},
1575 'amount' => $amount,
1576 'invoice_number' => $options{'invnum'},
1577 'customer_id' => $self->custnum,
1578 'last_name' => $paylast,
1579 'first_name' => $payfirst,
1581 'address' => $address,
1582 'city' => $self->city,
1583 'state' => $self->state,
1584 'zip' => $self->zip,
1585 'country' => $self->country,
1586 'referer' => 'http://cleanwhisker.420.am/',
1588 'phone' => $self->daytime || $self->night,
1591 $transaction->submit();
1593 if ( $transaction->is_success() && $action2 ) {
1594 my $auth = $transaction->authorization;
1595 my $ordernum = $transaction->can('order_number')
1596 ? $transaction->order_number
1600 new Business::OnlinePayment( $processor, @bop_options );
1607 password => $password,
1608 order_number => $ordernum,
1610 authorization => $auth,
1611 description => $options{'description'},
1614 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1615 transaction_sequence_num local_transaction_date
1616 local_transaction_time AVS_result_code )) {
1617 $capture{$field} = $transaction->$field() if $transaction->can($field);
1620 $capture->content( %capture );
1624 unless ( $capture->is_success ) {
1625 my $e = "Authorization sucessful but capture failed, custnum #".
1626 $self->custnum. ': '. $capture->result_code.
1627 ": ". $capture->error_message;
1635 if ( $transaction->is_success() ) {
1637 my %method2payby = (
1643 my $cust_pay = new FS::cust_pay ( {
1644 'custnum' => $self->custnum,
1645 'invnum' => $options{'invnum'},
1648 'payby' => $method2payby{$method},
1649 'payinfo' => $self->payinfo,
1650 'paybatch' => "$processor:". $transaction->authorization,
1652 my $error = $cust_pay->insert;
1654 # gah, even with transactions.
1655 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1656 'error applying payment, invnum #' . $self->invnum.
1657 " ($processor): $error";
1666 my $perror = "$processor error: ". $transaction->error_message;
1668 if ( !$options{'quiet'} && $conf->exists('emaildecline')
1669 && grep { $_ ne 'POST' } $self->invoicing_list
1671 my @templ = $conf->config('declinetemplate');
1672 my $template = new Text::Template (
1674 SOURCE => [ map "$_\n", @templ ],
1675 ) or return "($perror) can't create template: $Text::Template::ERROR";
1676 $template->compile()
1677 or return "($perror) can't compile template: $Text::Template::ERROR";
1679 my $templ_hash = { error => $transaction->error_message };
1681 my $error = send_email(
1682 'from' => $conf->config('invoice_from'),
1683 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1684 'subject' => 'Your payment could not be processed',
1685 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1688 $perror .= " (also received error sending decline notification: $error)"
1700 Returns the total owed for this customer on all invoices
1701 (see L<FS::cust_bill/owed>).
1707 $self->total_owed_date(2145859200); #12/31/2037
1710 =item total_owed_date TIME
1712 Returns the total owed for this customer on all invoices with date earlier than
1713 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1714 see L<Time::Local> and L<Date::Parse> for conversion functions.
1718 sub total_owed_date {
1722 foreach my $cust_bill (
1723 grep { $_->_date <= $time }
1724 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1726 $total_bill += $cust_bill->owed;
1728 sprintf( "%.2f", $total_bill );
1733 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1734 to outstanding invoice balances in chronological order and returns the value
1735 of any remaining unapplied credits available for refund
1736 (see L<FS::cust_refund>).
1743 return 0 unless $self->total_credited;
1745 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1746 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1748 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1749 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1753 foreach my $cust_bill ( @invoices ) {
1756 if ( !defined($credit) || $credit->credited == 0) {
1757 $credit = pop @credits or last;
1760 if ($cust_bill->owed >= $credit->credited) {
1761 $amount=$credit->credited;
1763 $amount=$cust_bill->owed;
1766 my $cust_credit_bill = new FS::cust_credit_bill ( {
1767 'crednum' => $credit->crednum,
1768 'invnum' => $cust_bill->invnum,
1769 'amount' => $amount,
1771 my $error = $cust_credit_bill->insert;
1772 die $error if $error;
1774 redo if ($cust_bill->owed > 0);
1778 return $self->total_credited;
1781 =item apply_payments
1783 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1784 to outstanding invoice balances in chronological order.
1786 #and returns the value of any remaining unapplied payments.
1790 sub apply_payments {
1795 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1796 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1798 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1799 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1803 foreach my $cust_bill ( @invoices ) {
1806 if ( !defined($payment) || $payment->unapplied == 0 ) {
1807 $payment = pop @payments or last;
1810 if ( $cust_bill->owed >= $payment->unapplied ) {
1811 $amount = $payment->unapplied;
1813 $amount = $cust_bill->owed;
1816 my $cust_bill_pay = new FS::cust_bill_pay ( {
1817 'paynum' => $payment->paynum,
1818 'invnum' => $cust_bill->invnum,
1819 'amount' => $amount,
1821 my $error = $cust_bill_pay->insert;
1822 die $error if $error;
1824 redo if ( $cust_bill->owed > 0);
1828 return $self->total_unapplied_payments;
1831 =item total_credited
1833 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1834 customer. See L<FS::cust_credit/credited>.
1838 sub total_credited {
1840 my $total_credit = 0;
1841 foreach my $cust_credit ( qsearch('cust_credit', {
1842 'custnum' => $self->custnum,
1844 $total_credit += $cust_credit->credited;
1846 sprintf( "%.2f", $total_credit );
1849 =item total_unapplied_payments
1851 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1852 See L<FS::cust_pay/unapplied>.
1856 sub total_unapplied_payments {
1858 my $total_unapplied = 0;
1859 foreach my $cust_pay ( qsearch('cust_pay', {
1860 'custnum' => $self->custnum,
1862 $total_unapplied += $cust_pay->unapplied;
1864 sprintf( "%.2f", $total_unapplied );
1869 Returns the balance for this customer (total_owed minus total_credited
1870 minus total_unapplied_payments).
1877 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1881 =item balance_date TIME
1883 Returns the balance for this customer, only considering invoices with date
1884 earlier than TIME (total_owed_date minus total_credited minus
1885 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1886 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1895 $self->total_owed_date($time)
1896 - $self->total_credited
1897 - $self->total_unapplied_payments
1901 =item invoicing_list [ ARRAYREF ]
1903 If an arguement is given, sets these email addresses as invoice recipients
1904 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1905 (except as warnings), so use check_invoicing_list first.
1907 Returns a list of email addresses (with svcnum entries expanded).
1909 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1910 check it without disturbing anything by passing nothing.
1912 This interface may change in the future.
1916 sub invoicing_list {
1917 my( $self, $arrayref ) = @_;
1919 my @cust_main_invoice;
1920 if ( $self->custnum ) {
1921 @cust_main_invoice =
1922 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1924 @cust_main_invoice = ();
1926 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1927 #warn $cust_main_invoice->destnum;
1928 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1929 #warn $cust_main_invoice->destnum;
1930 my $error = $cust_main_invoice->delete;
1931 warn $error if $error;
1934 if ( $self->custnum ) {
1935 @cust_main_invoice =
1936 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1938 @cust_main_invoice = ();
1940 my %seen = map { $_->address => 1 } @cust_main_invoice;
1941 foreach my $address ( @{$arrayref} ) {
1942 next if exists $seen{$address} && $seen{$address};
1943 $seen{$address} = 1;
1944 my $cust_main_invoice = new FS::cust_main_invoice ( {
1945 'custnum' => $self->custnum,
1948 my $error = $cust_main_invoice->insert;
1949 warn $error if $error;
1952 if ( $self->custnum ) {
1954 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1960 =item check_invoicing_list ARRAYREF
1962 Checks these arguements as valid input for the invoicing_list method. If there
1963 is an error, returns the error, otherwise returns false.
1967 sub check_invoicing_list {
1968 my( $self, $arrayref ) = @_;
1969 foreach my $address ( @{$arrayref} ) {
1970 my $cust_main_invoice = new FS::cust_main_invoice ( {
1971 'custnum' => $self->custnum,
1974 my $error = $self->custnum
1975 ? $cust_main_invoice->check
1976 : $cust_main_invoice->checkdest
1978 return $error if $error;
1983 =item set_default_invoicing_list
1985 Sets the invoicing list to all accounts associated with this customer,
1986 overwriting any previous invoicing list.
1990 sub set_default_invoicing_list {
1992 $self->invoicing_list($self->all_emails);
1997 Returns the email addresses of all accounts provisioned for this customer.
2004 foreach my $cust_pkg ( $self->all_pkgs ) {
2005 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2007 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2008 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2010 $list{$_}=1 foreach map { $_->email } @svc_acct;
2015 =item invoicing_list_addpost
2017 Adds postal invoicing to this customer. If this customer is already configured
2018 to receive postal invoices, does nothing.
2022 sub invoicing_list_addpost {
2024 return if grep { $_ eq 'POST' } $self->invoicing_list;
2025 my @invoicing_list = $self->invoicing_list;
2026 push @invoicing_list, 'POST';
2027 $self->invoicing_list(\@invoicing_list);
2030 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2032 Returns an array of customers referred by this customer (referral_custnum set
2033 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2034 customers referred by customers referred by this customer and so on, inclusive.
2035 The default behavior is DEPTH 1 (no recursion).
2039 sub referral_cust_main {
2041 my $depth = @_ ? shift : 1;
2042 my $exclude = @_ ? shift : {};
2045 map { $exclude->{$_->custnum}++; $_; }
2046 grep { ! $exclude->{ $_->custnum } }
2047 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2051 map { $_->referral_cust_main($depth-1, $exclude) }
2058 =item referral_cust_main_ncancelled
2060 Same as referral_cust_main, except only returns customers with uncancelled
2065 sub referral_cust_main_ncancelled {
2067 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2070 =item referral_cust_pkg [ DEPTH ]
2072 Like referral_cust_main, except returns a flat list of all unsuspended (and
2073 uncancelled) packages for each customer. The number of items in this list may
2074 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2078 sub referral_cust_pkg {
2080 my $depth = @_ ? shift : 1;
2082 map { $_->unsuspended_pkgs }
2083 grep { $_->unsuspended_pkgs }
2084 $self->referral_cust_main($depth);
2087 =item credit AMOUNT, REASON
2089 Applies a credit to this customer. If there is an error, returns the error,
2090 otherwise returns false.
2095 my( $self, $amount, $reason ) = @_;
2096 my $cust_credit = new FS::cust_credit {
2097 'custnum' => $self->custnum,
2098 'amount' => $amount,
2099 'reason' => $reason,
2101 $cust_credit->insert;
2104 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2106 Creates a one-time charge for this customer. If there is an error, returns
2107 the error, otherwise returns false.
2112 my ( $self, $amount ) = ( shift, shift );
2113 my $pkg = @_ ? shift : 'One-time charge';
2114 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2115 my $taxclass = @_ ? shift : '';
2117 local $SIG{HUP} = 'IGNORE';
2118 local $SIG{INT} = 'IGNORE';
2119 local $SIG{QUIT} = 'IGNORE';
2120 local $SIG{TERM} = 'IGNORE';
2121 local $SIG{TSTP} = 'IGNORE';
2122 local $SIG{PIPE} = 'IGNORE';
2124 my $oldAutoCommit = $FS::UID::AutoCommit;
2125 local $FS::UID::AutoCommit = 0;
2128 my $part_pkg = new FS::part_pkg ( {
2130 'comment' => $comment,
2135 'taxclass' => $taxclass,
2138 my $error = $part_pkg->insert;
2140 $dbh->rollback if $oldAutoCommit;
2144 my $pkgpart = $part_pkg->pkgpart;
2145 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2146 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2147 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2148 $error = $type_pkgs->insert;
2150 $dbh->rollback if $oldAutoCommit;
2155 my $cust_pkg = new FS::cust_pkg ( {
2156 'custnum' => $self->custnum,
2157 'pkgpart' => $pkgpart,
2160 $error = $cust_pkg->insert;
2162 $dbh->rollback if $oldAutoCommit;
2166 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2173 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2179 sort { $a->_date <=> $b->_date }
2180 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2183 =item open_cust_bill
2185 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2190 sub open_cust_bill {
2192 grep { $_->owed > 0 } $self->cust_bill;
2201 =item check_and_rebuild_fuzzyfiles
2205 sub check_and_rebuild_fuzzyfiles {
2206 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2207 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2208 or &rebuild_fuzzyfiles;
2211 =item rebuild_fuzzyfiles
2215 sub rebuild_fuzzyfiles {
2217 use Fcntl qw(:flock);
2219 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2223 open(LASTLOCK,">>$dir/cust_main.last")
2224 or die "can't open $dir/cust_main.last: $!";
2225 flock(LASTLOCK,LOCK_EX)
2226 or die "can't lock $dir/cust_main.last: $!";
2228 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2230 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2231 if defined dbdef->table('cust_main')->column('ship_last');
2233 open (LASTCACHE,">$dir/cust_main.last.tmp")
2234 or die "can't open $dir/cust_main.last.tmp: $!";
2235 print LASTCACHE join("\n", @all_last), "\n";
2236 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2238 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2243 open(COMPANYLOCK,">>$dir/cust_main.company")
2244 or die "can't open $dir/cust_main.company: $!";
2245 flock(COMPANYLOCK,LOCK_EX)
2246 or die "can't lock $dir/cust_main.company: $!";
2248 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2250 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2251 if defined dbdef->table('cust_main')->column('ship_last');
2253 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2254 or die "can't open $dir/cust_main.company.tmp: $!";
2255 print COMPANYCACHE join("\n", @all_company), "\n";
2256 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2258 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2268 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2269 open(LASTCACHE,"<$dir/cust_main.last")
2270 or die "can't open $dir/cust_main.last: $!";
2271 my @array = map { chomp; $_; } <LASTCACHE>;
2281 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2282 open(COMPANYCACHE,"<$dir/cust_main.company")
2283 or die "can't open $dir/cust_main.last: $!";
2284 my @array = map { chomp; $_; } <COMPANYCACHE>;
2289 =item append_fuzzyfiles LASTNAME COMPANY
2293 sub append_fuzzyfiles {
2294 my( $last, $company ) = @_;
2296 &check_and_rebuild_fuzzyfiles;
2298 use Fcntl qw(:flock);
2300 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2304 open(LAST,">>$dir/cust_main.last")
2305 or die "can't open $dir/cust_main.last: $!";
2307 or die "can't lock $dir/cust_main.last: $!";
2309 print LAST "$last\n";
2312 or die "can't unlock $dir/cust_main.last: $!";
2318 open(COMPANY,">>$dir/cust_main.company")
2319 or die "can't open $dir/cust_main.company: $!";
2320 flock(COMPANY,LOCK_EX)
2321 or die "can't lock $dir/cust_main.company: $!";
2323 print COMPANY "$company\n";
2325 flock(COMPANY,LOCK_UN)
2326 or die "can't unlock $dir/cust_main.company: $!";
2340 #warn join('-',keys %$param);
2341 my $fh = $param->{filehandle};
2342 my $agentnum = $param->{agentnum};
2343 my $refnum = $param->{refnum};
2344 my $pkgpart = $param->{pkgpart};
2345 my @fields = @{$param->{fields}};
2347 eval "use Date::Parse;";
2349 eval "use Text::CSV_XS;";
2352 my $csv = new Text::CSV_XS;
2359 local $SIG{HUP} = 'IGNORE';
2360 local $SIG{INT} = 'IGNORE';
2361 local $SIG{QUIT} = 'IGNORE';
2362 local $SIG{TERM} = 'IGNORE';
2363 local $SIG{TSTP} = 'IGNORE';
2364 local $SIG{PIPE} = 'IGNORE';
2366 my $oldAutoCommit = $FS::UID::AutoCommit;
2367 local $FS::UID::AutoCommit = 0;
2370 #while ( $columns = $csv->getline($fh) ) {
2372 while ( defined($line=<$fh>) ) {
2374 $csv->parse($line) or do {
2375 $dbh->rollback if $oldAutoCommit;
2376 return "can't parse: ". $csv->error_input();
2379 my @columns = $csv->fields();
2380 #warn join('-',@columns);
2383 agentnum => $agentnum,
2385 country => 'US', #default
2386 payby => 'BILL', #default
2387 paydate => '12/2037', #default
2389 my $billtime = time;
2390 my %cust_pkg = ( pkgpart => $pkgpart );
2391 foreach my $field ( @fields ) {
2392 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2393 #$cust_pkg{$1} = str2time( shift @$columns );
2394 if ( $1 eq 'setup' ) {
2395 $billtime = str2time(shift @columns);
2397 $cust_pkg{$1} = str2time( shift @columns );
2400 #$cust_main{$field} = shift @$columns;
2401 $cust_main{$field} = shift @columns;
2405 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2406 my $cust_main = new FS::cust_main ( \%cust_main );
2408 tie my %hash, 'Tie::RefHash'; #this part is important
2409 $hash{$cust_pkg} = [] if $pkgpart;
2410 my $error = $cust_main->insert( \%hash );
2413 $dbh->rollback if $oldAutoCommit;
2414 return "can't insert customer for $line: $error";
2417 #false laziness w/bill.cgi
2418 $error = $cust_main->bill( 'time' => $billtime );
2420 $dbh->rollback if $oldAutoCommit;
2421 return "can't bill customer for $line: $error";
2424 $cust_main->apply_payments;
2425 $cust_main->apply_credits;
2427 $error = $cust_main->collect();
2429 $dbh->rollback if $oldAutoCommit;
2430 return "can't collect customer for $line: $error";
2436 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2438 return "Empty file!" unless $imported;
2450 #warn join('-',keys %$param);
2451 my $fh = $param->{filehandle};
2452 my @fields = @{$param->{fields}};
2454 eval "use Date::Parse;";
2456 eval "use Text::CSV_XS;";
2459 my $csv = new Text::CSV_XS;
2466 local $SIG{HUP} = 'IGNORE';
2467 local $SIG{INT} = 'IGNORE';
2468 local $SIG{QUIT} = 'IGNORE';
2469 local $SIG{TERM} = 'IGNORE';
2470 local $SIG{TSTP} = 'IGNORE';
2471 local $SIG{PIPE} = 'IGNORE';
2473 my $oldAutoCommit = $FS::UID::AutoCommit;
2474 local $FS::UID::AutoCommit = 0;
2477 #while ( $columns = $csv->getline($fh) ) {
2479 while ( defined($line=<$fh>) ) {
2481 $csv->parse($line) or do {
2482 $dbh->rollback if $oldAutoCommit;
2483 return "can't parse: ". $csv->error_input();
2486 my @columns = $csv->fields();
2487 #warn join('-',@columns);
2490 foreach my $field ( @fields ) {
2491 $row{$field} = shift @columns;
2494 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2495 unless ( $cust_main ) {
2496 $dbh->rollback if $oldAutoCommit;
2497 return "unknown custnum $row{'custnum'}";
2500 if ( $row{'amount'} > 0 ) {
2501 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2503 $dbh->rollback if $oldAutoCommit;
2507 } elsif ( $row{'amount'} < 0 ) {
2508 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2511 $dbh->rollback if $oldAutoCommit;
2521 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2523 return "Empty file!" unless $imported;
2535 The delete method should possibly take an FS::cust_main object reference
2536 instead of a scalar customer number.
2538 Bill and collect options should probably be passed as references instead of a
2541 There should probably be a configuration file with a list of allowed credit
2544 No multiple currency support (probably a larger project than just this module).
2548 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2549 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2550 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.