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 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</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 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
494 && $conf->config('users-allow_comp') ) {
495 return "You are not permitted to create complimentary accounts."
496 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
499 my $oldAutoCommit = $FS::UID::AutoCommit;
500 local $FS::UID::AutoCommit = 0;
503 my $error = $self->SUPER::replace($old);
506 $dbh->rollback if $oldAutoCommit;
510 if ( @param ) { # INVOICING_LIST_ARYREF
511 my $invoicing_list = shift @param;
512 $error = $self->check_invoicing_list( $invoicing_list );
514 $dbh->rollback if $oldAutoCommit;
517 $self->invoicing_list( $invoicing_list );
520 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
521 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
522 # card/check/lec info has changed, want to retry realtime_ invoice events
523 my $error = $self->retry_realtime;
525 $dbh->rollback if $oldAutoCommit;
530 $error = $self->queue_fuzzyfiles_update;
532 $dbh->rollback if $oldAutoCommit;
533 return "updating fuzzy search cache: $error";
536 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
541 =item queue_fuzzyfiles_update
543 Used by insert & replace to update the fuzzy search cache
547 sub queue_fuzzyfiles_update {
550 local $SIG{HUP} = 'IGNORE';
551 local $SIG{INT} = 'IGNORE';
552 local $SIG{QUIT} = 'IGNORE';
553 local $SIG{TERM} = 'IGNORE';
554 local $SIG{TSTP} = 'IGNORE';
555 local $SIG{PIPE} = 'IGNORE';
557 my $oldAutoCommit = $FS::UID::AutoCommit;
558 local $FS::UID::AutoCommit = 0;
561 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
562 my $error = $queue->insert($self->getfield('last'), $self->company);
564 $dbh->rollback if $oldAutoCommit;
565 return "queueing job (transaction rolled back): $error";
568 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
569 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
570 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
572 $dbh->rollback if $oldAutoCommit;
573 return "queueing job (transaction rolled back): $error";
577 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
584 Checks all fields to make sure this is a valid customer record. If there is
585 an error, returns the error, otherwise returns false. Called by the insert
593 #warn "BEFORE: \n". $self->_dump;
596 $self->ut_numbern('custnum')
597 || $self->ut_number('agentnum')
598 || $self->ut_number('refnum')
599 || $self->ut_name('last')
600 || $self->ut_name('first')
601 || $self->ut_textn('company')
602 || $self->ut_text('address1')
603 || $self->ut_textn('address2')
604 || $self->ut_text('city')
605 || $self->ut_textn('county')
606 || $self->ut_textn('state')
607 || $self->ut_country('country')
608 || $self->ut_anything('comments')
609 || $self->ut_numbern('referral_custnum')
611 #barf. need message catalogs. i18n. etc.
612 $error .= "Please select an advertising source."
613 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
614 return $error if $error;
616 return "Unknown agent"
617 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
619 return "Unknown refnum"
620 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
622 return "Unknown referring custnum ". $self->referral_custnum
623 unless ! $self->referral_custnum
624 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
626 if ( $self->ss eq '' ) {
631 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
632 or return "Illegal social security number: ". $self->ss;
633 $self->ss("$1-$2-$3");
637 # bad idea to disable, causes billing to fail because of no tax rates later
638 # unless ( $import ) {
639 unless ( qsearch('cust_main_county', {
640 'country' => $self->country,
643 return "Unknown state/county/country: ".
644 $self->state. "/". $self->county. "/". $self->country
645 unless qsearch('cust_main_county',{
646 'state' => $self->state,
647 'county' => $self->county,
648 'country' => $self->country,
654 $self->ut_phonen('daytime', $self->country)
655 || $self->ut_phonen('night', $self->country)
656 || $self->ut_phonen('fax', $self->country)
657 || $self->ut_zip('zip', $self->country)
659 return $error if $error;
662 last first company address1 address2 city county state zip
663 country daytime night fax
666 if ( defined $self->dbdef_table->column('ship_last') ) {
667 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
669 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
673 $self->ut_name('ship_last')
674 || $self->ut_name('ship_first')
675 || $self->ut_textn('ship_company')
676 || $self->ut_text('ship_address1')
677 || $self->ut_textn('ship_address2')
678 || $self->ut_text('ship_city')
679 || $self->ut_textn('ship_county')
680 || $self->ut_textn('ship_state')
681 || $self->ut_country('ship_country')
683 return $error if $error;
685 #false laziness with above
686 unless ( qsearchs('cust_main_county', {
687 'country' => $self->ship_country,
690 return "Unknown ship_state/ship_county/ship_country: ".
691 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
692 unless qsearchs('cust_main_county',{
693 'state' => $self->ship_state,
694 'county' => $self->ship_county,
695 'country' => $self->ship_country,
701 $self->ut_phonen('ship_daytime', $self->ship_country)
702 || $self->ut_phonen('ship_night', $self->ship_country)
703 || $self->ut_phonen('ship_fax', $self->ship_country)
704 || $self->ut_zip('ship_zip', $self->ship_country)
706 return $error if $error;
708 } else { # ship_ info eq billing info, so don't store dup info in database
709 $self->setfield("ship_$_", '')
710 foreach qw( last first company address1 address2 city county state zip
711 country daytime night fax );
715 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
716 or return "Illegal payby: ". $self->payby;
719 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
721 my $payinfo = $self->payinfo;
723 $payinfo =~ /^(\d{13,16})$/
724 or return gettext('invalid_card'); # . ": ". $self->payinfo;
726 $self->payinfo($payinfo);
728 or return gettext('invalid_card'); # . ": ". $self->payinfo;
729 return gettext('unknown_card_type')
730 if cardtype($self->payinfo) eq "Unknown";
732 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
734 my $payinfo = $self->payinfo;
735 $payinfo =~ s/[^\d\@]//g;
736 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
738 $self->payinfo($payinfo);
740 } elsif ( $self->payby eq 'LECB' ) {
742 my $payinfo = $self->payinfo;
744 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
746 $self->payinfo($payinfo);
748 } elsif ( $self->payby eq 'BILL' ) {
750 $error = $self->ut_textn('payinfo');
751 return "Illegal P.O. number: ". $self->payinfo if $error;
753 } elsif ( $self->payby eq 'COMP' ) {
755 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
756 return "You are not permitted to create complimentary accounts."
757 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
760 $error = $self->ut_textn('payinfo');
761 return "Illegal comp account issuer: ". $self->payinfo if $error;
763 } elsif ( $self->payby eq 'PREPAY' ) {
765 my $payinfo = $self->payinfo;
766 $payinfo =~ s/\W//g; #anything else would just confuse things
767 $self->payinfo($payinfo);
768 $error = $self->ut_alpha('payinfo');
769 return "Illegal prepayment identifier: ". $self->payinfo if $error;
770 return "Unknown prepayment identifier"
771 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
775 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
776 return "Expriation date required"
777 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
781 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
782 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
783 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
784 ( $m, $y ) = ( $3, "20$2" );
786 return "Illegal expiration date: ". $self->paydate;
788 $self->paydate("$y-$m-01");
789 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
790 return gettext('expired_card')
791 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
794 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
795 ( ! $conf->exists('require_cardname')
796 || $self->payby !~ /^(CARD|DCRD)$/ )
798 $self->payname( $self->first. " ". $self->getfield('last') );
800 $self->payname =~ /^([\w \,\.\-\']+)$/
801 or return gettext('illegal_name'). " payname: ". $self->payname;
805 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
808 $self->otaker(getotaker);
810 #warn "AFTER: \n". $self->_dump;
817 Returns all packages (see L<FS::cust_pkg>) for this customer.
823 if ( $self->{'_pkgnum'} ) {
824 values %{ $self->{'_pkgnum'}->cache };
826 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
830 =item ncancelled_pkgs
832 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
836 sub ncancelled_pkgs {
838 if ( $self->{'_pkgnum'} ) {
839 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
841 @{ [ # force list context
842 qsearch( 'cust_pkg', {
843 'custnum' => $self->custnum,
846 qsearch( 'cust_pkg', {
847 'custnum' => $self->custnum,
856 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
862 grep { $_->susp } $self->ncancelled_pkgs;
865 =item unflagged_suspended_pkgs
867 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
868 customer (thouse packages without the `manual_flag' set).
872 sub unflagged_suspended_pkgs {
874 return $self->suspended_pkgs
875 unless dbdef->table('cust_pkg')->column('manual_flag');
876 grep { ! $_->manual_flag } $self->suspended_pkgs;
879 =item unsuspended_pkgs
881 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
886 sub unsuspended_pkgs {
888 grep { ! $_->susp } $self->ncancelled_pkgs;
893 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
894 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
895 on success or a list of errors.
901 grep { $_->unsuspend } $self->suspended_pkgs;
906 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
907 Always returns a list: an empty list on success or a list of errors.
913 grep { $_->suspend } $self->unsuspended_pkgs;
918 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
919 Always returns a list: an empty list on success or a list of errors.
925 grep { $_->cancel } $self->ncancelled_pkgs;
930 Returns the agent (see L<FS::agent>) for this customer.
936 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
941 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
942 conjunction with the collect method.
944 Options are passed as name-value pairs.
946 The only currently available option is `time', which bills the customer as if
947 it were that time. It is specified as a UNIX timestamp; see
948 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
949 functions. For example:
953 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
955 If there is an error, returns the error, otherwise returns false.
960 my( $self, %options ) = @_;
961 my $time = $options{'time'} || time;
966 local $SIG{HUP} = 'IGNORE';
967 local $SIG{INT} = 'IGNORE';
968 local $SIG{QUIT} = 'IGNORE';
969 local $SIG{TERM} = 'IGNORE';
970 local $SIG{TSTP} = 'IGNORE';
971 local $SIG{PIPE} = 'IGNORE';
973 my $oldAutoCommit = $FS::UID::AutoCommit;
974 local $FS::UID::AutoCommit = 0;
977 # find the packages which are due for billing, find out how much they are
978 # & generate invoice database.
980 my( $total_setup, $total_recur ) = ( 0, 0 );
981 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
982 my @cust_bill_pkg = ();
984 #my $taxable_charged = 0;##
989 foreach my $cust_pkg (
990 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
993 #NO!! next if $cust_pkg->cancel;
994 next if $cust_pkg->getfield('cancel');
996 #? to avoid use of uninitialized value errors... ?
997 $cust_pkg->setfield('bill', '')
998 unless defined($cust_pkg->bill);
1000 my $part_pkg = $cust_pkg->part_pkg;
1002 #so we don't modify cust_pkg record unnecessarily
1003 my $cust_pkg_mod_flag = 0;
1004 my %hash = $cust_pkg->hash;
1005 my $old_cust_pkg = new FS::cust_pkg \%hash;
1011 unless ( $cust_pkg->setup ) {
1012 my $setup_prog = $part_pkg->getfield('setup');
1013 $setup_prog =~ /^(.*)$/ or do {
1014 $dbh->rollback if $oldAutoCommit;
1015 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1019 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1021 #my $cpt = new Safe;
1022 ##$cpt->permit(); #what is necessary?
1023 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1024 #$setup = $cpt->reval($setup_prog);
1025 $setup = eval $setup_prog;
1026 unless ( defined($setup) ) {
1027 $dbh->rollback if $oldAutoCommit;
1028 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1029 "(expression $setup_prog): $@";
1031 $cust_pkg->setfield('setup',$time);
1032 $cust_pkg_mod_flag=1;
1038 if ( $part_pkg->getfield('freq') > 0 &&
1039 ! $cust_pkg->getfield('susp') &&
1040 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1042 my $recur_prog = $part_pkg->getfield('recur');
1043 $recur_prog =~ /^(.*)$/ or do {
1044 $dbh->rollback if $oldAutoCommit;
1045 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1049 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1051 # shared with $recur_prog
1052 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1054 #my $cpt = new Safe;
1055 ##$cpt->permit(); #what is necessary?
1056 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1057 #$recur = $cpt->reval($recur_prog);
1058 $recur = eval $recur_prog;
1059 unless ( defined($recur) ) {
1060 $dbh->rollback if $oldAutoCommit;
1061 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1062 "(expression $recur_prog): $@";
1064 #change this bit to use Date::Manip? CAREFUL with timezones (see
1065 # mailing list archive)
1066 my ($sec,$min,$hour,$mday,$mon,$year) =
1067 (localtime($sdate) )[0,1,2,3,4,5];
1069 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1070 # only for figuring next bill date, nothing else, so, reset $sdate again
1072 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1073 $cust_pkg->last_bill($sdate)
1074 if $cust_pkg->dbdef_table->column('last_bill');
1076 $mon += $part_pkg->freq;
1077 until ( $mon < 12 ) { $mon -= 12; $year++; }
1078 $cust_pkg->setfield('bill',
1079 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1080 $cust_pkg_mod_flag = 1;
1083 warn "\$setup is undefined" unless defined($setup);
1084 warn "\$recur is undefined" unless defined($recur);
1085 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1087 my $taxable_charged = 0;
1088 if ( $cust_pkg_mod_flag ) {
1089 $error=$cust_pkg->replace($old_cust_pkg);
1090 if ( $error ) { #just in case
1091 $dbh->rollback if $oldAutoCommit;
1092 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1094 $setup = sprintf( "%.2f", $setup );
1095 $recur = sprintf( "%.2f", $recur );
1097 $dbh->rollback if $oldAutoCommit;
1098 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1101 $dbh->rollback if $oldAutoCommit;
1102 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1104 if ( $setup > 0 || $recur > 0 ) {
1105 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1106 'pkgnum' => $cust_pkg->pkgnum,
1110 'edate' => $cust_pkg->bill,
1111 'details' => \@details,
1113 push @cust_bill_pkg, $cust_bill_pkg;
1114 $total_setup += $setup;
1115 $total_recur += $recur;
1116 $taxable_charged += $setup
1117 unless $part_pkg->setuptax =~ /^Y$/i;
1118 $taxable_charged += $recur
1119 unless $part_pkg->recurtax =~ /^Y$/i;
1121 unless ( $self->tax =~ /Y/i
1122 || $self->payby eq 'COMP'
1123 || $taxable_charged == 0 ) {
1125 my $cust_main_county = qsearchs('cust_main_county',{
1126 'state' => $self->state,
1127 'county' => $self->county,
1128 'country' => $self->country,
1129 'taxclass' => $part_pkg->taxclass,
1131 $cust_main_county ||= qsearchs('cust_main_county',{
1132 'state' => $self->state,
1133 'county' => $self->county,
1134 'country' => $self->country,
1137 unless ( $cust_main_county ) {
1138 $dbh->rollback if $oldAutoCommit;
1140 "fatal: can't find tax rate for state/county/country/taxclass ".
1141 join('/', ( map $self->$_(), qw(state county country) ),
1142 $part_pkg->taxclass ). "\n";
1145 if ( $cust_main_county->exempt_amount ) {
1146 my ($mon,$year) = (localtime($sdate) )[4,5];
1148 my $freq = $part_pkg->freq || 1;
1149 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1150 foreach my $which_month ( 1 .. $freq ) {
1152 'custnum' => $self->custnum,
1153 'taxnum' => $cust_main_county->taxnum,
1154 'year' => 1900+$year,
1157 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1158 until ( $mon < 13 ) { $mon -= 12; $year++; }
1159 my $cust_tax_exempt =
1160 qsearchs('cust_tax_exempt', \%hash)
1161 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1162 my $remaining_exemption = sprintf("%.2f",
1163 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1164 if ( $remaining_exemption > 0 ) {
1165 my $addl = $remaining_exemption > $taxable_per_month
1166 ? $taxable_per_month
1167 : $remaining_exemption;
1168 $taxable_charged -= $addl;
1169 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1170 $cust_tax_exempt->hash,
1171 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1173 $error = $new_cust_tax_exempt->exemptnum
1174 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1175 : $new_cust_tax_exempt->insert;
1177 $dbh->rollback if $oldAutoCommit;
1178 return "fatal: can't update cust_tax_exempt: $error";
1181 } # if $remaining_exemption > 0
1183 } #foreach $which_month
1185 } #if $cust_main_county->exempt_amount
1187 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1189 #$tax += $taxable_charged * $cust_main_county->tax / 100
1190 $tax{ $cust_main_county->taxname || 'Tax' } +=
1191 $taxable_charged * $cust_main_county->tax / 100
1193 } #unless $self->tax =~ /Y/i
1194 # || $self->payby eq 'COMP'
1195 # || $taxable_charged == 0
1197 } #if $setup > 0 || $recur > 0
1199 } #if $cust_pkg_mod_flag
1201 } #foreach my $cust_pkg
1203 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1204 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1206 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1207 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1211 # unless ( $self->tax =~ /Y/i
1212 # || $self->payby eq 'COMP'
1213 # || $taxable_charged == 0 ) {
1214 # my $cust_main_county = qsearchs('cust_main_county',{
1215 # 'state' => $self->state,
1216 # 'county' => $self->county,
1217 # 'country' => $self->country,
1218 # } ) or die "fatal: can't find tax rate for state/county/country ".
1219 # $self->state. "/". $self->county. "/". $self->country. "\n";
1220 # my $tax = sprintf( "%.2f",
1221 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1224 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1225 my $tax = sprintf("%.2f", $tax{$taxname} );
1226 $charged = sprintf( "%.2f", $charged+$tax );
1228 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1234 'itemdesc' => $taxname,
1236 push @cust_bill_pkg, $cust_bill_pkg;
1240 my $cust_bill = new FS::cust_bill ( {
1241 'custnum' => $self->custnum,
1243 'charged' => $charged,
1245 $error = $cust_bill->insert;
1247 $dbh->rollback if $oldAutoCommit;
1248 return "can't create invoice for customer #". $self->custnum. ": $error";
1251 my $invnum = $cust_bill->invnum;
1253 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1255 $cust_bill_pkg->invnum($invnum);
1256 $error = $cust_bill_pkg->insert;
1258 $dbh->rollback if $oldAutoCommit;
1259 return "can't create invoice line item for customer #". $self->custnum.
1264 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1268 =item collect OPTIONS
1270 (Attempt to) collect money for this customer's outstanding invoices (see
1271 L<FS::cust_bill>). Usually used after the bill method.
1273 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1274 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1275 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1277 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1278 and the invoice events web interface.
1280 If there is an error, returns the error, otherwise returns false.
1282 Options are passed as name-value pairs.
1284 Currently available options are:
1286 invoice_time - Use this time when deciding when to print invoices and
1287 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>
1288 for conversion functions.
1290 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1293 retry_card - Deprecated alias for 'retry'
1295 batch_card - This option is deprecated. See the invoice events web interface
1296 to control whether cards are batched or run against a realtime gateway.
1298 report_badcard - This option is deprecated.
1300 force_print - This option is deprecated; see the invoice events web interface.
1302 quiet - set true to surpress email card/ACH decline notices.
1307 my( $self, %options ) = @_;
1308 my $invoice_time = $options{'invoice_time'} || time;
1311 local $SIG{HUP} = 'IGNORE';
1312 local $SIG{INT} = 'IGNORE';
1313 local $SIG{QUIT} = 'IGNORE';
1314 local $SIG{TERM} = 'IGNORE';
1315 local $SIG{TSTP} = 'IGNORE';
1316 local $SIG{PIPE} = 'IGNORE';
1318 my $oldAutoCommit = $FS::UID::AutoCommit;
1319 local $FS::UID::AutoCommit = 0;
1322 my $balance = $self->balance;
1323 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1324 unless ( $balance > 0 ) { #redundant?????
1325 $dbh->rollback if $oldAutoCommit; #hmm
1329 if ( exists($options{'retry_card'}) ) {
1330 carp 'retry_card option passed to collect is deprecated; use retry';
1331 $options{'retry'} ||= $options{'retry_card'};
1333 if ( exists($options{'retry'}) && $options{'retry'} ) {
1334 my $error = $self->retry_realtime;
1336 $dbh->rollback if $oldAutoCommit;
1341 foreach my $cust_bill ( $self->cust_bill ) {
1343 #this has to be before next's
1344 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1348 $balance = sprintf( "%.2f", $balance - $amount );
1350 next unless $cust_bill->owed > 0;
1352 # don't try to charge for the same invoice if it's already in a batch
1353 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1355 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1357 next unless $amount > 0;
1360 foreach my $part_bill_event (
1361 sort { $a->seconds <=> $b->seconds
1362 || $a->weight <=> $b->weight
1363 || $a->eventpart <=> $b->eventpart }
1364 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1365 && ! qsearchs( 'cust_bill_event', {
1366 'invnum' => $cust_bill->invnum,
1367 'eventpart' => $_->eventpart,
1371 qsearch('part_bill_event', { 'payby' => $self->payby,
1372 'disabled' => '', } )
1375 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1377 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1379 my $cust_main = $self; #for callback
1380 my $error = eval $part_bill_event->eventcode;
1383 my $statustext = '';
1387 } elsif ( $error ) {
1389 $statustext = $error;
1394 #add cust_bill_event
1395 my $cust_bill_event = new FS::cust_bill_event {
1396 'invnum' => $cust_bill->invnum,
1397 'eventpart' => $part_bill_event->eventpart,
1398 #'_date' => $invoice_time,
1400 'status' => $status,
1401 'statustext' => $statustext,
1403 $error = $cust_bill_event->insert;
1405 #$dbh->rollback if $oldAutoCommit;
1406 #return "error: $error";
1408 # gah, even with transactions.
1409 $dbh->commit if $oldAutoCommit; #well.
1410 my $e = 'WARNING: Event run but database not updated - '.
1411 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1412 ', eventpart '. $part_bill_event->eventpart.
1423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1428 =item retry_realtime
1430 Schedules realtime credit card / electronic check / LEC billing events for
1431 for retry. Useful if card information has changed or manual retry is desired.
1432 The 'collect' method must be called to actually retry the transaction.
1434 Implementation details: For each of this customer's open invoices, changes
1435 the status of the first "done" (with statustext error) realtime processing
1440 sub retry_realtime {
1443 local $SIG{HUP} = 'IGNORE';
1444 local $SIG{INT} = 'IGNORE';
1445 local $SIG{QUIT} = 'IGNORE';
1446 local $SIG{TERM} = 'IGNORE';
1447 local $SIG{TSTP} = 'IGNORE';
1448 local $SIG{PIPE} = 'IGNORE';
1450 my $oldAutoCommit = $FS::UID::AutoCommit;
1451 local $FS::UID::AutoCommit = 0;
1454 foreach my $cust_bill (
1455 grep { $_->cust_bill_event }
1456 $self->open_cust_bill
1458 my @cust_bill_event =
1459 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1461 #$_->part_bill_event->plan eq 'realtime-card'
1462 $_->part_bill_event->eventcode =~
1463 /\$cust_bill\->realtime_(card|ach|lec)/
1464 && $_->status eq 'done'
1467 $cust_bill->cust_bill_event;
1468 next unless @cust_bill_event;
1469 my $error = $cust_bill_event[0]->retry;
1471 $dbh->rollback if $oldAutoCommit;
1472 return "error scheduling invoice event for retry: $error";
1477 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1482 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1484 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1485 via a Business::OnlinePayment realtime gateway. See
1486 L<http://420.am/business-onlinepayment> for supported gateways.
1488 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1490 Available options are: I<description>, I<invnum>, I<quiet>
1492 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1493 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1494 if set, will override the value from the customer record.
1496 I<description> is a free-text field passed to the gateway. It defaults to
1497 "Internet services".
1499 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1500 specified invoice. If you don't specify an I<invnum> you might want to
1501 call the B<apply_payments> method.
1503 I<quiet> can be set true to surpress email decline notices.
1505 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1510 my( $self, $method, $amount, %options ) = @_;
1512 warn "$self $method $amount\n";
1513 warn " $_ => $options{$_}\n" foreach keys %options;
1516 $options{'description'} ||= 'Internet services';
1519 die "Real-time processing not enabled\n"
1520 unless $conf->exists('business-onlinepayment');
1521 eval "use Business::OnlinePayment";
1525 $self->set( $_ => $options{$_} )
1526 foreach grep { exists($options{$_}) }
1527 qw( payname address1 address2 city state zip payinfo paydate );
1530 my $bop_config = 'business-onlinepayment';
1531 $bop_config .= '-ach'
1532 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1533 my ( $processor, $login, $password, $action, @bop_options ) =
1534 $conf->config($bop_config);
1535 $action ||= 'normal authorization';
1536 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1540 my $address = $self->address1;
1541 $address .= ", ". $self->address2 if $self->address2;
1543 my($payname, $payfirst, $paylast);
1544 if ( $self->payname && $method ne 'ECHECK' ) {
1545 $payname = $self->payname;
1546 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1547 or return "Illegal payname $payname";
1548 ($payfirst, $paylast) = ($1, $2);
1550 $payfirst = $self->getfield('first');
1551 $paylast = $self->getfield('last');
1552 $payname = "$payfirst $paylast";
1555 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1556 if ( $conf->exists('emailinvoiceauto')
1557 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1558 push @invoicing_list, $self->all_emails;
1560 my $email = $invoicing_list[0];
1563 if ( $method eq 'CC' ) {
1564 $content{card_number} = $self->payinfo;
1565 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1566 $content{expiration} = "$2/$1";
1567 } elsif ( $method eq 'ECHECK' ) {
1568 my($account_number,$routing_code) = $self->payinfo;
1569 ( $content{account_number}, $content{routing_code} ) =
1570 split('@', $self->payinfo);
1571 $content{bank_name} = $self->payname;
1572 $content{account_type} = 'CHECKING';
1573 $content{account_name} = $payname;
1574 $content{customer_org} = $self->company ? 'B' : 'I';
1575 $content{customer_ssn} = $self->ss;
1576 } elsif ( $method eq 'LEC' ) {
1577 $content{phone} = $self->payinfo;
1582 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1585 new Business::OnlinePayment( $processor, @bop_options );
1586 $transaction->content(
1589 'password' => $password,
1590 'action' => $action1,
1591 'description' => $options{'description'},
1592 'amount' => $amount,
1593 'invoice_number' => $options{'invnum'},
1594 'customer_id' => $self->custnum,
1595 'last_name' => $paylast,
1596 'first_name' => $payfirst,
1598 'address' => $address,
1599 'city' => $self->city,
1600 'state' => $self->state,
1601 'zip' => $self->zip,
1602 'country' => $self->country,
1603 'referer' => 'http://cleanwhisker.420.am/',
1605 'phone' => $self->daytime || $self->night,
1608 $transaction->submit();
1610 if ( $transaction->is_success() && $action2 ) {
1611 my $auth = $transaction->authorization;
1612 my $ordernum = $transaction->can('order_number')
1613 ? $transaction->order_number
1617 new Business::OnlinePayment( $processor, @bop_options );
1624 password => $password,
1625 order_number => $ordernum,
1627 authorization => $auth,
1628 description => $options{'description'},
1631 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1632 transaction_sequence_num local_transaction_date
1633 local_transaction_time AVS_result_code )) {
1634 $capture{$field} = $transaction->$field() if $transaction->can($field);
1637 $capture->content( %capture );
1641 unless ( $capture->is_success ) {
1642 my $e = "Authorization sucessful but capture failed, custnum #".
1643 $self->custnum. ': '. $capture->result_code.
1644 ": ". $capture->error_message;
1652 if ( $transaction->is_success() ) {
1654 my %method2payby = (
1660 my $cust_pay = new FS::cust_pay ( {
1661 'custnum' => $self->custnum,
1662 'invnum' => $options{'invnum'},
1665 'payby' => $method2payby{$method},
1666 'payinfo' => $self->payinfo,
1667 'paybatch' => "$processor:". $transaction->authorization,
1669 my $error = $cust_pay->insert;
1671 # gah, even with transactions.
1672 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1673 'error applying payment, invnum #' . $self->invnum.
1674 " ($processor): $error";
1683 my $perror = "$processor error: ". $transaction->error_message;
1685 if ( !$options{'quiet'} && $conf->exists('emaildecline')
1686 && grep { $_ ne 'POST' } $self->invoicing_list
1688 my @templ = $conf->config('declinetemplate');
1689 my $template = new Text::Template (
1691 SOURCE => [ map "$_\n", @templ ],
1692 ) or return "($perror) can't create template: $Text::Template::ERROR";
1693 $template->compile()
1694 or return "($perror) can't compile template: $Text::Template::ERROR";
1696 my $templ_hash = { error => $transaction->error_message };
1698 my $error = send_email(
1699 'from' => $conf->config('invoice_from'),
1700 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1701 'subject' => 'Your payment could not be processed',
1702 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1705 $perror .= " (also received error sending decline notification: $error)"
1717 Returns the total owed for this customer on all invoices
1718 (see L<FS::cust_bill/owed>).
1724 $self->total_owed_date(2145859200); #12/31/2037
1727 =item total_owed_date TIME
1729 Returns the total owed for this customer on all invoices with date earlier than
1730 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1731 see L<Time::Local> and L<Date::Parse> for conversion functions.
1735 sub total_owed_date {
1739 foreach my $cust_bill (
1740 grep { $_->_date <= $time }
1741 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1743 $total_bill += $cust_bill->owed;
1745 sprintf( "%.2f", $total_bill );
1750 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1751 to outstanding invoice balances in chronological order and returns the value
1752 of any remaining unapplied credits available for refund
1753 (see L<FS::cust_refund>).
1760 return 0 unless $self->total_credited;
1762 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1763 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1765 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1766 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1770 foreach my $cust_bill ( @invoices ) {
1773 if ( !defined($credit) || $credit->credited == 0) {
1774 $credit = pop @credits or last;
1777 if ($cust_bill->owed >= $credit->credited) {
1778 $amount=$credit->credited;
1780 $amount=$cust_bill->owed;
1783 my $cust_credit_bill = new FS::cust_credit_bill ( {
1784 'crednum' => $credit->crednum,
1785 'invnum' => $cust_bill->invnum,
1786 'amount' => $amount,
1788 my $error = $cust_credit_bill->insert;
1789 die $error if $error;
1791 redo if ($cust_bill->owed > 0);
1795 return $self->total_credited;
1798 =item apply_payments
1800 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1801 to outstanding invoice balances in chronological order.
1803 #and returns the value of any remaining unapplied payments.
1807 sub apply_payments {
1812 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1813 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1815 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1816 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1820 foreach my $cust_bill ( @invoices ) {
1823 if ( !defined($payment) || $payment->unapplied == 0 ) {
1824 $payment = pop @payments or last;
1827 if ( $cust_bill->owed >= $payment->unapplied ) {
1828 $amount = $payment->unapplied;
1830 $amount = $cust_bill->owed;
1833 my $cust_bill_pay = new FS::cust_bill_pay ( {
1834 'paynum' => $payment->paynum,
1835 'invnum' => $cust_bill->invnum,
1836 'amount' => $amount,
1838 my $error = $cust_bill_pay->insert;
1839 die $error if $error;
1841 redo if ( $cust_bill->owed > 0);
1845 return $self->total_unapplied_payments;
1848 =item total_credited
1850 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1851 customer. See L<FS::cust_credit/credited>.
1855 sub total_credited {
1857 my $total_credit = 0;
1858 foreach my $cust_credit ( qsearch('cust_credit', {
1859 'custnum' => $self->custnum,
1861 $total_credit += $cust_credit->credited;
1863 sprintf( "%.2f", $total_credit );
1866 =item total_unapplied_payments
1868 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1869 See L<FS::cust_pay/unapplied>.
1873 sub total_unapplied_payments {
1875 my $total_unapplied = 0;
1876 foreach my $cust_pay ( qsearch('cust_pay', {
1877 'custnum' => $self->custnum,
1879 $total_unapplied += $cust_pay->unapplied;
1881 sprintf( "%.2f", $total_unapplied );
1886 Returns the balance for this customer (total_owed minus total_credited
1887 minus total_unapplied_payments).
1894 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1898 =item balance_date TIME
1900 Returns the balance for this customer, only considering invoices with date
1901 earlier than TIME (total_owed_date minus total_credited minus
1902 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1903 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1912 $self->total_owed_date($time)
1913 - $self->total_credited
1914 - $self->total_unapplied_payments
1918 =item invoicing_list [ ARRAYREF ]
1920 If an arguement is given, sets these email addresses as invoice recipients
1921 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1922 (except as warnings), so use check_invoicing_list first.
1924 Returns a list of email addresses (with svcnum entries expanded).
1926 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1927 check it without disturbing anything by passing nothing.
1929 This interface may change in the future.
1933 sub invoicing_list {
1934 my( $self, $arrayref ) = @_;
1936 my @cust_main_invoice;
1937 if ( $self->custnum ) {
1938 @cust_main_invoice =
1939 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1941 @cust_main_invoice = ();
1943 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1944 #warn $cust_main_invoice->destnum;
1945 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1946 #warn $cust_main_invoice->destnum;
1947 my $error = $cust_main_invoice->delete;
1948 warn $error if $error;
1951 if ( $self->custnum ) {
1952 @cust_main_invoice =
1953 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1955 @cust_main_invoice = ();
1957 my %seen = map { $_->address => 1 } @cust_main_invoice;
1958 foreach my $address ( @{$arrayref} ) {
1959 next if exists $seen{$address} && $seen{$address};
1960 $seen{$address} = 1;
1961 my $cust_main_invoice = new FS::cust_main_invoice ( {
1962 'custnum' => $self->custnum,
1965 my $error = $cust_main_invoice->insert;
1966 warn $error if $error;
1969 if ( $self->custnum ) {
1971 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1977 =item check_invoicing_list ARRAYREF
1979 Checks these arguements as valid input for the invoicing_list method. If there
1980 is an error, returns the error, otherwise returns false.
1984 sub check_invoicing_list {
1985 my( $self, $arrayref ) = @_;
1986 foreach my $address ( @{$arrayref} ) {
1987 my $cust_main_invoice = new FS::cust_main_invoice ( {
1988 'custnum' => $self->custnum,
1991 my $error = $self->custnum
1992 ? $cust_main_invoice->check
1993 : $cust_main_invoice->checkdest
1995 return $error if $error;
2000 =item set_default_invoicing_list
2002 Sets the invoicing list to all accounts associated with this customer,
2003 overwriting any previous invoicing list.
2007 sub set_default_invoicing_list {
2009 $self->invoicing_list($self->all_emails);
2014 Returns the email addresses of all accounts provisioned for this customer.
2021 foreach my $cust_pkg ( $self->all_pkgs ) {
2022 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2024 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2025 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2027 $list{$_}=1 foreach map { $_->email } @svc_acct;
2032 =item invoicing_list_addpost
2034 Adds postal invoicing to this customer. If this customer is already configured
2035 to receive postal invoices, does nothing.
2039 sub invoicing_list_addpost {
2041 return if grep { $_ eq 'POST' } $self->invoicing_list;
2042 my @invoicing_list = $self->invoicing_list;
2043 push @invoicing_list, 'POST';
2044 $self->invoicing_list(\@invoicing_list);
2047 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2049 Returns an array of customers referred by this customer (referral_custnum set
2050 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2051 customers referred by customers referred by this customer and so on, inclusive.
2052 The default behavior is DEPTH 1 (no recursion).
2056 sub referral_cust_main {
2058 my $depth = @_ ? shift : 1;
2059 my $exclude = @_ ? shift : {};
2062 map { $exclude->{$_->custnum}++; $_; }
2063 grep { ! $exclude->{ $_->custnum } }
2064 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2068 map { $_->referral_cust_main($depth-1, $exclude) }
2075 =item referral_cust_main_ncancelled
2077 Same as referral_cust_main, except only returns customers with uncancelled
2082 sub referral_cust_main_ncancelled {
2084 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2087 =item referral_cust_pkg [ DEPTH ]
2089 Like referral_cust_main, except returns a flat list of all unsuspended (and
2090 uncancelled) packages for each customer. The number of items in this list may
2091 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2095 sub referral_cust_pkg {
2097 my $depth = @_ ? shift : 1;
2099 map { $_->unsuspended_pkgs }
2100 grep { $_->unsuspended_pkgs }
2101 $self->referral_cust_main($depth);
2104 =item credit AMOUNT, REASON
2106 Applies a credit to this customer. If there is an error, returns the error,
2107 otherwise returns false.
2112 my( $self, $amount, $reason ) = @_;
2113 my $cust_credit = new FS::cust_credit {
2114 'custnum' => $self->custnum,
2115 'amount' => $amount,
2116 'reason' => $reason,
2118 $cust_credit->insert;
2121 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2123 Creates a one-time charge for this customer. If there is an error, returns
2124 the error, otherwise returns false.
2129 my ( $self, $amount ) = ( shift, shift );
2130 my $pkg = @_ ? shift : 'One-time charge';
2131 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2132 my $taxclass = @_ ? shift : '';
2134 local $SIG{HUP} = 'IGNORE';
2135 local $SIG{INT} = 'IGNORE';
2136 local $SIG{QUIT} = 'IGNORE';
2137 local $SIG{TERM} = 'IGNORE';
2138 local $SIG{TSTP} = 'IGNORE';
2139 local $SIG{PIPE} = 'IGNORE';
2141 my $oldAutoCommit = $FS::UID::AutoCommit;
2142 local $FS::UID::AutoCommit = 0;
2145 my $part_pkg = new FS::part_pkg ( {
2147 'comment' => $comment,
2152 'taxclass' => $taxclass,
2155 my $error = $part_pkg->insert;
2157 $dbh->rollback if $oldAutoCommit;
2161 my $pkgpart = $part_pkg->pkgpart;
2162 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2163 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2164 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2165 $error = $type_pkgs->insert;
2167 $dbh->rollback if $oldAutoCommit;
2172 my $cust_pkg = new FS::cust_pkg ( {
2173 'custnum' => $self->custnum,
2174 'pkgpart' => $pkgpart,
2177 $error = $cust_pkg->insert;
2179 $dbh->rollback if $oldAutoCommit;
2183 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2190 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2196 sort { $a->_date <=> $b->_date }
2197 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2200 =item open_cust_bill
2202 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2207 sub open_cust_bill {
2209 grep { $_->owed > 0 } $self->cust_bill;
2218 =item check_and_rebuild_fuzzyfiles
2222 sub check_and_rebuild_fuzzyfiles {
2223 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2224 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2225 or &rebuild_fuzzyfiles;
2228 =item rebuild_fuzzyfiles
2232 sub rebuild_fuzzyfiles {
2234 use Fcntl qw(:flock);
2236 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2240 open(LASTLOCK,">>$dir/cust_main.last")
2241 or die "can't open $dir/cust_main.last: $!";
2242 flock(LASTLOCK,LOCK_EX)
2243 or die "can't lock $dir/cust_main.last: $!";
2245 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2247 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2248 if defined dbdef->table('cust_main')->column('ship_last');
2250 open (LASTCACHE,">$dir/cust_main.last.tmp")
2251 or die "can't open $dir/cust_main.last.tmp: $!";
2252 print LASTCACHE join("\n", @all_last), "\n";
2253 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2255 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2260 open(COMPANYLOCK,">>$dir/cust_main.company")
2261 or die "can't open $dir/cust_main.company: $!";
2262 flock(COMPANYLOCK,LOCK_EX)
2263 or die "can't lock $dir/cust_main.company: $!";
2265 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2267 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2268 if defined dbdef->table('cust_main')->column('ship_last');
2270 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2271 or die "can't open $dir/cust_main.company.tmp: $!";
2272 print COMPANYCACHE join("\n", @all_company), "\n";
2273 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2275 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2285 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2286 open(LASTCACHE,"<$dir/cust_main.last")
2287 or die "can't open $dir/cust_main.last: $!";
2288 my @array = map { chomp; $_; } <LASTCACHE>;
2298 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2299 open(COMPANYCACHE,"<$dir/cust_main.company")
2300 or die "can't open $dir/cust_main.last: $!";
2301 my @array = map { chomp; $_; } <COMPANYCACHE>;
2306 =item append_fuzzyfiles LASTNAME COMPANY
2310 sub append_fuzzyfiles {
2311 my( $last, $company ) = @_;
2313 &check_and_rebuild_fuzzyfiles;
2315 use Fcntl qw(:flock);
2317 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2321 open(LAST,">>$dir/cust_main.last")
2322 or die "can't open $dir/cust_main.last: $!";
2324 or die "can't lock $dir/cust_main.last: $!";
2326 print LAST "$last\n";
2329 or die "can't unlock $dir/cust_main.last: $!";
2335 open(COMPANY,">>$dir/cust_main.company")
2336 or die "can't open $dir/cust_main.company: $!";
2337 flock(COMPANY,LOCK_EX)
2338 or die "can't lock $dir/cust_main.company: $!";
2340 print COMPANY "$company\n";
2342 flock(COMPANY,LOCK_UN)
2343 or die "can't unlock $dir/cust_main.company: $!";
2357 #warn join('-',keys %$param);
2358 my $fh = $param->{filehandle};
2359 my $agentnum = $param->{agentnum};
2360 my $refnum = $param->{refnum};
2361 my $pkgpart = $param->{pkgpart};
2362 my @fields = @{$param->{fields}};
2364 eval "use Date::Parse;";
2366 eval "use Text::CSV_XS;";
2369 my $csv = new Text::CSV_XS;
2376 local $SIG{HUP} = 'IGNORE';
2377 local $SIG{INT} = 'IGNORE';
2378 local $SIG{QUIT} = 'IGNORE';
2379 local $SIG{TERM} = 'IGNORE';
2380 local $SIG{TSTP} = 'IGNORE';
2381 local $SIG{PIPE} = 'IGNORE';
2383 my $oldAutoCommit = $FS::UID::AutoCommit;
2384 local $FS::UID::AutoCommit = 0;
2387 #while ( $columns = $csv->getline($fh) ) {
2389 while ( defined($line=<$fh>) ) {
2391 $csv->parse($line) or do {
2392 $dbh->rollback if $oldAutoCommit;
2393 return "can't parse: ". $csv->error_input();
2396 my @columns = $csv->fields();
2397 #warn join('-',@columns);
2400 agentnum => $agentnum,
2402 country => 'US', #default
2403 payby => 'BILL', #default
2404 paydate => '12/2037', #default
2406 my $billtime = time;
2407 my %cust_pkg = ( pkgpart => $pkgpart );
2408 foreach my $field ( @fields ) {
2409 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2410 #$cust_pkg{$1} = str2time( shift @$columns );
2411 if ( $1 eq 'setup' ) {
2412 $billtime = str2time(shift @columns);
2414 $cust_pkg{$1} = str2time( shift @columns );
2417 #$cust_main{$field} = shift @$columns;
2418 $cust_main{$field} = shift @columns;
2422 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2423 my $cust_main = new FS::cust_main ( \%cust_main );
2425 tie my %hash, 'Tie::RefHash'; #this part is important
2426 $hash{$cust_pkg} = [] if $pkgpart;
2427 my $error = $cust_main->insert( \%hash );
2430 $dbh->rollback if $oldAutoCommit;
2431 return "can't insert customer for $line: $error";
2434 #false laziness w/bill.cgi
2435 $error = $cust_main->bill( 'time' => $billtime );
2437 $dbh->rollback if $oldAutoCommit;
2438 return "can't bill customer for $line: $error";
2441 $cust_main->apply_payments;
2442 $cust_main->apply_credits;
2444 $error = $cust_main->collect();
2446 $dbh->rollback if $oldAutoCommit;
2447 return "can't collect customer for $line: $error";
2453 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2455 return "Empty file!" unless $imported;
2467 #warn join('-',keys %$param);
2468 my $fh = $param->{filehandle};
2469 my @fields = @{$param->{fields}};
2471 eval "use Date::Parse;";
2473 eval "use Text::CSV_XS;";
2476 my $csv = new Text::CSV_XS;
2483 local $SIG{HUP} = 'IGNORE';
2484 local $SIG{INT} = 'IGNORE';
2485 local $SIG{QUIT} = 'IGNORE';
2486 local $SIG{TERM} = 'IGNORE';
2487 local $SIG{TSTP} = 'IGNORE';
2488 local $SIG{PIPE} = 'IGNORE';
2490 my $oldAutoCommit = $FS::UID::AutoCommit;
2491 local $FS::UID::AutoCommit = 0;
2494 #while ( $columns = $csv->getline($fh) ) {
2496 while ( defined($line=<$fh>) ) {
2498 $csv->parse($line) or do {
2499 $dbh->rollback if $oldAutoCommit;
2500 return "can't parse: ". $csv->error_input();
2503 my @columns = $csv->fields();
2504 #warn join('-',@columns);
2507 foreach my $field ( @fields ) {
2508 $row{$field} = shift @columns;
2511 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2512 unless ( $cust_main ) {
2513 $dbh->rollback if $oldAutoCommit;
2514 return "unknown custnum $row{'custnum'}";
2517 if ( $row{'amount'} > 0 ) {
2518 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2520 $dbh->rollback if $oldAutoCommit;
2524 } elsif ( $row{'amount'} < 0 ) {
2525 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2528 $dbh->rollback if $oldAutoCommit;
2538 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2540 return "Empty file!" unless $imported;
2552 The delete method should possibly take an FS::cust_main object reference
2553 instead of a scalar customer number.
2555 Bill and collect options should probably be passed as references instead of a
2558 There should probably be a configuration file with a list of allowed credit
2561 No multiple currency support (probably a larger project than just this module).
2565 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2566 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2567 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.