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.
1305 my( $self, %options ) = @_;
1306 my $invoice_time = $options{'invoice_time'} || time;
1309 local $SIG{HUP} = 'IGNORE';
1310 local $SIG{INT} = 'IGNORE';
1311 local $SIG{QUIT} = 'IGNORE';
1312 local $SIG{TERM} = 'IGNORE';
1313 local $SIG{TSTP} = 'IGNORE';
1314 local $SIG{PIPE} = 'IGNORE';
1316 my $oldAutoCommit = $FS::UID::AutoCommit;
1317 local $FS::UID::AutoCommit = 0;
1320 my $balance = $self->balance;
1321 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1322 unless ( $balance > 0 ) { #redundant?????
1323 $dbh->rollback if $oldAutoCommit; #hmm
1327 if ( exists($options{'retry_card'}) ) {
1328 carp 'retry_card option passed to collect is deprecated; use retry';
1329 $options{'retry'} ||= $options{'retry_card'};
1331 if ( exists($options{'retry'}) && $options{'retry'} ) {
1332 my $error = $self->retry_realtime;
1334 $dbh->rollback if $oldAutoCommit;
1339 foreach my $cust_bill ( $self->cust_bill ) {
1341 #this has to be before next's
1342 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1346 $balance = sprintf( "%.2f", $balance - $amount );
1348 next unless $cust_bill->owed > 0;
1350 # don't try to charge for the same invoice if it's already in a batch
1351 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1353 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1355 next unless $amount > 0;
1358 foreach my $part_bill_event (
1359 sort { $a->seconds <=> $b->seconds
1360 || $a->weight <=> $b->weight
1361 || $a->eventpart <=> $b->eventpart }
1362 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1363 && ! qsearchs( 'cust_bill_event', {
1364 'invnum' => $cust_bill->invnum,
1365 'eventpart' => $_->eventpart,
1369 qsearch('part_bill_event', { 'payby' => $self->payby,
1370 'disabled' => '', } )
1373 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1375 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1377 my $cust_main = $self; #for callback
1378 my $error = eval $part_bill_event->eventcode;
1381 my $statustext = '';
1385 } elsif ( $error ) {
1387 $statustext = $error;
1392 #add cust_bill_event
1393 my $cust_bill_event = new FS::cust_bill_event {
1394 'invnum' => $cust_bill->invnum,
1395 'eventpart' => $part_bill_event->eventpart,
1396 #'_date' => $invoice_time,
1398 'status' => $status,
1399 'statustext' => $statustext,
1401 $error = $cust_bill_event->insert;
1403 #$dbh->rollback if $oldAutoCommit;
1404 #return "error: $error";
1406 # gah, even with transactions.
1407 $dbh->commit if $oldAutoCommit; #well.
1408 my $e = 'WARNING: Event run but database not updated - '.
1409 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1410 ', eventpart '. $part_bill_event->eventpart.
1421 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1426 =item retry_realtime
1428 Schedules realtime credit card / electronic check / LEC billing events for
1429 for retry. Useful if card information has changed or manual retry is desired.
1430 The 'collect' method must be called to actually retry the transaction.
1432 Implementation details: For each of this customer's open invoices, changes
1433 the status of the first "done" (with statustext error) realtime processing
1438 sub retry_realtime {
1441 local $SIG{HUP} = 'IGNORE';
1442 local $SIG{INT} = 'IGNORE';
1443 local $SIG{QUIT} = 'IGNORE';
1444 local $SIG{TERM} = 'IGNORE';
1445 local $SIG{TSTP} = 'IGNORE';
1446 local $SIG{PIPE} = 'IGNORE';
1448 my $oldAutoCommit = $FS::UID::AutoCommit;
1449 local $FS::UID::AutoCommit = 0;
1452 foreach my $cust_bill (
1453 grep { $_->cust_bill_event }
1454 $self->open_cust_bill
1456 my @cust_bill_event =
1457 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1459 #$_->part_bill_event->plan eq 'realtime-card'
1460 $_->part_bill_event->eventcode =~
1461 /\$cust_bill\->realtime_(card|ach|lec)/
1462 && $_->status eq 'done'
1465 $cust_bill->cust_bill_event;
1466 next unless @cust_bill_event;
1467 my $error = $cust_bill_event[0]->retry;
1469 $dbh->rollback if $oldAutoCommit;
1470 return "error scheduling invoice event for retry: $error";
1475 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1480 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1482 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1483 via a Business::OnlinePayment realtime gateway. See
1484 L<http://420.am/business-onlinepayment> for supported gateways.
1486 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1488 Available options are: I<description>, I<invnum>, I<quiet>
1490 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1491 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1492 if set, will override the value from the customer record.
1494 I<description> is a free-text field passed to the gateway. It defaults to
1495 "Internet services".
1497 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1498 specified invoice. If you don't specify an I<invnum> you might want to
1499 call the B<apply_payments> method.
1501 I<quiet> can be set true to surpress email decline notices.
1503 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1508 my( $self, $method, $amount, %options ) = @_;
1510 warn "$self $method $amount\n";
1511 warn " $_ => $options{$_}\n" foreach keys %options;
1514 $options{'description'} ||= 'Internet services';
1517 die "Real-time processing not enabled\n"
1518 unless $conf->exists('business-onlinepayment');
1519 eval "use Business::OnlinePayment";
1523 $self->set( $_ => $options{$_} )
1524 foreach grep { exists($options{$_}) }
1525 qw( payname address1 address2 city state zip payinfo paydate );
1528 my $bop_config = 'business-onlinepayment';
1529 $bop_config .= '-ach'
1530 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1531 my ( $processor, $login, $password, $action, @bop_options ) =
1532 $conf->config($bop_config);
1533 $action ||= 'normal authorization';
1534 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1538 my $address = $self->address1;
1539 $address .= ", ". $self->address2 if $self->address2;
1541 my($payname, $payfirst, $paylast);
1542 if ( $self->payname && $method ne 'ECHECK' ) {
1543 $payname = $self->payname;
1544 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1545 or return "Illegal payname $payname";
1546 ($payfirst, $paylast) = ($1, $2);
1548 $payfirst = $self->getfield('first');
1549 $paylast = $self->getfield('last');
1550 $payname = "$payfirst $paylast";
1553 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1554 if ( $conf->exists('emailinvoiceauto')
1555 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1556 push @invoicing_list, $self->all_emails;
1558 my $email = $invoicing_list[0];
1561 if ( $method eq 'CC' ) {
1562 $content{card_number} = $self->payinfo;
1563 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1564 $content{expiration} = "$2/$1";
1565 } elsif ( $method eq 'ECHECK' ) {
1566 my($account_number,$routing_code) = $self->payinfo;
1567 ( $content{account_number}, $content{routing_code} ) =
1568 split('@', $self->payinfo);
1569 $content{bank_name} = $self->payname;
1570 $content{account_type} = 'CHECKING';
1571 $content{account_name} = $payname;
1572 $content{customer_org} = $self->company ? 'B' : 'I';
1573 $content{customer_ssn} = $self->ss;
1574 } elsif ( $method eq 'LEC' ) {
1575 $content{phone} = $self->payinfo;
1580 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1583 new Business::OnlinePayment( $processor, @bop_options );
1584 $transaction->content(
1587 'password' => $password,
1588 'action' => $action1,
1589 'description' => $options{'description'},
1590 'amount' => $amount,
1591 'invoice_number' => $options{'invnum'},
1592 'customer_id' => $self->custnum,
1593 'last_name' => $paylast,
1594 'first_name' => $payfirst,
1596 'address' => $address,
1597 'city' => $self->city,
1598 'state' => $self->state,
1599 'zip' => $self->zip,
1600 'country' => $self->country,
1601 'referer' => 'http://cleanwhisker.420.am/',
1603 'phone' => $self->daytime || $self->night,
1606 $transaction->submit();
1608 if ( $transaction->is_success() && $action2 ) {
1609 my $auth = $transaction->authorization;
1610 my $ordernum = $transaction->can('order_number')
1611 ? $transaction->order_number
1615 new Business::OnlinePayment( $processor, @bop_options );
1622 password => $password,
1623 order_number => $ordernum,
1625 authorization => $auth,
1626 description => $options{'description'},
1629 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1630 transaction_sequence_num local_transaction_date
1631 local_transaction_time AVS_result_code )) {
1632 $capture{$field} = $transaction->$field() if $transaction->can($field);
1635 $capture->content( %capture );
1639 unless ( $capture->is_success ) {
1640 my $e = "Authorization sucessful but capture failed, custnum #".
1641 $self->custnum. ': '. $capture->result_code.
1642 ": ". $capture->error_message;
1650 if ( $transaction->is_success() ) {
1652 my %method2payby = (
1658 my $cust_pay = new FS::cust_pay ( {
1659 'custnum' => $self->custnum,
1660 'invnum' => $options{'invnum'},
1663 'payby' => $method2payby{$method},
1664 'payinfo' => $self->payinfo,
1665 'paybatch' => "$processor:". $transaction->authorization,
1667 my $error = $cust_pay->insert;
1669 # gah, even with transactions.
1670 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1671 'error applying payment, invnum #' . $self->invnum.
1672 " ($processor): $error";
1681 my $perror = "$processor error: ". $transaction->error_message;
1683 if ( !$options{'quiet'} && $conf->exists('emaildecline')
1684 && grep { $_ ne 'POST' } $self->invoicing_list
1686 my @templ = $conf->config('declinetemplate');
1687 my $template = new Text::Template (
1689 SOURCE => [ map "$_\n", @templ ],
1690 ) or return "($perror) can't create template: $Text::Template::ERROR";
1691 $template->compile()
1692 or return "($perror) can't compile template: $Text::Template::ERROR";
1694 my $templ_hash = { error => $transaction->error_message };
1696 my $error = send_email(
1697 'from' => $conf->config('invoice_from'),
1698 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1699 'subject' => 'Your payment could not be processed',
1700 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1703 $perror .= " (also received error sending decline notification: $error)"
1715 Returns the total owed for this customer on all invoices
1716 (see L<FS::cust_bill/owed>).
1722 $self->total_owed_date(2145859200); #12/31/2037
1725 =item total_owed_date TIME
1727 Returns the total owed for this customer on all invoices with date earlier than
1728 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1729 see L<Time::Local> and L<Date::Parse> for conversion functions.
1733 sub total_owed_date {
1737 foreach my $cust_bill (
1738 grep { $_->_date <= $time }
1739 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1741 $total_bill += $cust_bill->owed;
1743 sprintf( "%.2f", $total_bill );
1748 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1749 to outstanding invoice balances in chronological order and returns the value
1750 of any remaining unapplied credits available for refund
1751 (see L<FS::cust_refund>).
1758 return 0 unless $self->total_credited;
1760 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1761 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1763 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1764 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1768 foreach my $cust_bill ( @invoices ) {
1771 if ( !defined($credit) || $credit->credited == 0) {
1772 $credit = pop @credits or last;
1775 if ($cust_bill->owed >= $credit->credited) {
1776 $amount=$credit->credited;
1778 $amount=$cust_bill->owed;
1781 my $cust_credit_bill = new FS::cust_credit_bill ( {
1782 'crednum' => $credit->crednum,
1783 'invnum' => $cust_bill->invnum,
1784 'amount' => $amount,
1786 my $error = $cust_credit_bill->insert;
1787 die $error if $error;
1789 redo if ($cust_bill->owed > 0);
1793 return $self->total_credited;
1796 =item apply_payments
1798 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1799 to outstanding invoice balances in chronological order.
1801 #and returns the value of any remaining unapplied payments.
1805 sub apply_payments {
1810 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1811 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1813 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1814 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1818 foreach my $cust_bill ( @invoices ) {
1821 if ( !defined($payment) || $payment->unapplied == 0 ) {
1822 $payment = pop @payments or last;
1825 if ( $cust_bill->owed >= $payment->unapplied ) {
1826 $amount = $payment->unapplied;
1828 $amount = $cust_bill->owed;
1831 my $cust_bill_pay = new FS::cust_bill_pay ( {
1832 'paynum' => $payment->paynum,
1833 'invnum' => $cust_bill->invnum,
1834 'amount' => $amount,
1836 my $error = $cust_bill_pay->insert;
1837 die $error if $error;
1839 redo if ( $cust_bill->owed > 0);
1843 return $self->total_unapplied_payments;
1846 =item total_credited
1848 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1849 customer. See L<FS::cust_credit/credited>.
1853 sub total_credited {
1855 my $total_credit = 0;
1856 foreach my $cust_credit ( qsearch('cust_credit', {
1857 'custnum' => $self->custnum,
1859 $total_credit += $cust_credit->credited;
1861 sprintf( "%.2f", $total_credit );
1864 =item total_unapplied_payments
1866 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1867 See L<FS::cust_pay/unapplied>.
1871 sub total_unapplied_payments {
1873 my $total_unapplied = 0;
1874 foreach my $cust_pay ( qsearch('cust_pay', {
1875 'custnum' => $self->custnum,
1877 $total_unapplied += $cust_pay->unapplied;
1879 sprintf( "%.2f", $total_unapplied );
1884 Returns the balance for this customer (total_owed minus total_credited
1885 minus total_unapplied_payments).
1892 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1896 =item balance_date TIME
1898 Returns the balance for this customer, only considering invoices with date
1899 earlier than TIME (total_owed_date minus total_credited minus
1900 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1901 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1910 $self->total_owed_date($time)
1911 - $self->total_credited
1912 - $self->total_unapplied_payments
1916 =item invoicing_list [ ARRAYREF ]
1918 If an arguement is given, sets these email addresses as invoice recipients
1919 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1920 (except as warnings), so use check_invoicing_list first.
1922 Returns a list of email addresses (with svcnum entries expanded).
1924 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1925 check it without disturbing anything by passing nothing.
1927 This interface may change in the future.
1931 sub invoicing_list {
1932 my( $self, $arrayref ) = @_;
1934 my @cust_main_invoice;
1935 if ( $self->custnum ) {
1936 @cust_main_invoice =
1937 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1939 @cust_main_invoice = ();
1941 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1942 #warn $cust_main_invoice->destnum;
1943 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1944 #warn $cust_main_invoice->destnum;
1945 my $error = $cust_main_invoice->delete;
1946 warn $error if $error;
1949 if ( $self->custnum ) {
1950 @cust_main_invoice =
1951 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1953 @cust_main_invoice = ();
1955 my %seen = map { $_->address => 1 } @cust_main_invoice;
1956 foreach my $address ( @{$arrayref} ) {
1957 next if exists $seen{$address} && $seen{$address};
1958 $seen{$address} = 1;
1959 my $cust_main_invoice = new FS::cust_main_invoice ( {
1960 'custnum' => $self->custnum,
1963 my $error = $cust_main_invoice->insert;
1964 warn $error if $error;
1967 if ( $self->custnum ) {
1969 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1975 =item check_invoicing_list ARRAYREF
1977 Checks these arguements as valid input for the invoicing_list method. If there
1978 is an error, returns the error, otherwise returns false.
1982 sub check_invoicing_list {
1983 my( $self, $arrayref ) = @_;
1984 foreach my $address ( @{$arrayref} ) {
1985 my $cust_main_invoice = new FS::cust_main_invoice ( {
1986 'custnum' => $self->custnum,
1989 my $error = $self->custnum
1990 ? $cust_main_invoice->check
1991 : $cust_main_invoice->checkdest
1993 return $error if $error;
1998 =item set_default_invoicing_list
2000 Sets the invoicing list to all accounts associated with this customer,
2001 overwriting any previous invoicing list.
2005 sub set_default_invoicing_list {
2007 $self->invoicing_list($self->all_emails);
2012 Returns the email addresses of all accounts provisioned for this customer.
2019 foreach my $cust_pkg ( $self->all_pkgs ) {
2020 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2022 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2023 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2025 $list{$_}=1 foreach map { $_->email } @svc_acct;
2030 =item invoicing_list_addpost
2032 Adds postal invoicing to this customer. If this customer is already configured
2033 to receive postal invoices, does nothing.
2037 sub invoicing_list_addpost {
2039 return if grep { $_ eq 'POST' } $self->invoicing_list;
2040 my @invoicing_list = $self->invoicing_list;
2041 push @invoicing_list, 'POST';
2042 $self->invoicing_list(\@invoicing_list);
2045 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2047 Returns an array of customers referred by this customer (referral_custnum set
2048 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2049 customers referred by customers referred by this customer and so on, inclusive.
2050 The default behavior is DEPTH 1 (no recursion).
2054 sub referral_cust_main {
2056 my $depth = @_ ? shift : 1;
2057 my $exclude = @_ ? shift : {};
2060 map { $exclude->{$_->custnum}++; $_; }
2061 grep { ! $exclude->{ $_->custnum } }
2062 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2066 map { $_->referral_cust_main($depth-1, $exclude) }
2073 =item referral_cust_main_ncancelled
2075 Same as referral_cust_main, except only returns customers with uncancelled
2080 sub referral_cust_main_ncancelled {
2082 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2085 =item referral_cust_pkg [ DEPTH ]
2087 Like referral_cust_main, except returns a flat list of all unsuspended (and
2088 uncancelled) packages for each customer. The number of items in this list may
2089 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2093 sub referral_cust_pkg {
2095 my $depth = @_ ? shift : 1;
2097 map { $_->unsuspended_pkgs }
2098 grep { $_->unsuspended_pkgs }
2099 $self->referral_cust_main($depth);
2102 =item credit AMOUNT, REASON
2104 Applies a credit to this customer. If there is an error, returns the error,
2105 otherwise returns false.
2110 my( $self, $amount, $reason ) = @_;
2111 my $cust_credit = new FS::cust_credit {
2112 'custnum' => $self->custnum,
2113 'amount' => $amount,
2114 'reason' => $reason,
2116 $cust_credit->insert;
2119 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2121 Creates a one-time charge for this customer. If there is an error, returns
2122 the error, otherwise returns false.
2127 my ( $self, $amount ) = ( shift, shift );
2128 my $pkg = @_ ? shift : 'One-time charge';
2129 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2130 my $taxclass = @_ ? shift : '';
2132 local $SIG{HUP} = 'IGNORE';
2133 local $SIG{INT} = 'IGNORE';
2134 local $SIG{QUIT} = 'IGNORE';
2135 local $SIG{TERM} = 'IGNORE';
2136 local $SIG{TSTP} = 'IGNORE';
2137 local $SIG{PIPE} = 'IGNORE';
2139 my $oldAutoCommit = $FS::UID::AutoCommit;
2140 local $FS::UID::AutoCommit = 0;
2143 my $part_pkg = new FS::part_pkg ( {
2145 'comment' => $comment,
2150 'taxclass' => $taxclass,
2153 my $error = $part_pkg->insert;
2155 $dbh->rollback if $oldAutoCommit;
2159 my $pkgpart = $part_pkg->pkgpart;
2160 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2161 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2162 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2163 $error = $type_pkgs->insert;
2165 $dbh->rollback if $oldAutoCommit;
2170 my $cust_pkg = new FS::cust_pkg ( {
2171 'custnum' => $self->custnum,
2172 'pkgpart' => $pkgpart,
2175 $error = $cust_pkg->insert;
2177 $dbh->rollback if $oldAutoCommit;
2181 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2188 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2194 sort { $a->_date <=> $b->_date }
2195 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2198 =item open_cust_bill
2200 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2205 sub open_cust_bill {
2207 grep { $_->owed > 0 } $self->cust_bill;
2216 =item check_and_rebuild_fuzzyfiles
2220 sub check_and_rebuild_fuzzyfiles {
2221 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2222 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2223 or &rebuild_fuzzyfiles;
2226 =item rebuild_fuzzyfiles
2230 sub rebuild_fuzzyfiles {
2232 use Fcntl qw(:flock);
2234 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2238 open(LASTLOCK,">>$dir/cust_main.last")
2239 or die "can't open $dir/cust_main.last: $!";
2240 flock(LASTLOCK,LOCK_EX)
2241 or die "can't lock $dir/cust_main.last: $!";
2243 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2245 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2246 if defined dbdef->table('cust_main')->column('ship_last');
2248 open (LASTCACHE,">$dir/cust_main.last.tmp")
2249 or die "can't open $dir/cust_main.last.tmp: $!";
2250 print LASTCACHE join("\n", @all_last), "\n";
2251 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2253 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2258 open(COMPANYLOCK,">>$dir/cust_main.company")
2259 or die "can't open $dir/cust_main.company: $!";
2260 flock(COMPANYLOCK,LOCK_EX)
2261 or die "can't lock $dir/cust_main.company: $!";
2263 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2265 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2266 if defined dbdef->table('cust_main')->column('ship_last');
2268 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2269 or die "can't open $dir/cust_main.company.tmp: $!";
2270 print COMPANYCACHE join("\n", @all_company), "\n";
2271 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2273 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2283 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2284 open(LASTCACHE,"<$dir/cust_main.last")
2285 or die "can't open $dir/cust_main.last: $!";
2286 my @array = map { chomp; $_; } <LASTCACHE>;
2296 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2297 open(COMPANYCACHE,"<$dir/cust_main.company")
2298 or die "can't open $dir/cust_main.last: $!";
2299 my @array = map { chomp; $_; } <COMPANYCACHE>;
2304 =item append_fuzzyfiles LASTNAME COMPANY
2308 sub append_fuzzyfiles {
2309 my( $last, $company ) = @_;
2311 &check_and_rebuild_fuzzyfiles;
2313 use Fcntl qw(:flock);
2315 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2319 open(LAST,">>$dir/cust_main.last")
2320 or die "can't open $dir/cust_main.last: $!";
2322 or die "can't lock $dir/cust_main.last: $!";
2324 print LAST "$last\n";
2327 or die "can't unlock $dir/cust_main.last: $!";
2333 open(COMPANY,">>$dir/cust_main.company")
2334 or die "can't open $dir/cust_main.company: $!";
2335 flock(COMPANY,LOCK_EX)
2336 or die "can't lock $dir/cust_main.company: $!";
2338 print COMPANY "$company\n";
2340 flock(COMPANY,LOCK_UN)
2341 or die "can't unlock $dir/cust_main.company: $!";
2355 #warn join('-',keys %$param);
2356 my $fh = $param->{filehandle};
2357 my $agentnum = $param->{agentnum};
2358 my $refnum = $param->{refnum};
2359 my $pkgpart = $param->{pkgpart};
2360 my @fields = @{$param->{fields}};
2362 eval "use Date::Parse;";
2364 eval "use Text::CSV_XS;";
2367 my $csv = new Text::CSV_XS;
2374 local $SIG{HUP} = 'IGNORE';
2375 local $SIG{INT} = 'IGNORE';
2376 local $SIG{QUIT} = 'IGNORE';
2377 local $SIG{TERM} = 'IGNORE';
2378 local $SIG{TSTP} = 'IGNORE';
2379 local $SIG{PIPE} = 'IGNORE';
2381 my $oldAutoCommit = $FS::UID::AutoCommit;
2382 local $FS::UID::AutoCommit = 0;
2385 #while ( $columns = $csv->getline($fh) ) {
2387 while ( defined($line=<$fh>) ) {
2389 $csv->parse($line) or do {
2390 $dbh->rollback if $oldAutoCommit;
2391 return "can't parse: ". $csv->error_input();
2394 my @columns = $csv->fields();
2395 #warn join('-',@columns);
2398 agentnum => $agentnum,
2400 country => 'US', #default
2401 payby => 'BILL', #default
2402 paydate => '12/2037', #default
2404 my $billtime = time;
2405 my %cust_pkg = ( pkgpart => $pkgpart );
2406 foreach my $field ( @fields ) {
2407 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2408 #$cust_pkg{$1} = str2time( shift @$columns );
2409 if ( $1 eq 'setup' ) {
2410 $billtime = str2time(shift @columns);
2412 $cust_pkg{$1} = str2time( shift @columns );
2415 #$cust_main{$field} = shift @$columns;
2416 $cust_main{$field} = shift @columns;
2420 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2421 my $cust_main = new FS::cust_main ( \%cust_main );
2423 tie my %hash, 'Tie::RefHash'; #this part is important
2424 $hash{$cust_pkg} = [] if $pkgpart;
2425 my $error = $cust_main->insert( \%hash );
2428 $dbh->rollback if $oldAutoCommit;
2429 return "can't insert customer for $line: $error";
2432 #false laziness w/bill.cgi
2433 $error = $cust_main->bill( 'time' => $billtime );
2435 $dbh->rollback if $oldAutoCommit;
2436 return "can't bill customer for $line: $error";
2439 $cust_main->apply_payments;
2440 $cust_main->apply_credits;
2442 $error = $cust_main->collect();
2444 $dbh->rollback if $oldAutoCommit;
2445 return "can't collect customer for $line: $error";
2451 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2453 return "Empty file!" unless $imported;
2465 #warn join('-',keys %$param);
2466 my $fh = $param->{filehandle};
2467 my @fields = @{$param->{fields}};
2469 eval "use Date::Parse;";
2471 eval "use Text::CSV_XS;";
2474 my $csv = new Text::CSV_XS;
2481 local $SIG{HUP} = 'IGNORE';
2482 local $SIG{INT} = 'IGNORE';
2483 local $SIG{QUIT} = 'IGNORE';
2484 local $SIG{TERM} = 'IGNORE';
2485 local $SIG{TSTP} = 'IGNORE';
2486 local $SIG{PIPE} = 'IGNORE';
2488 my $oldAutoCommit = $FS::UID::AutoCommit;
2489 local $FS::UID::AutoCommit = 0;
2492 #while ( $columns = $csv->getline($fh) ) {
2494 while ( defined($line=<$fh>) ) {
2496 $csv->parse($line) or do {
2497 $dbh->rollback if $oldAutoCommit;
2498 return "can't parse: ". $csv->error_input();
2501 my @columns = $csv->fields();
2502 #warn join('-',@columns);
2505 foreach my $field ( @fields ) {
2506 $row{$field} = shift @columns;
2509 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2510 unless ( $cust_main ) {
2511 $dbh->rollback if $oldAutoCommit;
2512 return "unknown custnum $row{'custnum'}";
2515 if ( $row{'amount'} > 0 ) {
2516 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2518 $dbh->rollback if $oldAutoCommit;
2522 } elsif ( $row{'amount'} < 0 ) {
2523 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2526 $dbh->rollback if $oldAutoCommit;
2536 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2538 return "Empty file!" unless $imported;
2550 The delete method should possibly take an FS::cust_main object reference
2551 instead of a scalar customer number.
2553 Bill and collect options should probably be passed as references instead of a
2556 There should probably be a configuration file with a list of allowed credit
2559 No multiple currency support (probably a larger project than just this module).
2563 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2564 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2565 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.