4 use vars qw( @ISA $conf $Debug $import );
5 use vars qw( $realtime_bop_decline_quiet ); #ugh
9 eval "use Time::Local;";
10 die "Time::Local version 1.05 required with Perl versions before 5.6"
11 if $] < 5.006 && !defined($Time::Local::VERSION);
12 eval "use Time::Local qw(timelocal timelocal_nocheck);";
16 use Business::CreditCard;
17 use FS::UID qw( getotaker dbh );
18 use FS::Record qw( qsearchs qsearch dbdef );
19 use FS::Misc qw( send_email );
22 use FS::cust_bill_pkg;
25 use FS::part_referral;
26 use FS::cust_main_county;
28 use FS::cust_main_invoice;
29 use FS::cust_credit_bill;
30 use FS::cust_bill_pay;
31 use FS::prepay_credit;
34 use FS::part_bill_event;
35 use FS::cust_bill_event;
36 use FS::cust_tax_exempt;
38 use FS::Msgcat qw(gettext);
40 @ISA = qw( FS::Record );
42 $realtime_bop_decline_quiet = 0;
49 #ask FS::UID to run this stuff for us later
50 #$FS::UID::callback{'FS::cust_main'} = sub {
51 install_callback FS::UID sub {
53 #yes, need it for stuff below (prolly should be cached)
58 my ( $hashref, $cache ) = @_;
59 if ( exists $hashref->{'pkgnum'} ) {
60 # #@{ $self->{'_pkgnum'} } = ();
61 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
62 $self->{'_pkgnum'} = $subcache;
63 #push @{ $self->{'_pkgnum'} },
64 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
70 FS::cust_main - Object methods for cust_main records
76 $record = new FS::cust_main \%hash;
77 $record = new FS::cust_main { 'column' => 'value' };
79 $error = $record->insert;
81 $error = $new_record->replace($old_record);
83 $error = $record->delete;
85 $error = $record->check;
87 @cust_pkg = $record->all_pkgs;
89 @cust_pkg = $record->ncancelled_pkgs;
91 @cust_pkg = $record->suspended_pkgs;
93 $error = $record->bill;
94 $error = $record->bill %options;
95 $error = $record->bill 'time' => $time;
97 $error = $record->collect;
98 $error = $record->collect %options;
99 $error = $record->collect 'invoice_time' => $time,
100 'batch_card' => 'yes',
101 'report_badcard' => 'yes',
106 An FS::cust_main object represents a customer. FS::cust_main inherits from
107 FS::Record. The following fields are currently supported:
111 =item custnum - primary key (assigned automatically for new customers)
113 =item agentnum - agent (see L<FS::agent>)
115 =item refnum - Advertising source (see L<FS::part_referral>)
121 =item ss - social security number (optional)
123 =item company - (optional)
127 =item address2 - (optional)
131 =item county - (optional, see L<FS::cust_main_county>)
133 =item state - (see L<FS::cust_main_county>)
137 =item country - (see L<FS::cust_main_county>)
139 =item daytime - phone (optional)
141 =item night - phone (optional)
143 =item fax - phone (optional)
145 =item ship_first - name
147 =item ship_last - name
149 =item ship_company - (optional)
153 =item ship_address2 - (optional)
157 =item ship_county - (optional, see L<FS::cust_main_county>)
159 =item ship_state - (see L<FS::cust_main_county>)
163 =item ship_country - (see L<FS::cust_main_county>)
165 =item ship_daytime - phone (optional)
167 =item ship_night - phone (optional)
169 =item ship_fax - phone (optional)
171 =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>)
173 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
175 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
177 =item payname - name on card or billing name
179 =item tax - tax exempt, empty or `Y'
181 =item otaker - order taker (assigned automatically, see L<FS::UID>)
183 =item comments - comments (optional)
185 =item referral_custnum - referring customer number
195 Creates a new customer. To add the customer to the database, see L<"insert">.
197 Note that this stores the hash reference, not a distinct copy of the hash it
198 points to. You can ask the object for a copy with the I<hash> method.
202 sub table { 'cust_main'; }
204 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
206 Adds this customer to the database. If there is an error, returns the error,
207 otherwise returns false.
209 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
210 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
211 are inserted atomicly, or the transaction is rolled back. Passing an empty
212 hash reference is equivalent to not supplying this parameter. There should be
213 a better explanation of this, but until then, here's an example:
216 tie %hash, 'Tie::RefHash'; #this part is important
218 $cust_pkg => [ $svc_acct ],
221 $cust_main->insert( \%hash );
223 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
224 be set as the invoicing list (see L<"invoicing_list">). Errors return as
225 expected and rollback the entire transaction; it is not necessary to call
226 check_invoicing_list first. The invoicing_list is set after the records in the
227 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
228 invoicing_list destination to the newly-created svc_acct. Here's an example:
230 $cust_main->insert( {}, [ $email, 'POST' ] );
236 my $cust_pkgs = @_ ? shift : {};
237 my $invoicing_list = @_ ? shift : '';
239 local $SIG{HUP} = 'IGNORE';
240 local $SIG{INT} = 'IGNORE';
241 local $SIG{QUIT} = 'IGNORE';
242 local $SIG{TERM} = 'IGNORE';
243 local $SIG{TSTP} = 'IGNORE';
244 local $SIG{PIPE} = 'IGNORE';
246 my $oldAutoCommit = $FS::UID::AutoCommit;
247 local $FS::UID::AutoCommit = 0;
252 if ( $self->payby eq 'PREPAY' ) {
253 $self->payby('BILL');
254 my $prepay_credit = qsearchs(
256 { 'identifier' => $self->payinfo },
260 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
261 unless $prepay_credit;
262 $amount = $prepay_credit->amount;
263 $seconds = $prepay_credit->seconds;
264 my $error = $prepay_credit->delete;
266 $dbh->rollback if $oldAutoCommit;
267 return "removing prepay_credit (transaction rolled back): $error";
271 my $error = $self->SUPER::insert;
273 $dbh->rollback if $oldAutoCommit;
274 #return "inserting cust_main record (transaction rolled back): $error";
279 if ( $invoicing_list ) {
280 $error = $self->check_invoicing_list( $invoicing_list );
282 $dbh->rollback if $oldAutoCommit;
283 return "checking invoicing_list (transaction rolled back): $error";
285 $self->invoicing_list( $invoicing_list );
289 $error = $self->order_pkgs($cust_pkgs, \$seconds);
291 $dbh->rollback if $oldAutoCommit;
296 $dbh->rollback if $oldAutoCommit;
297 return "No svc_acct record to apply pre-paid time";
301 my $cust_credit = new FS::cust_credit {
302 'custnum' => $self->custnum,
305 $error = $cust_credit->insert;
307 $dbh->rollback if $oldAutoCommit;
308 return "inserting credit (transaction rolled back): $error";
312 $error = $self->queue_fuzzyfiles_update;
314 $dbh->rollback if $oldAutoCommit;
315 return "updating fuzzy search cache: $error";
318 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
325 document me. like ->insert(%cust_pkg) on an existing record
331 my $cust_pkgs = shift;
334 local $SIG{HUP} = 'IGNORE';
335 local $SIG{INT} = 'IGNORE';
336 local $SIG{QUIT} = 'IGNORE';
337 local $SIG{TERM} = 'IGNORE';
338 local $SIG{TSTP} = 'IGNORE';
339 local $SIG{PIPE} = 'IGNORE';
341 my $oldAutoCommit = $FS::UID::AutoCommit;
342 local $FS::UID::AutoCommit = 0;
345 foreach my $cust_pkg ( keys %$cust_pkgs ) {
346 $cust_pkg->custnum( $self->custnum );
347 my $error = $cust_pkg->insert;
349 $dbh->rollback if $oldAutoCommit;
350 return "inserting cust_pkg (transaction rolled back): $error";
352 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
353 $svc_something->pkgnum( $cust_pkg->pkgnum );
354 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
355 $svc_something->seconds( $svc_something->seconds + $$seconds );
358 $error = $svc_something->insert;
360 $dbh->rollback if $oldAutoCommit;
361 #return "inserting svc_ (transaction rolled back): $error";
367 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
371 =item delete NEW_CUSTNUM
373 This deletes the customer. If there is an error, returns the error, otherwise
376 This will completely remove all traces of the customer record. This is not
377 what you want when a customer cancels service; for that, cancel all of the
378 customer's packages (see L</cancel>).
380 If the customer has any uncancelled packages, you need to pass a new (valid)
381 customer number for those packages to be transferred to. Cancelled packages
382 will be deleted. Did I mention that this is NOT what you want when a customer
383 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
385 You can't delete a customer with invoices (see L<FS::cust_bill>),
386 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
387 refunds (see L<FS::cust_refund>).
394 local $SIG{HUP} = 'IGNORE';
395 local $SIG{INT} = 'IGNORE';
396 local $SIG{QUIT} = 'IGNORE';
397 local $SIG{TERM} = 'IGNORE';
398 local $SIG{TSTP} = 'IGNORE';
399 local $SIG{PIPE} = 'IGNORE';
401 my $oldAutoCommit = $FS::UID::AutoCommit;
402 local $FS::UID::AutoCommit = 0;
405 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
406 $dbh->rollback if $oldAutoCommit;
407 return "Can't delete a customer with invoices";
409 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
410 $dbh->rollback if $oldAutoCommit;
411 return "Can't delete a customer with credits";
413 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
414 $dbh->rollback if $oldAutoCommit;
415 return "Can't delete a customer with payments";
417 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
418 $dbh->rollback if $oldAutoCommit;
419 return "Can't delete a customer with refunds";
422 my @cust_pkg = $self->ncancelled_pkgs;
424 my $new_custnum = shift;
425 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
426 $dbh->rollback if $oldAutoCommit;
427 return "Invalid new customer number: $new_custnum";
429 foreach my $cust_pkg ( @cust_pkg ) {
430 my %hash = $cust_pkg->hash;
431 $hash{'custnum'} = $new_custnum;
432 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
433 my $error = $new_cust_pkg->replace($cust_pkg);
435 $dbh->rollback if $oldAutoCommit;
440 my @cancelled_cust_pkg = $self->all_pkgs;
441 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
442 my $error = $cust_pkg->delete;
444 $dbh->rollback if $oldAutoCommit;
449 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
450 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
452 my $error = $cust_main_invoice->delete;
454 $dbh->rollback if $oldAutoCommit;
459 my $error = $self->SUPER::delete;
461 $dbh->rollback if $oldAutoCommit;
465 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
470 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
472 Replaces the OLD_RECORD with this one in the database. If there is an error,
473 returns the error, otherwise returns false.
475 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
476 be set as the invoicing list (see L<"invoicing_list">). Errors return as
477 expected and rollback the entire transaction; it is not necessary to call
478 check_invoicing_list first. Here's an example:
480 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
489 local $SIG{HUP} = 'IGNORE';
490 local $SIG{INT} = 'IGNORE';
491 local $SIG{QUIT} = 'IGNORE';
492 local $SIG{TERM} = 'IGNORE';
493 local $SIG{TSTP} = 'IGNORE';
494 local $SIG{PIPE} = 'IGNORE';
496 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
497 && $conf->config('users-allow_comp') ) {
498 return "You are not permitted to create complimentary accounts."
499 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
502 my $oldAutoCommit = $FS::UID::AutoCommit;
503 local $FS::UID::AutoCommit = 0;
506 my $error = $self->SUPER::replace($old);
509 $dbh->rollback if $oldAutoCommit;
513 if ( @param ) { # INVOICING_LIST_ARYREF
514 my $invoicing_list = shift @param;
515 $error = $self->check_invoicing_list( $invoicing_list );
517 $dbh->rollback if $oldAutoCommit;
520 $self->invoicing_list( $invoicing_list );
523 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
524 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
525 # card/check/lec info has changed, want to retry realtime_ invoice events
526 my $error = $self->retry_realtime;
528 $dbh->rollback if $oldAutoCommit;
533 $error = $self->queue_fuzzyfiles_update;
535 $dbh->rollback if $oldAutoCommit;
536 return "updating fuzzy search cache: $error";
539 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
544 =item queue_fuzzyfiles_update
546 Used by insert & replace to update the fuzzy search cache
550 sub queue_fuzzyfiles_update {
553 local $SIG{HUP} = 'IGNORE';
554 local $SIG{INT} = 'IGNORE';
555 local $SIG{QUIT} = 'IGNORE';
556 local $SIG{TERM} = 'IGNORE';
557 local $SIG{TSTP} = 'IGNORE';
558 local $SIG{PIPE} = 'IGNORE';
560 my $oldAutoCommit = $FS::UID::AutoCommit;
561 local $FS::UID::AutoCommit = 0;
564 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
565 my $error = $queue->insert($self->getfield('last'), $self->company);
567 $dbh->rollback if $oldAutoCommit;
568 return "queueing job (transaction rolled back): $error";
571 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
572 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
573 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
575 $dbh->rollback if $oldAutoCommit;
576 return "queueing job (transaction rolled back): $error";
580 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
587 Checks all fields to make sure this is a valid customer record. If there is
588 an error, returns the error, otherwise returns false. Called by the insert
596 #warn "BEFORE: \n". $self->_dump;
599 $self->ut_numbern('custnum')
600 || $self->ut_number('agentnum')
601 || $self->ut_number('refnum')
602 || $self->ut_name('last')
603 || $self->ut_name('first')
604 || $self->ut_textn('company')
605 || $self->ut_text('address1')
606 || $self->ut_textn('address2')
607 || $self->ut_text('city')
608 || $self->ut_textn('county')
609 || $self->ut_textn('state')
610 || $self->ut_country('country')
611 || $self->ut_anything('comments')
612 || $self->ut_numbern('referral_custnum')
614 #barf. need message catalogs. i18n. etc.
615 $error .= "Please select an advertising source."
616 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
617 return $error if $error;
619 return "Unknown agent"
620 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
622 return "Unknown refnum"
623 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
625 return "Unknown referring custnum ". $self->referral_custnum
626 unless ! $self->referral_custnum
627 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
629 if ( $self->ss eq '' ) {
634 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
635 or return "Illegal social security number: ". $self->ss;
636 $self->ss("$1-$2-$3");
640 # bad idea to disable, causes billing to fail because of no tax rates later
641 # unless ( $import ) {
642 unless ( qsearch('cust_main_county', {
643 'country' => $self->country,
646 return "Unknown state/county/country: ".
647 $self->state. "/". $self->county. "/". $self->country
648 unless qsearch('cust_main_county',{
649 'state' => $self->state,
650 'county' => $self->county,
651 'country' => $self->country,
657 $self->ut_phonen('daytime', $self->country)
658 || $self->ut_phonen('night', $self->country)
659 || $self->ut_phonen('fax', $self->country)
660 || $self->ut_zip('zip', $self->country)
662 return $error if $error;
665 last first company address1 address2 city county state zip
666 country daytime night fax
669 if ( defined $self->dbdef_table->column('ship_last') ) {
670 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
672 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
676 $self->ut_name('ship_last')
677 || $self->ut_name('ship_first')
678 || $self->ut_textn('ship_company')
679 || $self->ut_text('ship_address1')
680 || $self->ut_textn('ship_address2')
681 || $self->ut_text('ship_city')
682 || $self->ut_textn('ship_county')
683 || $self->ut_textn('ship_state')
684 || $self->ut_country('ship_country')
686 return $error if $error;
688 #false laziness with above
689 unless ( qsearchs('cust_main_county', {
690 'country' => $self->ship_country,
693 return "Unknown ship_state/ship_county/ship_country: ".
694 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
695 unless qsearchs('cust_main_county',{
696 'state' => $self->ship_state,
697 'county' => $self->ship_county,
698 'country' => $self->ship_country,
704 $self->ut_phonen('ship_daytime', $self->ship_country)
705 || $self->ut_phonen('ship_night', $self->ship_country)
706 || $self->ut_phonen('ship_fax', $self->ship_country)
707 || $self->ut_zip('ship_zip', $self->ship_country)
709 return $error if $error;
711 } else { # ship_ info eq billing info, so don't store dup info in database
712 $self->setfield("ship_$_", '')
713 foreach qw( last first company address1 address2 city county state zip
714 country daytime night fax );
718 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
719 or return "Illegal payby: ". $self->payby;
722 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
724 my $payinfo = $self->payinfo;
726 $payinfo =~ /^(\d{13,16})$/
727 or return gettext('invalid_card'); # . ": ". $self->payinfo;
729 $self->payinfo($payinfo);
731 or return gettext('invalid_card'); # . ": ". $self->payinfo;
732 return gettext('unknown_card_type')
733 if cardtype($self->payinfo) eq "Unknown";
735 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
737 my $payinfo = $self->payinfo;
738 $payinfo =~ s/[^\d\@]//g;
739 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
741 $self->payinfo($payinfo);
743 } elsif ( $self->payby eq 'LECB' ) {
745 my $payinfo = $self->payinfo;
747 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
749 $self->payinfo($payinfo);
751 } elsif ( $self->payby eq 'BILL' ) {
753 $error = $self->ut_textn('payinfo');
754 return "Illegal P.O. number: ". $self->payinfo if $error;
756 } elsif ( $self->payby eq 'COMP' ) {
758 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
759 return "You are not permitted to create complimentary accounts."
760 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
763 $error = $self->ut_textn('payinfo');
764 return "Illegal comp account issuer: ". $self->payinfo if $error;
766 } elsif ( $self->payby eq 'PREPAY' ) {
768 my $payinfo = $self->payinfo;
769 $payinfo =~ s/\W//g; #anything else would just confuse things
770 $self->payinfo($payinfo);
771 $error = $self->ut_alpha('payinfo');
772 return "Illegal prepayment identifier: ". $self->payinfo if $error;
773 return "Unknown prepayment identifier"
774 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
778 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
779 return "Expriation date required"
780 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
784 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
785 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
786 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
787 ( $m, $y ) = ( $3, "20$2" );
789 return "Illegal expiration date: ". $self->paydate;
791 $self->paydate("$y-$m-01");
792 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
793 return gettext('expired_card')
794 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
797 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
798 ( ! $conf->exists('require_cardname')
799 || $self->payby !~ /^(CARD|DCRD)$/ )
801 $self->payname( $self->first. " ". $self->getfield('last') );
803 $self->payname =~ /^([\w \,\.\-\']+)$/
804 or return gettext('illegal_name'). " payname: ". $self->payname;
808 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
811 $self->otaker(getotaker);
813 #warn "AFTER: \n". $self->_dump;
820 Returns all packages (see L<FS::cust_pkg>) for this customer.
826 if ( $self->{'_pkgnum'} ) {
827 values %{ $self->{'_pkgnum'}->cache };
829 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
833 =item ncancelled_pkgs
835 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
839 sub ncancelled_pkgs {
841 if ( $self->{'_pkgnum'} ) {
842 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
844 @{ [ # force list context
845 qsearch( 'cust_pkg', {
846 'custnum' => $self->custnum,
849 qsearch( 'cust_pkg', {
850 'custnum' => $self->custnum,
859 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
865 grep { $_->susp } $self->ncancelled_pkgs;
868 =item unflagged_suspended_pkgs
870 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
871 customer (thouse packages without the `manual_flag' set).
875 sub unflagged_suspended_pkgs {
877 return $self->suspended_pkgs
878 unless dbdef->table('cust_pkg')->column('manual_flag');
879 grep { ! $_->manual_flag } $self->suspended_pkgs;
882 =item unsuspended_pkgs
884 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
889 sub unsuspended_pkgs {
891 grep { ! $_->susp } $self->ncancelled_pkgs;
896 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
897 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
898 on success or a list of errors.
904 grep { $_->unsuspend } $self->suspended_pkgs;
909 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
910 Always returns a list: an empty list on success or a list of errors.
916 grep { $_->suspend } $self->unsuspended_pkgs;
921 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
922 Always returns a list: an empty list on success or a list of errors.
928 grep { $_->cancel } $self->ncancelled_pkgs;
933 Returns the agent (see L<FS::agent>) for this customer.
939 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
944 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
945 conjunction with the collect method.
947 Options are passed as name-value pairs.
949 The only currently available option is `time', which bills the customer as if
950 it were that time. It is specified as a UNIX timestamp; see
951 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
952 functions. For example:
956 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
958 If there is an error, returns the error, otherwise returns false.
963 my( $self, %options ) = @_;
964 my $time = $options{'time'} || time;
969 local $SIG{HUP} = 'IGNORE';
970 local $SIG{INT} = 'IGNORE';
971 local $SIG{QUIT} = 'IGNORE';
972 local $SIG{TERM} = 'IGNORE';
973 local $SIG{TSTP} = 'IGNORE';
974 local $SIG{PIPE} = 'IGNORE';
976 my $oldAutoCommit = $FS::UID::AutoCommit;
977 local $FS::UID::AutoCommit = 0;
980 # find the packages which are due for billing, find out how much they are
981 # & generate invoice database.
983 my( $total_setup, $total_recur ) = ( 0, 0 );
984 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
985 my @cust_bill_pkg = ();
987 #my $taxable_charged = 0;##
992 foreach my $cust_pkg (
993 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
996 #NO!! next if $cust_pkg->cancel;
997 next if $cust_pkg->getfield('cancel');
999 #? to avoid use of uninitialized value errors... ?
1000 $cust_pkg->setfield('bill', '')
1001 unless defined($cust_pkg->bill);
1003 my $part_pkg = $cust_pkg->part_pkg;
1005 #so we don't modify cust_pkg record unnecessarily
1006 my $cust_pkg_mod_flag = 0;
1007 my %hash = $cust_pkg->hash;
1008 my $old_cust_pkg = new FS::cust_pkg \%hash;
1014 unless ( $cust_pkg->setup ) {
1015 my $setup_prog = $part_pkg->getfield('setup');
1016 $setup_prog =~ /^(.*)$/ or do {
1017 $dbh->rollback if $oldAutoCommit;
1018 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1022 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1024 #my $cpt = new Safe;
1025 ##$cpt->permit(); #what is necessary?
1026 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1027 #$setup = $cpt->reval($setup_prog);
1028 $setup = eval $setup_prog;
1029 unless ( defined($setup) ) {
1030 $dbh->rollback if $oldAutoCommit;
1031 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1032 "(expression $setup_prog): $@";
1034 $cust_pkg->setfield('setup',$time);
1035 $cust_pkg_mod_flag=1;
1041 if ( $part_pkg->getfield('freq') > 0 &&
1042 ! $cust_pkg->getfield('susp') &&
1043 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1045 my $recur_prog = $part_pkg->getfield('recur');
1046 $recur_prog =~ /^(.*)$/ or do {
1047 $dbh->rollback if $oldAutoCommit;
1048 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1052 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1054 # shared with $recur_prog
1055 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1057 #my $cpt = new Safe;
1058 ##$cpt->permit(); #what is necessary?
1059 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1060 #$recur = $cpt->reval($recur_prog);
1061 $recur = eval $recur_prog;
1062 unless ( defined($recur) ) {
1063 $dbh->rollback if $oldAutoCommit;
1064 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1065 "(expression $recur_prog): $@";
1067 #change this bit to use Date::Manip? CAREFUL with timezones (see
1068 # mailing list archive)
1069 my ($sec,$min,$hour,$mday,$mon,$year) =
1070 (localtime($sdate) )[0,1,2,3,4,5];
1072 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1073 # only for figuring next bill date, nothing else, so, reset $sdate again
1075 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1076 $cust_pkg->last_bill($sdate)
1077 if $cust_pkg->dbdef_table->column('last_bill');
1079 $mon += $part_pkg->freq;
1080 until ( $mon < 12 ) { $mon -= 12; $year++; }
1081 $cust_pkg->setfield('bill',
1082 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1083 $cust_pkg_mod_flag = 1;
1086 warn "\$setup is undefined" unless defined($setup);
1087 warn "\$recur is undefined" unless defined($recur);
1088 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1090 my $taxable_charged = 0;
1091 if ( $cust_pkg_mod_flag ) {
1092 $error=$cust_pkg->replace($old_cust_pkg);
1093 if ( $error ) { #just in case
1094 $dbh->rollback if $oldAutoCommit;
1095 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1097 $setup = sprintf( "%.2f", $setup );
1098 $recur = sprintf( "%.2f", $recur );
1100 $dbh->rollback if $oldAutoCommit;
1101 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1104 $dbh->rollback if $oldAutoCommit;
1105 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1107 if ( $setup > 0 || $recur > 0 ) {
1108 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1109 'pkgnum' => $cust_pkg->pkgnum,
1113 'edate' => $cust_pkg->bill,
1114 'details' => \@details,
1116 push @cust_bill_pkg, $cust_bill_pkg;
1117 $total_setup += $setup;
1118 $total_recur += $recur;
1119 $taxable_charged += $setup
1120 unless $part_pkg->setuptax =~ /^Y$/i;
1121 $taxable_charged += $recur
1122 unless $part_pkg->recurtax =~ /^Y$/i;
1124 unless ( $self->tax =~ /Y/i
1125 || $self->payby eq 'COMP'
1126 || $taxable_charged == 0 ) {
1128 my $cust_main_county = qsearchs('cust_main_county',{
1129 'state' => $self->state,
1130 'county' => $self->county,
1131 'country' => $self->country,
1132 'taxclass' => $part_pkg->taxclass,
1134 $cust_main_county ||= qsearchs('cust_main_county',{
1135 'state' => $self->state,
1136 'county' => $self->county,
1137 'country' => $self->country,
1140 unless ( $cust_main_county ) {
1141 $dbh->rollback if $oldAutoCommit;
1143 "fatal: can't find tax rate for state/county/country/taxclass ".
1144 join('/', ( map $self->$_(), qw(state county country) ),
1145 $part_pkg->taxclass ). "\n";
1148 if ( $cust_main_county->exempt_amount ) {
1149 my ($mon,$year) = (localtime($sdate) )[4,5];
1151 my $freq = $part_pkg->freq || 1;
1152 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1153 foreach my $which_month ( 1 .. $freq ) {
1155 'custnum' => $self->custnum,
1156 'taxnum' => $cust_main_county->taxnum,
1157 'year' => 1900+$year,
1160 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1161 until ( $mon < 13 ) { $mon -= 12; $year++; }
1162 my $cust_tax_exempt =
1163 qsearchs('cust_tax_exempt', \%hash)
1164 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1165 my $remaining_exemption = sprintf("%.2f",
1166 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1167 if ( $remaining_exemption > 0 ) {
1168 my $addl = $remaining_exemption > $taxable_per_month
1169 ? $taxable_per_month
1170 : $remaining_exemption;
1171 $taxable_charged -= $addl;
1172 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1173 $cust_tax_exempt->hash,
1174 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1176 $error = $new_cust_tax_exempt->exemptnum
1177 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1178 : $new_cust_tax_exempt->insert;
1180 $dbh->rollback if $oldAutoCommit;
1181 return "fatal: can't update cust_tax_exempt: $error";
1184 } # if $remaining_exemption > 0
1186 } #foreach $which_month
1188 } #if $cust_main_county->exempt_amount
1190 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1192 #$tax += $taxable_charged * $cust_main_county->tax / 100
1193 $tax{ $cust_main_county->taxname || 'Tax' } +=
1194 $taxable_charged * $cust_main_county->tax / 100
1196 } #unless $self->tax =~ /Y/i
1197 # || $self->payby eq 'COMP'
1198 # || $taxable_charged == 0
1200 } #if $setup > 0 || $recur > 0
1202 } #if $cust_pkg_mod_flag
1204 } #foreach my $cust_pkg
1206 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1207 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1209 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1210 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1214 # unless ( $self->tax =~ /Y/i
1215 # || $self->payby eq 'COMP'
1216 # || $taxable_charged == 0 ) {
1217 # my $cust_main_county = qsearchs('cust_main_county',{
1218 # 'state' => $self->state,
1219 # 'county' => $self->county,
1220 # 'country' => $self->country,
1221 # } ) or die "fatal: can't find tax rate for state/county/country ".
1222 # $self->state. "/". $self->county. "/". $self->country. "\n";
1223 # my $tax = sprintf( "%.2f",
1224 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1227 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1228 my $tax = sprintf("%.2f", $tax{$taxname} );
1229 $charged = sprintf( "%.2f", $charged+$tax );
1231 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1237 'itemdesc' => $taxname,
1239 push @cust_bill_pkg, $cust_bill_pkg;
1243 my $cust_bill = new FS::cust_bill ( {
1244 'custnum' => $self->custnum,
1246 'charged' => $charged,
1248 $error = $cust_bill->insert;
1250 $dbh->rollback if $oldAutoCommit;
1251 return "can't create invoice for customer #". $self->custnum. ": $error";
1254 my $invnum = $cust_bill->invnum;
1256 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1258 $cust_bill_pkg->invnum($invnum);
1259 $error = $cust_bill_pkg->insert;
1261 $dbh->rollback if $oldAutoCommit;
1262 return "can't create invoice line item for customer #". $self->custnum.
1267 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1271 =item collect OPTIONS
1273 (Attempt to) collect money for this customer's outstanding invoices (see
1274 L<FS::cust_bill>). Usually used after the bill method.
1276 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1277 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1278 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1280 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1281 and the invoice events web interface.
1283 If there is an error, returns the error, otherwise returns false.
1285 Options are passed as name-value pairs.
1287 Currently available options are:
1289 invoice_time - Use this time when deciding when to print invoices and
1290 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>
1291 for conversion functions.
1293 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1296 retry_card - Deprecated alias for 'retry'
1298 batch_card - This option is deprecated. See the invoice events web interface
1299 to control whether cards are batched or run against a realtime gateway.
1301 report_badcard - This option is deprecated.
1303 force_print - This option is deprecated; see the invoice events web interface.
1305 quiet - set true to surpress email card/ACH decline notices.
1310 my( $self, %options ) = @_;
1311 my $invoice_time = $options{'invoice_time'} || time;
1314 local $SIG{HUP} = 'IGNORE';
1315 local $SIG{INT} = 'IGNORE';
1316 local $SIG{QUIT} = 'IGNORE';
1317 local $SIG{TERM} = 'IGNORE';
1318 local $SIG{TSTP} = 'IGNORE';
1319 local $SIG{PIPE} = 'IGNORE';
1321 my $oldAutoCommit = $FS::UID::AutoCommit;
1322 local $FS::UID::AutoCommit = 0;
1325 my $balance = $self->balance;
1326 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1327 unless ( $balance > 0 ) { #redundant?????
1328 $dbh->rollback if $oldAutoCommit; #hmm
1332 if ( exists($options{'retry_card'}) ) {
1333 carp 'retry_card option passed to collect is deprecated; use retry';
1334 $options{'retry'} ||= $options{'retry_card'};
1336 if ( exists($options{'retry'}) && $options{'retry'} ) {
1337 my $error = $self->retry_realtime;
1339 $dbh->rollback if $oldAutoCommit;
1344 foreach my $cust_bill ( $self->cust_bill ) {
1346 #this has to be before next's
1347 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1351 $balance = sprintf( "%.2f", $balance - $amount );
1353 next unless $cust_bill->owed > 0;
1355 # don't try to charge for the same invoice if it's already in a batch
1356 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1358 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1360 next unless $amount > 0;
1363 foreach my $part_bill_event (
1364 sort { $a->seconds <=> $b->seconds
1365 || $a->weight <=> $b->weight
1366 || $a->eventpart <=> $b->eventpart }
1367 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1368 && ! qsearchs( 'cust_bill_event', {
1369 'invnum' => $cust_bill->invnum,
1370 'eventpart' => $_->eventpart,
1374 qsearch('part_bill_event', { 'payby' => $self->payby,
1375 'disabled' => '', } )
1378 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1380 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1382 my $cust_main = $self; #for callback
1386 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1387 $error = eval $part_bill_event->eventcode;
1391 my $statustext = '';
1395 } elsif ( $error ) {
1397 $statustext = $error;
1402 #add cust_bill_event
1403 my $cust_bill_event = new FS::cust_bill_event {
1404 'invnum' => $cust_bill->invnum,
1405 'eventpart' => $part_bill_event->eventpart,
1406 #'_date' => $invoice_time,
1408 'status' => $status,
1409 'statustext' => $statustext,
1411 $error = $cust_bill_event->insert;
1413 #$dbh->rollback if $oldAutoCommit;
1414 #return "error: $error";
1416 # gah, even with transactions.
1417 $dbh->commit if $oldAutoCommit; #well.
1418 my $e = 'WARNING: Event run but database not updated - '.
1419 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1420 ', eventpart '. $part_bill_event->eventpart.
1431 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1436 =item retry_realtime
1438 Schedules realtime credit card / electronic check / LEC billing events for
1439 for retry. Useful if card information has changed or manual retry is desired.
1440 The 'collect' method must be called to actually retry the transaction.
1442 Implementation details: For each of this customer's open invoices, changes
1443 the status of the first "done" (with statustext error) realtime processing
1448 sub retry_realtime {
1451 local $SIG{HUP} = 'IGNORE';
1452 local $SIG{INT} = 'IGNORE';
1453 local $SIG{QUIT} = 'IGNORE';
1454 local $SIG{TERM} = 'IGNORE';
1455 local $SIG{TSTP} = 'IGNORE';
1456 local $SIG{PIPE} = 'IGNORE';
1458 my $oldAutoCommit = $FS::UID::AutoCommit;
1459 local $FS::UID::AutoCommit = 0;
1462 foreach my $cust_bill (
1463 grep { $_->cust_bill_event }
1464 $self->open_cust_bill
1466 my @cust_bill_event =
1467 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1469 #$_->part_bill_event->plan eq 'realtime-card'
1470 $_->part_bill_event->eventcode =~
1471 /\$cust_bill\->realtime_(card|ach|lec)/
1472 && $_->status eq 'done'
1475 $cust_bill->cust_bill_event;
1476 next unless @cust_bill_event;
1477 my $error = $cust_bill_event[0]->retry;
1479 $dbh->rollback if $oldAutoCommit;
1480 return "error scheduling invoice event for retry: $error";
1485 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1490 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1492 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1493 via a Business::OnlinePayment realtime gateway. See
1494 L<http://420.am/business-onlinepayment> for supported gateways.
1496 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1498 Available options are: I<description>, I<invnum>, I<quiet>
1500 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1501 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1502 if set, will override the value from the customer record.
1504 I<description> is a free-text field passed to the gateway. It defaults to
1505 "Internet services".
1507 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1508 specified invoice. If you don't specify an I<invnum> you might want to
1509 call the B<apply_payments> method.
1511 I<quiet> can be set true to surpress email decline notices.
1513 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1518 my( $self, $method, $amount, %options ) = @_;
1520 warn "$self $method $amount\n";
1521 warn " $_ => $options{$_}\n" foreach keys %options;
1524 $options{'description'} ||= 'Internet services';
1527 die "Real-time processing not enabled\n"
1528 unless $conf->exists('business-onlinepayment');
1529 eval "use Business::OnlinePayment";
1533 $self->set( $_ => $options{$_} )
1534 foreach grep { exists($options{$_}) }
1535 qw( payname address1 address2 city state zip payinfo paydate );
1538 my $bop_config = 'business-onlinepayment';
1539 $bop_config .= '-ach'
1540 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1541 my ( $processor, $login, $password, $action, @bop_options ) =
1542 $conf->config($bop_config);
1543 $action ||= 'normal authorization';
1544 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1548 my $address = $self->address1;
1549 $address .= ", ". $self->address2 if $self->address2;
1551 my($payname, $payfirst, $paylast);
1552 if ( $self->payname && $method ne 'ECHECK' ) {
1553 $payname = $self->payname;
1554 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1555 or return "Illegal payname $payname";
1556 ($payfirst, $paylast) = ($1, $2);
1558 $payfirst = $self->getfield('first');
1559 $paylast = $self->getfield('last');
1560 $payname = "$payfirst $paylast";
1563 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1564 if ( $conf->exists('emailinvoiceauto')
1565 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1566 push @invoicing_list, $self->all_emails;
1568 my $email = $invoicing_list[0];
1571 if ( $method eq 'CC' ) {
1572 $content{card_number} = $self->payinfo;
1573 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1574 $content{expiration} = "$2/$1";
1575 } elsif ( $method eq 'ECHECK' ) {
1576 my($account_number,$routing_code) = $self->payinfo;
1577 ( $content{account_number}, $content{routing_code} ) =
1578 split('@', $self->payinfo);
1579 $content{bank_name} = $self->payname;
1580 $content{account_type} = 'CHECKING';
1581 $content{account_name} = $payname;
1582 $content{customer_org} = $self->company ? 'B' : 'I';
1583 $content{customer_ssn} = $self->ss;
1584 } elsif ( $method eq 'LEC' ) {
1585 $content{phone} = $self->payinfo;
1590 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1593 new Business::OnlinePayment( $processor, @bop_options );
1594 $transaction->content(
1597 'password' => $password,
1598 'action' => $action1,
1599 'description' => $options{'description'},
1600 'amount' => $amount,
1601 'invoice_number' => $options{'invnum'},
1602 'customer_id' => $self->custnum,
1603 'last_name' => $paylast,
1604 'first_name' => $payfirst,
1606 'address' => $address,
1607 'city' => $self->city,
1608 'state' => $self->state,
1609 'zip' => $self->zip,
1610 'country' => $self->country,
1611 'referer' => 'http://cleanwhisker.420.am/',
1613 'phone' => $self->daytime || $self->night,
1616 $transaction->submit();
1618 if ( $transaction->is_success() && $action2 ) {
1619 my $auth = $transaction->authorization;
1620 my $ordernum = $transaction->can('order_number')
1621 ? $transaction->order_number
1625 new Business::OnlinePayment( $processor, @bop_options );
1632 password => $password,
1633 order_number => $ordernum,
1635 authorization => $auth,
1636 description => $options{'description'},
1639 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1640 transaction_sequence_num local_transaction_date
1641 local_transaction_time AVS_result_code )) {
1642 $capture{$field} = $transaction->$field() if $transaction->can($field);
1645 $capture->content( %capture );
1649 unless ( $capture->is_success ) {
1650 my $e = "Authorization sucessful but capture failed, custnum #".
1651 $self->custnum. ': '. $capture->result_code.
1652 ": ". $capture->error_message;
1660 if ( $transaction->is_success() ) {
1662 my %method2payby = (
1668 my $cust_pay = new FS::cust_pay ( {
1669 'custnum' => $self->custnum,
1670 'invnum' => $options{'invnum'},
1673 'payby' => $method2payby{$method},
1674 'payinfo' => $self->payinfo,
1675 'paybatch' => "$processor:". $transaction->authorization,
1677 my $error = $cust_pay->insert;
1679 # gah, even with transactions.
1680 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1681 'error applying payment, invnum #' . $self->invnum.
1682 " ($processor): $error";
1691 my $perror = "$processor error: ". $transaction->error_message;
1693 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1694 && $conf->exists('emaildecline')
1695 && grep { $_ ne 'POST' } $self->invoicing_list
1697 my @templ = $conf->config('declinetemplate');
1698 my $template = new Text::Template (
1700 SOURCE => [ map "$_\n", @templ ],
1701 ) or return "($perror) can't create template: $Text::Template::ERROR";
1702 $template->compile()
1703 or return "($perror) can't compile template: $Text::Template::ERROR";
1705 my $templ_hash = { error => $transaction->error_message };
1707 my $error = send_email(
1708 'from' => $conf->config('invoice_from'),
1709 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1710 'subject' => 'Your payment could not be processed',
1711 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1714 $perror .= " (also received error sending decline notification: $error)"
1726 Returns the total owed for this customer on all invoices
1727 (see L<FS::cust_bill/owed>).
1733 $self->total_owed_date(2145859200); #12/31/2037
1736 =item total_owed_date TIME
1738 Returns the total owed for this customer on all invoices with date earlier than
1739 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1740 see L<Time::Local> and L<Date::Parse> for conversion functions.
1744 sub total_owed_date {
1748 foreach my $cust_bill (
1749 grep { $_->_date <= $time }
1750 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1752 $total_bill += $cust_bill->owed;
1754 sprintf( "%.2f", $total_bill );
1759 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1760 to outstanding invoice balances in chronological order and returns the value
1761 of any remaining unapplied credits available for refund
1762 (see L<FS::cust_refund>).
1769 return 0 unless $self->total_credited;
1771 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1772 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1774 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1775 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1779 foreach my $cust_bill ( @invoices ) {
1782 if ( !defined($credit) || $credit->credited == 0) {
1783 $credit = pop @credits or last;
1786 if ($cust_bill->owed >= $credit->credited) {
1787 $amount=$credit->credited;
1789 $amount=$cust_bill->owed;
1792 my $cust_credit_bill = new FS::cust_credit_bill ( {
1793 'crednum' => $credit->crednum,
1794 'invnum' => $cust_bill->invnum,
1795 'amount' => $amount,
1797 my $error = $cust_credit_bill->insert;
1798 die $error if $error;
1800 redo if ($cust_bill->owed > 0);
1804 return $self->total_credited;
1807 =item apply_payments
1809 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1810 to outstanding invoice balances in chronological order.
1812 #and returns the value of any remaining unapplied payments.
1816 sub apply_payments {
1821 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1822 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1824 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1825 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1829 foreach my $cust_bill ( @invoices ) {
1832 if ( !defined($payment) || $payment->unapplied == 0 ) {
1833 $payment = pop @payments or last;
1836 if ( $cust_bill->owed >= $payment->unapplied ) {
1837 $amount = $payment->unapplied;
1839 $amount = $cust_bill->owed;
1842 my $cust_bill_pay = new FS::cust_bill_pay ( {
1843 'paynum' => $payment->paynum,
1844 'invnum' => $cust_bill->invnum,
1845 'amount' => $amount,
1847 my $error = $cust_bill_pay->insert;
1848 die $error if $error;
1850 redo if ( $cust_bill->owed > 0);
1854 return $self->total_unapplied_payments;
1857 =item total_credited
1859 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1860 customer. See L<FS::cust_credit/credited>.
1864 sub total_credited {
1866 my $total_credit = 0;
1867 foreach my $cust_credit ( qsearch('cust_credit', {
1868 'custnum' => $self->custnum,
1870 $total_credit += $cust_credit->credited;
1872 sprintf( "%.2f", $total_credit );
1875 =item total_unapplied_payments
1877 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1878 See L<FS::cust_pay/unapplied>.
1882 sub total_unapplied_payments {
1884 my $total_unapplied = 0;
1885 foreach my $cust_pay ( qsearch('cust_pay', {
1886 'custnum' => $self->custnum,
1888 $total_unapplied += $cust_pay->unapplied;
1890 sprintf( "%.2f", $total_unapplied );
1895 Returns the balance for this customer (total_owed minus total_credited
1896 minus total_unapplied_payments).
1903 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1907 =item balance_date TIME
1909 Returns the balance for this customer, only considering invoices with date
1910 earlier than TIME (total_owed_date minus total_credited minus
1911 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1912 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1921 $self->total_owed_date($time)
1922 - $self->total_credited
1923 - $self->total_unapplied_payments
1927 =item invoicing_list [ ARRAYREF ]
1929 If an arguement is given, sets these email addresses as invoice recipients
1930 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1931 (except as warnings), so use check_invoicing_list first.
1933 Returns a list of email addresses (with svcnum entries expanded).
1935 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1936 check it without disturbing anything by passing nothing.
1938 This interface may change in the future.
1942 sub invoicing_list {
1943 my( $self, $arrayref ) = @_;
1945 my @cust_main_invoice;
1946 if ( $self->custnum ) {
1947 @cust_main_invoice =
1948 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1950 @cust_main_invoice = ();
1952 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1953 #warn $cust_main_invoice->destnum;
1954 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1955 #warn $cust_main_invoice->destnum;
1956 my $error = $cust_main_invoice->delete;
1957 warn $error if $error;
1960 if ( $self->custnum ) {
1961 @cust_main_invoice =
1962 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1964 @cust_main_invoice = ();
1966 my %seen = map { $_->address => 1 } @cust_main_invoice;
1967 foreach my $address ( @{$arrayref} ) {
1968 next if exists $seen{$address} && $seen{$address};
1969 $seen{$address} = 1;
1970 my $cust_main_invoice = new FS::cust_main_invoice ( {
1971 'custnum' => $self->custnum,
1974 my $error = $cust_main_invoice->insert;
1975 warn $error if $error;
1978 if ( $self->custnum ) {
1980 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1986 =item check_invoicing_list ARRAYREF
1988 Checks these arguements as valid input for the invoicing_list method. If there
1989 is an error, returns the error, otherwise returns false.
1993 sub check_invoicing_list {
1994 my( $self, $arrayref ) = @_;
1995 foreach my $address ( @{$arrayref} ) {
1996 my $cust_main_invoice = new FS::cust_main_invoice ( {
1997 'custnum' => $self->custnum,
2000 my $error = $self->custnum
2001 ? $cust_main_invoice->check
2002 : $cust_main_invoice->checkdest
2004 return $error if $error;
2009 =item set_default_invoicing_list
2011 Sets the invoicing list to all accounts associated with this customer,
2012 overwriting any previous invoicing list.
2016 sub set_default_invoicing_list {
2018 $self->invoicing_list($self->all_emails);
2023 Returns the email addresses of all accounts provisioned for this customer.
2030 foreach my $cust_pkg ( $self->all_pkgs ) {
2031 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2033 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2034 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2036 $list{$_}=1 foreach map { $_->email } @svc_acct;
2041 =item invoicing_list_addpost
2043 Adds postal invoicing to this customer. If this customer is already configured
2044 to receive postal invoices, does nothing.
2048 sub invoicing_list_addpost {
2050 return if grep { $_ eq 'POST' } $self->invoicing_list;
2051 my @invoicing_list = $self->invoicing_list;
2052 push @invoicing_list, 'POST';
2053 $self->invoicing_list(\@invoicing_list);
2056 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2058 Returns an array of customers referred by this customer (referral_custnum set
2059 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2060 customers referred by customers referred by this customer and so on, inclusive.
2061 The default behavior is DEPTH 1 (no recursion).
2065 sub referral_cust_main {
2067 my $depth = @_ ? shift : 1;
2068 my $exclude = @_ ? shift : {};
2071 map { $exclude->{$_->custnum}++; $_; }
2072 grep { ! $exclude->{ $_->custnum } }
2073 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2077 map { $_->referral_cust_main($depth-1, $exclude) }
2084 =item referral_cust_main_ncancelled
2086 Same as referral_cust_main, except only returns customers with uncancelled
2091 sub referral_cust_main_ncancelled {
2093 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2096 =item referral_cust_pkg [ DEPTH ]
2098 Like referral_cust_main, except returns a flat list of all unsuspended (and
2099 uncancelled) packages for each customer. The number of items in this list may
2100 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2104 sub referral_cust_pkg {
2106 my $depth = @_ ? shift : 1;
2108 map { $_->unsuspended_pkgs }
2109 grep { $_->unsuspended_pkgs }
2110 $self->referral_cust_main($depth);
2113 =item credit AMOUNT, REASON
2115 Applies a credit to this customer. If there is an error, returns the error,
2116 otherwise returns false.
2121 my( $self, $amount, $reason ) = @_;
2122 my $cust_credit = new FS::cust_credit {
2123 'custnum' => $self->custnum,
2124 'amount' => $amount,
2125 'reason' => $reason,
2127 $cust_credit->insert;
2130 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2132 Creates a one-time charge for this customer. If there is an error, returns
2133 the error, otherwise returns false.
2138 my ( $self, $amount ) = ( shift, shift );
2139 my $pkg = @_ ? shift : 'One-time charge';
2140 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2141 my $taxclass = @_ ? shift : '';
2143 local $SIG{HUP} = 'IGNORE';
2144 local $SIG{INT} = 'IGNORE';
2145 local $SIG{QUIT} = 'IGNORE';
2146 local $SIG{TERM} = 'IGNORE';
2147 local $SIG{TSTP} = 'IGNORE';
2148 local $SIG{PIPE} = 'IGNORE';
2150 my $oldAutoCommit = $FS::UID::AutoCommit;
2151 local $FS::UID::AutoCommit = 0;
2154 my $part_pkg = new FS::part_pkg ( {
2156 'comment' => $comment,
2161 'taxclass' => $taxclass,
2164 my $error = $part_pkg->insert;
2166 $dbh->rollback if $oldAutoCommit;
2170 my $pkgpart = $part_pkg->pkgpart;
2171 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2172 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2173 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2174 $error = $type_pkgs->insert;
2176 $dbh->rollback if $oldAutoCommit;
2181 my $cust_pkg = new FS::cust_pkg ( {
2182 'custnum' => $self->custnum,
2183 'pkgpart' => $pkgpart,
2186 $error = $cust_pkg->insert;
2188 $dbh->rollback if $oldAutoCommit;
2192 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2199 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2205 sort { $a->_date <=> $b->_date }
2206 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2209 =item open_cust_bill
2211 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2216 sub open_cust_bill {
2218 grep { $_->owed > 0 } $self->cust_bill;
2227 =item check_and_rebuild_fuzzyfiles
2231 sub check_and_rebuild_fuzzyfiles {
2232 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2233 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2234 or &rebuild_fuzzyfiles;
2237 =item rebuild_fuzzyfiles
2241 sub rebuild_fuzzyfiles {
2243 use Fcntl qw(:flock);
2245 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2249 open(LASTLOCK,">>$dir/cust_main.last")
2250 or die "can't open $dir/cust_main.last: $!";
2251 flock(LASTLOCK,LOCK_EX)
2252 or die "can't lock $dir/cust_main.last: $!";
2254 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2256 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2257 if defined dbdef->table('cust_main')->column('ship_last');
2259 open (LASTCACHE,">$dir/cust_main.last.tmp")
2260 or die "can't open $dir/cust_main.last.tmp: $!";
2261 print LASTCACHE join("\n", @all_last), "\n";
2262 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2264 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2269 open(COMPANYLOCK,">>$dir/cust_main.company")
2270 or die "can't open $dir/cust_main.company: $!";
2271 flock(COMPANYLOCK,LOCK_EX)
2272 or die "can't lock $dir/cust_main.company: $!";
2274 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2276 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2277 if defined dbdef->table('cust_main')->column('ship_last');
2279 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2280 or die "can't open $dir/cust_main.company.tmp: $!";
2281 print COMPANYCACHE join("\n", @all_company), "\n";
2282 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2284 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2294 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2295 open(LASTCACHE,"<$dir/cust_main.last")
2296 or die "can't open $dir/cust_main.last: $!";
2297 my @array = map { chomp; $_; } <LASTCACHE>;
2307 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2308 open(COMPANYCACHE,"<$dir/cust_main.company")
2309 or die "can't open $dir/cust_main.last: $!";
2310 my @array = map { chomp; $_; } <COMPANYCACHE>;
2315 =item append_fuzzyfiles LASTNAME COMPANY
2319 sub append_fuzzyfiles {
2320 my( $last, $company ) = @_;
2322 &check_and_rebuild_fuzzyfiles;
2324 use Fcntl qw(:flock);
2326 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2330 open(LAST,">>$dir/cust_main.last")
2331 or die "can't open $dir/cust_main.last: $!";
2333 or die "can't lock $dir/cust_main.last: $!";
2335 print LAST "$last\n";
2338 or die "can't unlock $dir/cust_main.last: $!";
2344 open(COMPANY,">>$dir/cust_main.company")
2345 or die "can't open $dir/cust_main.company: $!";
2346 flock(COMPANY,LOCK_EX)
2347 or die "can't lock $dir/cust_main.company: $!";
2349 print COMPANY "$company\n";
2351 flock(COMPANY,LOCK_UN)
2352 or die "can't unlock $dir/cust_main.company: $!";
2366 #warn join('-',keys %$param);
2367 my $fh = $param->{filehandle};
2368 my $agentnum = $param->{agentnum};
2369 my $refnum = $param->{refnum};
2370 my $pkgpart = $param->{pkgpart};
2371 my @fields = @{$param->{fields}};
2373 eval "use Date::Parse;";
2375 eval "use Text::CSV_XS;";
2378 my $csv = new Text::CSV_XS;
2385 local $SIG{HUP} = 'IGNORE';
2386 local $SIG{INT} = 'IGNORE';
2387 local $SIG{QUIT} = 'IGNORE';
2388 local $SIG{TERM} = 'IGNORE';
2389 local $SIG{TSTP} = 'IGNORE';
2390 local $SIG{PIPE} = 'IGNORE';
2392 my $oldAutoCommit = $FS::UID::AutoCommit;
2393 local $FS::UID::AutoCommit = 0;
2396 #while ( $columns = $csv->getline($fh) ) {
2398 while ( defined($line=<$fh>) ) {
2400 $csv->parse($line) or do {
2401 $dbh->rollback if $oldAutoCommit;
2402 return "can't parse: ". $csv->error_input();
2405 my @columns = $csv->fields();
2406 #warn join('-',@columns);
2409 agentnum => $agentnum,
2411 country => 'US', #default
2412 payby => 'BILL', #default
2413 paydate => '12/2037', #default
2415 my $billtime = time;
2416 my %cust_pkg = ( pkgpart => $pkgpart );
2417 foreach my $field ( @fields ) {
2418 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2419 #$cust_pkg{$1} = str2time( shift @$columns );
2420 if ( $1 eq 'setup' ) {
2421 $billtime = str2time(shift @columns);
2423 $cust_pkg{$1} = str2time( shift @columns );
2426 #$cust_main{$field} = shift @$columns;
2427 $cust_main{$field} = shift @columns;
2431 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2432 my $cust_main = new FS::cust_main ( \%cust_main );
2434 tie my %hash, 'Tie::RefHash'; #this part is important
2435 $hash{$cust_pkg} = [] if $pkgpart;
2436 my $error = $cust_main->insert( \%hash );
2439 $dbh->rollback if $oldAutoCommit;
2440 return "can't insert customer for $line: $error";
2443 #false laziness w/bill.cgi
2444 $error = $cust_main->bill( 'time' => $billtime );
2446 $dbh->rollback if $oldAutoCommit;
2447 return "can't bill customer for $line: $error";
2450 $cust_main->apply_payments;
2451 $cust_main->apply_credits;
2453 $error = $cust_main->collect();
2455 $dbh->rollback if $oldAutoCommit;
2456 return "can't collect customer for $line: $error";
2462 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2464 return "Empty file!" unless $imported;
2476 #warn join('-',keys %$param);
2477 my $fh = $param->{filehandle};
2478 my @fields = @{$param->{fields}};
2480 eval "use Date::Parse;";
2482 eval "use Text::CSV_XS;";
2485 my $csv = new Text::CSV_XS;
2492 local $SIG{HUP} = 'IGNORE';
2493 local $SIG{INT} = 'IGNORE';
2494 local $SIG{QUIT} = 'IGNORE';
2495 local $SIG{TERM} = 'IGNORE';
2496 local $SIG{TSTP} = 'IGNORE';
2497 local $SIG{PIPE} = 'IGNORE';
2499 my $oldAutoCommit = $FS::UID::AutoCommit;
2500 local $FS::UID::AutoCommit = 0;
2503 #while ( $columns = $csv->getline($fh) ) {
2505 while ( defined($line=<$fh>) ) {
2507 $csv->parse($line) or do {
2508 $dbh->rollback if $oldAutoCommit;
2509 return "can't parse: ". $csv->error_input();
2512 my @columns = $csv->fields();
2513 #warn join('-',@columns);
2516 foreach my $field ( @fields ) {
2517 $row{$field} = shift @columns;
2520 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2521 unless ( $cust_main ) {
2522 $dbh->rollback if $oldAutoCommit;
2523 return "unknown custnum $row{'custnum'}";
2526 if ( $row{'amount'} > 0 ) {
2527 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2529 $dbh->rollback if $oldAutoCommit;
2533 } elsif ( $row{'amount'} < 0 ) {
2534 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2537 $dbh->rollback if $oldAutoCommit;
2547 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2549 return "Empty file!" unless $imported;
2561 The delete method should possibly take an FS::cust_main object reference
2562 instead of a scalar customer number.
2564 Bill and collect options should probably be passed as references instead of a
2567 There should probably be a configuration file with a list of allowed credit
2570 No multiple currency support (probably a larger project than just this module).
2574 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2575 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2576 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.