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 minimum 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;
24 use FS::cust_pay_void;
27 use FS::part_referral;
28 use FS::cust_main_county;
30 use FS::cust_main_invoice;
31 use FS::cust_credit_bill;
32 use FS::cust_bill_pay;
33 use FS::prepay_credit;
36 use FS::part_bill_event;
37 use FS::cust_bill_event;
38 use FS::cust_tax_exempt;
40 use FS::Msgcat qw(gettext);
42 @ISA = qw( FS::Record );
44 $realtime_bop_decline_quiet = 0;
51 #ask FS::UID to run this stuff for us later
52 #$FS::UID::callback{'FS::cust_main'} = sub {
53 install_callback FS::UID sub {
55 #yes, need it for stuff below (prolly should be cached)
60 my ( $hashref, $cache ) = @_;
61 if ( exists $hashref->{'pkgnum'} ) {
62 # #@{ $self->{'_pkgnum'} } = ();
63 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
64 $self->{'_pkgnum'} = $subcache;
65 #push @{ $self->{'_pkgnum'} },
66 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
72 FS::cust_main - Object methods for cust_main records
78 $record = new FS::cust_main \%hash;
79 $record = new FS::cust_main { 'column' => 'value' };
81 $error = $record->insert;
83 $error = $new_record->replace($old_record);
85 $error = $record->delete;
87 $error = $record->check;
89 @cust_pkg = $record->all_pkgs;
91 @cust_pkg = $record->ncancelled_pkgs;
93 @cust_pkg = $record->suspended_pkgs;
95 $error = $record->bill;
96 $error = $record->bill %options;
97 $error = $record->bill 'time' => $time;
99 $error = $record->collect;
100 $error = $record->collect %options;
101 $error = $record->collect 'invoice_time' => $time,
102 'batch_card' => 'yes',
103 'report_badcard' => 'yes',
108 An FS::cust_main object represents a customer. FS::cust_main inherits from
109 FS::Record. The following fields are currently supported:
113 =item custnum - primary key (assigned automatically for new customers)
115 =item agentnum - agent (see L<FS::agent>)
117 =item refnum - Advertising source (see L<FS::part_referral>)
123 =item ss - social security number (optional)
125 =item company - (optional)
129 =item address2 - (optional)
133 =item county - (optional, see L<FS::cust_main_county>)
135 =item state - (see L<FS::cust_main_county>)
139 =item country - (see L<FS::cust_main_county>)
141 =item daytime - phone (optional)
143 =item night - phone (optional)
145 =item fax - phone (optional)
147 =item ship_first - name
149 =item ship_last - name
151 =item ship_company - (optional)
155 =item ship_address2 - (optional)
159 =item ship_county - (optional, see L<FS::cust_main_county>)
161 =item ship_state - (see L<FS::cust_main_county>)
165 =item ship_country - (see L<FS::cust_main_county>)
167 =item ship_daytime - phone (optional)
169 =item ship_night - phone (optional)
171 =item ship_fax - phone (optional)
173 =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>)
175 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
177 =item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
179 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
181 =item payname - name on card or billing name
183 =item tax - tax exempt, empty or `Y'
185 =item otaker - order taker (assigned automatically, see L<FS::UID>)
187 =item comments - comments (optional)
189 =item referral_custnum - referring customer number
199 Creates a new customer. To add the customer to the database, see L<"insert">.
201 Note that this stores the hash reference, not a distinct copy of the hash it
202 points to. You can ask the object for a copy with the I<hash> method.
206 sub table { 'cust_main'; }
208 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
210 Adds this customer to the database. If there is an error, returns the error,
211 otherwise returns false.
213 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
214 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
215 are inserted atomicly, or the transaction is rolled back. Passing an empty
216 hash reference is equivalent to not supplying this parameter. There should be
217 a better explanation of this, but until then, here's an example:
220 tie %hash, 'Tie::RefHash'; #this part is important
222 $cust_pkg => [ $svc_acct ],
225 $cust_main->insert( \%hash );
227 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
228 be set as the invoicing list (see L<"invoicing_list">). Errors return as
229 expected and rollback the entire transaction; it is not necessary to call
230 check_invoicing_list first. The invoicing_list is set after the records in the
231 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
232 invoicing_list destination to the newly-created svc_acct. Here's an example:
234 $cust_main->insert( {}, [ $email, 'POST' ] );
236 Currently available options are: I<depend_jobnum> and I<noexport>.
238 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
239 on the supplied jobnum (they will not run until the specific job completes).
240 This can be used to defer provisioning until some action completes (such
241 as running the customer's credit card sucessfully).
243 The I<noexport> option is deprecated. If I<noexport> is set true, no
244 provisioning jobs (exports) are scheduled. (You can schedule them later with
245 the B<reexport> method.)
251 my $cust_pkgs = @_ ? shift : {};
252 my $invoicing_list = @_ ? shift : '';
254 warn "FS::cust_main::insert called with options ".
255 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
258 local $SIG{HUP} = 'IGNORE';
259 local $SIG{INT} = 'IGNORE';
260 local $SIG{QUIT} = 'IGNORE';
261 local $SIG{TERM} = 'IGNORE';
262 local $SIG{TSTP} = 'IGNORE';
263 local $SIG{PIPE} = 'IGNORE';
265 my $oldAutoCommit = $FS::UID::AutoCommit;
266 local $FS::UID::AutoCommit = 0;
271 if ( $self->payby eq 'PREPAY' ) {
272 $self->payby('BILL');
273 my $prepay_credit = qsearchs(
275 { 'identifier' => $self->payinfo },
279 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
280 unless $prepay_credit;
281 $amount = $prepay_credit->amount;
282 $seconds = $prepay_credit->seconds;
283 my $error = $prepay_credit->delete;
285 $dbh->rollback if $oldAutoCommit;
286 return "removing prepay_credit (transaction rolled back): $error";
290 my $error = $self->SUPER::insert;
292 $dbh->rollback if $oldAutoCommit;
293 #return "inserting cust_main record (transaction rolled back): $error";
298 if ( $invoicing_list ) {
299 $error = $self->check_invoicing_list( $invoicing_list );
301 $dbh->rollback if $oldAutoCommit;
302 return "checking invoicing_list (transaction rolled back): $error";
304 $self->invoicing_list( $invoicing_list );
308 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
310 $dbh->rollback if $oldAutoCommit;
315 $dbh->rollback if $oldAutoCommit;
316 return "No svc_acct record to apply pre-paid time";
320 my $cust_credit = new FS::cust_credit {
321 'custnum' => $self->custnum,
324 $error = $cust_credit->insert;
326 $dbh->rollback if $oldAutoCommit;
327 return "inserting credit (transaction rolled back): $error";
331 $error = $self->queue_fuzzyfiles_update;
333 $dbh->rollback if $oldAutoCommit;
334 return "updating fuzzy search cache: $error";
337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
342 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
344 Like the insert method on an existing record, this method orders a package
345 and included services atomicaly. Pass a Tie::RefHash data structure to this
346 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
347 be a better explanation of this, but until then, here's an example:
350 tie %hash, 'Tie::RefHash'; #this part is important
352 $cust_pkg => [ $svc_acct ],
355 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
357 Currently available options are: I<depend_jobnum> and I<noexport>.
359 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
360 on the supplied jobnum (they will not run until the specific job completes).
361 This can be used to defer provisioning until some action completes (such
362 as running the customer's credit card sucessfully).
364 The I<noexport> option is deprecated. If I<noexport> is set true, no
365 provisioning jobs (exports) are scheduled. (You can schedule them later with
366 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
367 on the cust_main object is not recommended, as existing services will also be
374 my $cust_pkgs = shift;
377 my %svc_options = ();
378 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
379 if exists $options{'depend_jobnum'};
380 warn "FS::cust_main::order_pkgs called with options ".
381 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
384 local $SIG{HUP} = 'IGNORE';
385 local $SIG{INT} = 'IGNORE';
386 local $SIG{QUIT} = 'IGNORE';
387 local $SIG{TERM} = 'IGNORE';
388 local $SIG{TSTP} = 'IGNORE';
389 local $SIG{PIPE} = 'IGNORE';
391 my $oldAutoCommit = $FS::UID::AutoCommit;
392 local $FS::UID::AutoCommit = 0;
395 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
397 foreach my $cust_pkg ( keys %$cust_pkgs ) {
398 $cust_pkg->custnum( $self->custnum );
399 my $error = $cust_pkg->insert;
401 $dbh->rollback if $oldAutoCommit;
402 return "inserting cust_pkg (transaction rolled back): $error";
404 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
405 $svc_something->pkgnum( $cust_pkg->pkgnum );
406 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
407 $svc_something->seconds( $svc_something->seconds + $$seconds );
410 $error = $svc_something->insert(%svc_options);
412 $dbh->rollback if $oldAutoCommit;
413 #return "inserting svc_ (transaction rolled back): $error";
419 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
425 This method is deprecated. See the I<depend_jobnum> option to the insert and
426 order_pkgs methods for a better way to defer provisioning.
428 Re-schedules all exports by calling the B<reexport> method of all associated
429 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
430 otherwise returns false.
437 carp "warning: FS::cust_main::reexport is deprectated; ".
438 "use the depend_jobnum option to insert or order_pkgs to delay export";
440 local $SIG{HUP} = 'IGNORE';
441 local $SIG{INT} = 'IGNORE';
442 local $SIG{QUIT} = 'IGNORE';
443 local $SIG{TERM} = 'IGNORE';
444 local $SIG{TSTP} = 'IGNORE';
445 local $SIG{PIPE} = 'IGNORE';
447 my $oldAutoCommit = $FS::UID::AutoCommit;
448 local $FS::UID::AutoCommit = 0;
451 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
452 my $error = $cust_pkg->reexport;
454 $dbh->rollback if $oldAutoCommit;
459 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
464 =item delete NEW_CUSTNUM
466 This deletes the customer. If there is an error, returns the error, otherwise
469 This will completely remove all traces of the customer record. This is not
470 what you want when a customer cancels service; for that, cancel all of the
471 customer's packages (see L</cancel>).
473 If the customer has any uncancelled packages, you need to pass a new (valid)
474 customer number for those packages to be transferred to. Cancelled packages
475 will be deleted. Did I mention that this is NOT what you want when a customer
476 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
478 You can't delete a customer with invoices (see L<FS::cust_bill>),
479 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
480 refunds (see L<FS::cust_refund>).
487 local $SIG{HUP} = 'IGNORE';
488 local $SIG{INT} = 'IGNORE';
489 local $SIG{QUIT} = 'IGNORE';
490 local $SIG{TERM} = 'IGNORE';
491 local $SIG{TSTP} = 'IGNORE';
492 local $SIG{PIPE} = 'IGNORE';
494 my $oldAutoCommit = $FS::UID::AutoCommit;
495 local $FS::UID::AutoCommit = 0;
498 if ( $self->cust_bill ) {
499 $dbh->rollback if $oldAutoCommit;
500 return "Can't delete a customer with invoices";
502 if ( $self->cust_credit ) {
503 $dbh->rollback if $oldAutoCommit;
504 return "Can't delete a customer with credits";
506 if ( $self->cust_pay ) {
507 $dbh->rollback if $oldAutoCommit;
508 return "Can't delete a customer with payments";
510 if ( $self->cust_refund ) {
511 $dbh->rollback if $oldAutoCommit;
512 return "Can't delete a customer with refunds";
515 my @cust_pkg = $self->ncancelled_pkgs;
517 my $new_custnum = shift;
518 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
519 $dbh->rollback if $oldAutoCommit;
520 return "Invalid new customer number: $new_custnum";
522 foreach my $cust_pkg ( @cust_pkg ) {
523 my %hash = $cust_pkg->hash;
524 $hash{'custnum'} = $new_custnum;
525 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
526 my $error = $new_cust_pkg->replace($cust_pkg);
528 $dbh->rollback if $oldAutoCommit;
533 my @cancelled_cust_pkg = $self->all_pkgs;
534 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
535 my $error = $cust_pkg->delete;
537 $dbh->rollback if $oldAutoCommit;
542 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
543 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
545 my $error = $cust_main_invoice->delete;
547 $dbh->rollback if $oldAutoCommit;
552 my $error = $self->SUPER::delete;
554 $dbh->rollback if $oldAutoCommit;
558 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
563 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
565 Replaces the OLD_RECORD with this one in the database. If there is an error,
566 returns the error, otherwise returns false.
568 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
569 be set as the invoicing list (see L<"invoicing_list">). Errors return as
570 expected and rollback the entire transaction; it is not necessary to call
571 check_invoicing_list first. Here's an example:
573 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
582 local $SIG{HUP} = 'IGNORE';
583 local $SIG{INT} = 'IGNORE';
584 local $SIG{QUIT} = 'IGNORE';
585 local $SIG{TERM} = 'IGNORE';
586 local $SIG{TSTP} = 'IGNORE';
587 local $SIG{PIPE} = 'IGNORE';
589 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
590 && $conf->config('users-allow_comp') ) {
591 return "You are not permitted to create complimentary accounts."
592 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
595 my $oldAutoCommit = $FS::UID::AutoCommit;
596 local $FS::UID::AutoCommit = 0;
599 my $error = $self->SUPER::replace($old);
602 $dbh->rollback if $oldAutoCommit;
606 if ( @param ) { # INVOICING_LIST_ARYREF
607 my $invoicing_list = shift @param;
608 $error = $self->check_invoicing_list( $invoicing_list );
610 $dbh->rollback if $oldAutoCommit;
613 $self->invoicing_list( $invoicing_list );
616 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
617 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
618 # card/check/lec info has changed, want to retry realtime_ invoice events
619 my $error = $self->retry_realtime;
621 $dbh->rollback if $oldAutoCommit;
626 $error = $self->queue_fuzzyfiles_update;
628 $dbh->rollback if $oldAutoCommit;
629 return "updating fuzzy search cache: $error";
632 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
637 =item queue_fuzzyfiles_update
639 Used by insert & replace to update the fuzzy search cache
643 sub queue_fuzzyfiles_update {
646 local $SIG{HUP} = 'IGNORE';
647 local $SIG{INT} = 'IGNORE';
648 local $SIG{QUIT} = 'IGNORE';
649 local $SIG{TERM} = 'IGNORE';
650 local $SIG{TSTP} = 'IGNORE';
651 local $SIG{PIPE} = 'IGNORE';
653 my $oldAutoCommit = $FS::UID::AutoCommit;
654 local $FS::UID::AutoCommit = 0;
657 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
658 my $error = $queue->insert($self->getfield('last'), $self->company);
660 $dbh->rollback if $oldAutoCommit;
661 return "queueing job (transaction rolled back): $error";
664 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
665 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
666 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
668 $dbh->rollback if $oldAutoCommit;
669 return "queueing job (transaction rolled back): $error";
673 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
680 Checks all fields to make sure this is a valid customer record. If there is
681 an error, returns the error, otherwise returns false. Called by the insert
689 #warn "BEFORE: \n". $self->_dump;
692 $self->ut_numbern('custnum')
693 || $self->ut_number('agentnum')
694 || $self->ut_number('refnum')
695 || $self->ut_name('last')
696 || $self->ut_name('first')
697 || $self->ut_textn('company')
698 || $self->ut_text('address1')
699 || $self->ut_textn('address2')
700 || $self->ut_text('city')
701 || $self->ut_textn('county')
702 || $self->ut_textn('state')
703 || $self->ut_country('country')
704 || $self->ut_anything('comments')
705 || $self->ut_numbern('referral_custnum')
707 #barf. need message catalogs. i18n. etc.
708 $error .= "Please select an advertising source."
709 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
710 return $error if $error;
712 return "Unknown agent"
713 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
715 return "Unknown refnum"
716 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
718 return "Unknown referring custnum ". $self->referral_custnum
719 unless ! $self->referral_custnum
720 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
722 if ( $self->ss eq '' ) {
727 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
728 or return "Illegal social security number: ". $self->ss;
729 $self->ss("$1-$2-$3");
733 # bad idea to disable, causes billing to fail because of no tax rates later
734 # unless ( $import ) {
735 unless ( qsearch('cust_main_county', {
736 'country' => $self->country,
739 return "Unknown state/county/country: ".
740 $self->state. "/". $self->county. "/". $self->country
741 unless qsearch('cust_main_county',{
742 'state' => $self->state,
743 'county' => $self->county,
744 'country' => $self->country,
750 $self->ut_phonen('daytime', $self->country)
751 || $self->ut_phonen('night', $self->country)
752 || $self->ut_phonen('fax', $self->country)
753 || $self->ut_zip('zip', $self->country)
755 return $error if $error;
758 last first company address1 address2 city county state zip
759 country daytime night fax
762 if ( defined $self->dbdef_table->column('ship_last') ) {
763 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
765 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
769 $self->ut_name('ship_last')
770 || $self->ut_name('ship_first')
771 || $self->ut_textn('ship_company')
772 || $self->ut_text('ship_address1')
773 || $self->ut_textn('ship_address2')
774 || $self->ut_text('ship_city')
775 || $self->ut_textn('ship_county')
776 || $self->ut_textn('ship_state')
777 || $self->ut_country('ship_country')
779 return $error if $error;
781 #false laziness with above
782 unless ( qsearchs('cust_main_county', {
783 'country' => $self->ship_country,
786 return "Unknown ship_state/ship_county/ship_country: ".
787 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
788 unless qsearchs('cust_main_county',{
789 'state' => $self->ship_state,
790 'county' => $self->ship_county,
791 'country' => $self->ship_country,
797 $self->ut_phonen('ship_daytime', $self->ship_country)
798 || $self->ut_phonen('ship_night', $self->ship_country)
799 || $self->ut_phonen('ship_fax', $self->ship_country)
800 || $self->ut_zip('ship_zip', $self->ship_country)
802 return $error if $error;
804 } else { # ship_ info eq billing info, so don't store dup info in database
805 $self->setfield("ship_$_", '')
806 foreach qw( last first company address1 address2 city county state zip
807 country daytime night fax );
811 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
812 or return "Illegal payby: ". $self->payby;
815 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
817 my $payinfo = $self->payinfo;
819 $payinfo =~ /^(\d{13,16})$/
820 or return gettext('invalid_card'); # . ": ". $self->payinfo;
822 $self->payinfo($payinfo);
824 or return gettext('invalid_card'); # . ": ". $self->payinfo;
825 return gettext('unknown_card_type')
826 if cardtype($self->payinfo) eq "Unknown";
827 if ( defined $self->dbdef_table->column('paycvv') ) {
828 if ( length($self->paycvv) ) {
829 if ( cardtype($self->payinfo) eq 'American Express card' ) {
830 $self->paycvv =~ /^(\d{4})$/
831 or return "CVV2 (CID) for American Express cards is four digits.";
834 $self->paycvv =~ /^(\d{3})$/
835 or return "CVV2 (CVC2/CID) is three digits.";
843 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
845 my $payinfo = $self->payinfo;
846 $payinfo =~ s/[^\d\@]//g;
847 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
849 $self->payinfo($payinfo);
850 $self->paycvv('') if $self->dbdef_table->column('paycvv');
852 } elsif ( $self->payby eq 'LECB' ) {
854 my $payinfo = $self->payinfo;
856 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
858 $self->payinfo($payinfo);
859 $self->paycvv('') if $self->dbdef_table->column('paycvv');
861 } elsif ( $self->payby eq 'BILL' ) {
863 $error = $self->ut_textn('payinfo');
864 return "Illegal P.O. number: ". $self->payinfo if $error;
865 $self->paycvv('') if $self->dbdef_table->column('paycvv');
867 } elsif ( $self->payby eq 'COMP' ) {
869 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
870 return "You are not permitted to create complimentary accounts."
871 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
874 $error = $self->ut_textn('payinfo');
875 return "Illegal comp account issuer: ". $self->payinfo if $error;
876 $self->paycvv('') if $self->dbdef_table->column('paycvv');
878 } elsif ( $self->payby eq 'PREPAY' ) {
880 my $payinfo = $self->payinfo;
881 $payinfo =~ s/\W//g; #anything else would just confuse things
882 $self->payinfo($payinfo);
883 $error = $self->ut_alpha('payinfo');
884 return "Illegal prepayment identifier: ". $self->payinfo if $error;
885 return "Unknown prepayment identifier"
886 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
887 $self->paycvv('') if $self->dbdef_table->column('paycvv');
891 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
892 return "Expriation date required"
893 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
897 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
898 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
899 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
900 ( $m, $y ) = ( $3, "20$2" );
902 return "Illegal expiration date: ". $self->paydate;
904 $self->paydate("$y-$m-01");
905 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
906 return gettext('expired_card')
907 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
910 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
911 ( ! $conf->exists('require_cardname')
912 || $self->payby !~ /^(CARD|DCRD)$/ )
914 $self->payname( $self->first. " ". $self->getfield('last') );
916 $self->payname =~ /^([\w \,\.\-\']+)$/
917 or return gettext('illegal_name'). " payname: ". $self->payname;
921 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
924 $self->otaker(getotaker) unless $self->otaker;
926 #warn "AFTER: \n". $self->_dump;
933 Returns all packages (see L<FS::cust_pkg>) for this customer.
939 if ( $self->{'_pkgnum'} ) {
940 values %{ $self->{'_pkgnum'}->cache };
942 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
946 =item ncancelled_pkgs
948 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
952 sub ncancelled_pkgs {
954 if ( $self->{'_pkgnum'} ) {
955 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
957 @{ [ # force list context
958 qsearch( 'cust_pkg', {
959 'custnum' => $self->custnum,
962 qsearch( 'cust_pkg', {
963 'custnum' => $self->custnum,
972 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
978 grep { $_->susp } $self->ncancelled_pkgs;
981 =item unflagged_suspended_pkgs
983 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
984 customer (thouse packages without the `manual_flag' set).
988 sub unflagged_suspended_pkgs {
990 return $self->suspended_pkgs
991 unless dbdef->table('cust_pkg')->column('manual_flag');
992 grep { ! $_->manual_flag } $self->suspended_pkgs;
995 =item unsuspended_pkgs
997 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1002 sub unsuspended_pkgs {
1004 grep { ! $_->susp } $self->ncancelled_pkgs;
1009 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1010 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1011 on success or a list of errors.
1017 grep { $_->unsuspend } $self->suspended_pkgs;
1022 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1023 Always returns a list: an empty list on success or a list of errors.
1029 grep { $_->suspend } $self->unsuspended_pkgs;
1032 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1034 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1035 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1036 success or a list of errors.
1040 sub suspend_if_pkgpart {
1043 grep { $_->suspend }
1044 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1045 $self->unsuspended_pkgs;
1048 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1050 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1051 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1052 on success or a list of errors.
1056 sub suspend_unless_pkgpart {
1059 grep { $_->suspend }
1060 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1061 $self->unsuspended_pkgs;
1064 =item cancel [ OPTION => VALUE ... ]
1066 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1068 Available options are: I<quiet>
1070 I<quiet> can be set true to supress email cancellation notices.
1072 Always returns a list: an empty list on success or a list of errors.
1078 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1083 Returns the agent (see L<FS::agent>) for this customer.
1089 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1094 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1095 conjunction with the collect method.
1097 Options are passed as name-value pairs.
1099 Currently available options are:
1101 resetup - if set true, re-charges setup fees.
1103 time - bills the customer as if it were that time. Specified as a UNIX
1104 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1105 L<Date::Parse> for conversion functions. For example:
1109 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1112 If there is an error, returns the error, otherwise returns false.
1117 my( $self, %options ) = @_;
1118 my $time = $options{'time'} || time;
1123 local $SIG{HUP} = 'IGNORE';
1124 local $SIG{INT} = 'IGNORE';
1125 local $SIG{QUIT} = 'IGNORE';
1126 local $SIG{TERM} = 'IGNORE';
1127 local $SIG{TSTP} = 'IGNORE';
1128 local $SIG{PIPE} = 'IGNORE';
1130 my $oldAutoCommit = $FS::UID::AutoCommit;
1131 local $FS::UID::AutoCommit = 0;
1134 $self->select_for_update; #mutex
1136 # find the packages which are due for billing, find out how much they are
1137 # & generate invoice database.
1139 my( $total_setup, $total_recur ) = ( 0, 0 );
1140 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1141 my @cust_bill_pkg = ();
1143 #my $taxable_charged = 0;##
1148 foreach my $cust_pkg (
1149 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1152 #NO!! next if $cust_pkg->cancel;
1153 next if $cust_pkg->getfield('cancel');
1155 #? to avoid use of uninitialized value errors... ?
1156 $cust_pkg->setfield('bill', '')
1157 unless defined($cust_pkg->bill);
1159 my $part_pkg = $cust_pkg->part_pkg;
1161 #so we don't modify cust_pkg record unnecessarily
1162 my $cust_pkg_mod_flag = 0;
1163 my %hash = $cust_pkg->hash;
1164 my $old_cust_pkg = new FS::cust_pkg \%hash;
1170 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1171 my $setup_prog = $part_pkg->getfield('setup');
1172 $setup_prog =~ /^(.*)$/ or do {
1173 $dbh->rollback if $oldAutoCommit;
1174 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1178 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1180 #my $cpt = new Safe;
1181 ##$cpt->permit(); #what is necessary?
1182 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1183 #$setup = $cpt->reval($setup_prog);
1184 $setup = eval $setup_prog;
1185 unless ( defined($setup) ) {
1186 $dbh->rollback if $oldAutoCommit;
1187 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1188 "(expression $setup_prog): $@";
1190 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1191 $cust_pkg_mod_flag=1;
1197 if ( $part_pkg->getfield('freq') ne '0' &&
1198 ! $cust_pkg->getfield('susp') &&
1199 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1201 my $recur_prog = $part_pkg->getfield('recur');
1202 $recur_prog =~ /^(.*)$/ or do {
1203 $dbh->rollback if $oldAutoCommit;
1204 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1208 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1210 # shared with $recur_prog
1211 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1213 #my $cpt = new Safe;
1214 ##$cpt->permit(); #what is necessary?
1215 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1216 #$recur = $cpt->reval($recur_prog);
1217 $recur = eval $recur_prog;
1218 unless ( defined($recur) ) {
1219 $dbh->rollback if $oldAutoCommit;
1220 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1221 "(expression $recur_prog): $@";
1223 #change this bit to use Date::Manip? CAREFUL with timezones (see
1224 # mailing list archive)
1225 my ($sec,$min,$hour,$mday,$mon,$year) =
1226 (localtime($sdate) )[0,1,2,3,4,5];
1228 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1229 # only for figuring next bill date, nothing else, so, reset $sdate again
1231 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1232 $cust_pkg->last_bill($sdate)
1233 if $cust_pkg->dbdef_table->column('last_bill');
1235 if ( $part_pkg->freq =~ /^\d+$/ ) {
1236 $mon += $part_pkg->freq;
1237 until ( $mon < 12 ) { $mon -= 12; $year++; }
1238 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1240 $mday += $weeks * 7;
1241 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1245 $dbh->rollback if $oldAutoCommit;
1246 return "unparsable frequency: ". $part_pkg->freq;
1248 $cust_pkg->setfield('bill',
1249 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1250 $cust_pkg_mod_flag = 1;
1253 warn "\$setup is undefined" unless defined($setup);
1254 warn "\$recur is undefined" unless defined($recur);
1255 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1257 if ( $cust_pkg_mod_flag ) {
1258 $error=$cust_pkg->replace($old_cust_pkg);
1259 if ( $error ) { #just in case
1260 $dbh->rollback if $oldAutoCommit;
1261 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1263 $setup = sprintf( "%.2f", $setup );
1264 $recur = sprintf( "%.2f", $recur );
1265 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1266 $dbh->rollback if $oldAutoCommit;
1267 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1269 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1270 $dbh->rollback if $oldAutoCommit;
1271 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1273 if ( $setup != 0 || $recur != 0 ) {
1274 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1275 'pkgnum' => $cust_pkg->pkgnum,
1279 'edate' => $cust_pkg->bill,
1280 'details' => \@details,
1282 push @cust_bill_pkg, $cust_bill_pkg;
1283 $total_setup += $setup;
1284 $total_recur += $recur;
1286 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1288 my @taxes = qsearch( 'cust_main_county', {
1289 'state' => $self->state,
1290 'county' => $self->county,
1291 'country' => $self->country,
1292 'taxclass' => $part_pkg->taxclass,
1295 @taxes = qsearch( 'cust_main_county', {
1296 'state' => $self->state,
1297 'county' => $self->county,
1298 'country' => $self->country,
1303 #one more try at a whole-country tax rate
1305 @taxes = qsearch( 'cust_main_county', {
1308 'country' => $self->country,
1313 # maybe eliminate this entirely, along with all the 0% records
1315 $dbh->rollback if $oldAutoCommit;
1317 "fatal: can't find tax rate for state/county/country/taxclass ".
1318 join('/', ( map $self->$_(), qw(state county country) ),
1319 $part_pkg->taxclass ). "\n";
1322 foreach my $tax ( @taxes ) {
1324 my $taxable_charged = 0;
1325 $taxable_charged += $setup
1326 unless $part_pkg->setuptax =~ /^Y$/i
1327 || $tax->setuptax =~ /^Y$/i;
1328 $taxable_charged += $recur
1329 unless $part_pkg->recurtax =~ /^Y$/i
1330 || $tax->recurtax =~ /^Y$/i;
1331 next unless $taxable_charged;
1333 if ( $tax->exempt_amount > 0 ) {
1334 my ($mon,$year) = (localtime($sdate) )[4,5];
1336 my $freq = $part_pkg->freq || 1;
1337 if ( $freq !~ /(\d+)$/ ) {
1338 $dbh->rollback if $oldAutoCommit;
1339 return "daily/weekly package definitions not (yet?)".
1340 " compatible with monthly tax exemptions";
1342 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1343 foreach my $which_month ( 1 .. $freq ) {
1345 'custnum' => $self->custnum,
1346 'taxnum' => $tax->taxnum,
1347 'year' => 1900+$year,
1350 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1351 until ( $mon < 13 ) { $mon -= 12; $year++; }
1352 my $cust_tax_exempt =
1353 qsearchs('cust_tax_exempt', \%hash)
1354 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1355 my $remaining_exemption = sprintf("%.2f",
1356 $tax->exempt_amount - $cust_tax_exempt->amount );
1357 if ( $remaining_exemption > 0 ) {
1358 my $addl = $remaining_exemption > $taxable_per_month
1359 ? $taxable_per_month
1360 : $remaining_exemption;
1361 $taxable_charged -= $addl;
1362 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1363 $cust_tax_exempt->hash,
1365 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1367 $error = $new_cust_tax_exempt->exemptnum
1368 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1369 : $new_cust_tax_exempt->insert;
1371 $dbh->rollback if $oldAutoCommit;
1372 return "fatal: can't update cust_tax_exempt: $error";
1375 } # if $remaining_exemption > 0
1377 } #foreach $which_month
1379 } #if $tax->exempt_amount
1381 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1383 #$tax += $taxable_charged * $cust_main_county->tax / 100
1384 $tax{ $tax->taxname || 'Tax' } +=
1385 $taxable_charged * $tax->tax / 100
1387 } #foreach my $tax ( @taxes )
1389 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1391 } #if $setup != 0 || $recur != 0
1393 } #if $cust_pkg_mod_flag
1395 } #foreach my $cust_pkg
1397 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1398 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1400 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1401 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1405 # unless ( $self->tax =~ /Y/i
1406 # || $self->payby eq 'COMP'
1407 # || $taxable_charged == 0 ) {
1408 # my $cust_main_county = qsearchs('cust_main_county',{
1409 # 'state' => $self->state,
1410 # 'county' => $self->county,
1411 # 'country' => $self->country,
1412 # } ) or die "fatal: can't find tax rate for state/county/country ".
1413 # $self->state. "/". $self->county. "/". $self->country. "\n";
1414 # my $tax = sprintf( "%.2f",
1415 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1418 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1420 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1421 my $tax = sprintf("%.2f", $tax{$taxname} );
1422 $charged = sprintf( "%.2f", $charged+$tax );
1424 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1430 'itemdesc' => $taxname,
1432 push @cust_bill_pkg, $cust_bill_pkg;
1435 } else { #1.4 schema
1438 foreach ( values %tax ) { $tax += $_ };
1439 $tax = sprintf("%.2f", $tax);
1441 $charged = sprintf( "%.2f", $charged+$tax );
1443 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1450 push @cust_bill_pkg, $cust_bill_pkg;
1455 my $cust_bill = new FS::cust_bill ( {
1456 'custnum' => $self->custnum,
1458 'charged' => $charged,
1460 $error = $cust_bill->insert;
1462 $dbh->rollback if $oldAutoCommit;
1463 return "can't create invoice for customer #". $self->custnum. ": $error";
1466 my $invnum = $cust_bill->invnum;
1468 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1470 $cust_bill_pkg->invnum($invnum);
1471 $error = $cust_bill_pkg->insert;
1473 $dbh->rollback if $oldAutoCommit;
1474 return "can't create invoice line item for customer #". $self->custnum.
1479 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1483 =item collect OPTIONS
1485 (Attempt to) collect money for this customer's outstanding invoices (see
1486 L<FS::cust_bill>). Usually used after the bill method.
1488 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1489 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1490 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1492 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1493 and the invoice events web interface.
1495 If there is an error, returns the error, otherwise returns false.
1497 Options are passed as name-value pairs.
1499 Currently available options are:
1501 invoice_time - Use this time when deciding when to print invoices and
1502 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>
1503 for conversion functions.
1505 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1508 retry_card - Deprecated alias for 'retry'
1510 batch_card - This option is deprecated. See the invoice events web interface
1511 to control whether cards are batched or run against a realtime gateway.
1513 report_badcard - This option is deprecated.
1515 force_print - This option is deprecated; see the invoice events web interface.
1517 quiet - set true to surpress email card/ACH decline notices.
1522 my( $self, %options ) = @_;
1523 my $invoice_time = $options{'invoice_time'} || time;
1526 local $SIG{HUP} = 'IGNORE';
1527 local $SIG{INT} = 'IGNORE';
1528 local $SIG{QUIT} = 'IGNORE';
1529 local $SIG{TERM} = 'IGNORE';
1530 local $SIG{TSTP} = 'IGNORE';
1531 local $SIG{PIPE} = 'IGNORE';
1533 my $oldAutoCommit = $FS::UID::AutoCommit;
1534 local $FS::UID::AutoCommit = 0;
1537 $self->select_for_update; #mutex
1539 my $balance = $self->balance;
1540 warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1541 unless ( $balance > 0 ) { #redundant?????
1542 $dbh->rollback if $oldAutoCommit; #hmm
1546 if ( exists($options{'retry_card'}) ) {
1547 carp 'retry_card option passed to collect is deprecated; use retry';
1548 $options{'retry'} ||= $options{'retry_card'};
1550 if ( exists($options{'retry'}) && $options{'retry'} ) {
1551 my $error = $self->retry_realtime;
1553 $dbh->rollback if $oldAutoCommit;
1558 foreach my $cust_bill ( $self->open_cust_bill ) {
1560 # don't try to charge for the same invoice if it's already in a batch
1561 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1563 last if $self->balance <= 0;
1565 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1568 foreach my $part_bill_event (
1569 sort { $a->seconds <=> $b->seconds
1570 || $a->weight <=> $b->weight
1571 || $a->eventpart <=> $b->eventpart }
1572 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1573 && ! qsearch( 'cust_bill_event', {
1574 'invnum' => $cust_bill->invnum,
1575 'eventpart' => $_->eventpart,
1579 qsearch('part_bill_event', { 'payby' => $self->payby,
1580 'disabled' => '', } )
1583 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1584 || $self->balance <= 0; # or if balance<=0
1586 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1588 my $cust_main = $self; #for callback
1592 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1593 $error = eval $part_bill_event->eventcode;
1597 my $statustext = '';
1601 } elsif ( $error ) {
1603 $statustext = $error;
1608 #add cust_bill_event
1609 my $cust_bill_event = new FS::cust_bill_event {
1610 'invnum' => $cust_bill->invnum,
1611 'eventpart' => $part_bill_event->eventpart,
1612 #'_date' => $invoice_time,
1614 'status' => $status,
1615 'statustext' => $statustext,
1617 $error = $cust_bill_event->insert;
1619 #$dbh->rollback if $oldAutoCommit;
1620 #return "error: $error";
1622 # gah, even with transactions.
1623 $dbh->commit if $oldAutoCommit; #well.
1624 my $e = 'WARNING: Event run but database not updated - '.
1625 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1626 ', eventpart '. $part_bill_event->eventpart.
1637 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1642 =item retry_realtime
1644 Schedules realtime credit card / electronic check / LEC billing events for
1645 for retry. Useful if card information has changed or manual retry is desired.
1646 The 'collect' method must be called to actually retry the transaction.
1648 Implementation details: For each of this customer's open invoices, changes
1649 the status of the first "done" (with statustext error) realtime processing
1654 sub retry_realtime {
1657 local $SIG{HUP} = 'IGNORE';
1658 local $SIG{INT} = 'IGNORE';
1659 local $SIG{QUIT} = 'IGNORE';
1660 local $SIG{TERM} = 'IGNORE';
1661 local $SIG{TSTP} = 'IGNORE';
1662 local $SIG{PIPE} = 'IGNORE';
1664 my $oldAutoCommit = $FS::UID::AutoCommit;
1665 local $FS::UID::AutoCommit = 0;
1668 foreach my $cust_bill (
1669 grep { $_->cust_bill_event }
1670 $self->open_cust_bill
1672 my @cust_bill_event =
1673 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1675 #$_->part_bill_event->plan eq 'realtime-card'
1676 $_->part_bill_event->eventcode =~
1677 /\$cust_bill\->realtime_(card|ach|lec)/
1678 && $_->status eq 'done'
1681 $cust_bill->cust_bill_event;
1682 next unless @cust_bill_event;
1683 my $error = $cust_bill_event[0]->retry;
1685 $dbh->rollback if $oldAutoCommit;
1686 return "error scheduling invoice event for retry: $error";
1691 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1696 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1698 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1699 via a Business::OnlinePayment realtime gateway. See
1700 L<http://420.am/business-onlinepayment> for supported gateways.
1702 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1704 Available options are: I<description>, I<invnum>, I<quiet>
1706 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1707 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1708 if set, will override the value from the customer record.
1710 I<description> is a free-text field passed to the gateway. It defaults to
1711 "Internet services".
1713 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1714 specified invoice. If you don't specify an I<invnum> you might want to
1715 call the B<apply_payments> method.
1717 I<quiet> can be set true to surpress email decline notices.
1719 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1724 my( $self, $method, $amount, %options ) = @_;
1726 warn "$self $method $amount\n";
1727 warn " $_ => $options{$_}\n" foreach keys %options;
1730 $options{'description'} ||= 'Internet services';
1733 die "Real-time processing not enabled\n"
1734 unless $conf->exists('business-onlinepayment');
1735 eval "use Business::OnlinePayment";
1739 $self->set( $_ => $options{$_} )
1740 foreach grep { exists($options{$_}) }
1741 qw( payname address1 address2 city state zip payinfo paydate paycvv);
1744 my $bop_config = 'business-onlinepayment';
1745 $bop_config .= '-ach'
1746 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1747 my ( $processor, $login, $password, $action, @bop_options ) =
1748 $conf->config($bop_config);
1749 $action ||= 'normal authorization';
1750 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1751 die "No real-time processor is enabled - ".
1752 "did you set the business-onlinepayment configuration value?\n"
1757 my $address = $self->address1;
1758 $address .= ", ". $self->address2 if $self->address2;
1760 my($payname, $payfirst, $paylast);
1761 if ( $self->payname && $method ne 'ECHECK' ) {
1762 $payname = $self->payname;
1763 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1764 or return "Illegal payname $payname";
1765 ($payfirst, $paylast) = ($1, $2);
1767 $payfirst = $self->getfield('first');
1768 $paylast = $self->getfield('last');
1769 $payname = "$payfirst $paylast";
1772 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1773 if ( $conf->exists('emailinvoiceauto')
1774 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1775 push @invoicing_list, $self->all_emails;
1777 my $email = $invoicing_list[0];
1780 if ( $method eq 'CC' ) {
1782 $content{card_number} = $self->payinfo;
1783 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1784 $content{expiration} = "$2/$1";
1786 $content{cvv2} = $self->paycvv
1787 if defined $self->dbdef_table->column('paycvv')
1788 && length($self->paycvv);
1790 $content{recurring_billing} = 'YES'
1791 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1793 'payinfo' => $self->payinfo, } );
1795 } elsif ( $method eq 'ECHECK' ) {
1796 my($account_number,$routing_code) = $self->payinfo;
1797 ( $content{account_number}, $content{routing_code} ) =
1798 split('@', $self->payinfo);
1799 $content{bank_name} = $self->payname;
1800 $content{account_type} = 'CHECKING';
1801 $content{account_name} = $payname;
1802 $content{customer_org} = $self->company ? 'B' : 'I';
1803 $content{customer_ssn} = $self->ss;
1804 } elsif ( $method eq 'LEC' ) {
1805 $content{phone} = $self->payinfo;
1810 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1812 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1813 $transaction->content(
1816 'password' => $password,
1817 'action' => $action1,
1818 'description' => $options{'description'},
1819 'amount' => $amount,
1820 'invoice_number' => $options{'invnum'},
1821 'customer_id' => $self->custnum,
1822 'last_name' => $paylast,
1823 'first_name' => $payfirst,
1825 'address' => $address,
1826 'city' => $self->city,
1827 'state' => $self->state,
1828 'zip' => $self->zip,
1829 'country' => $self->country,
1830 'referer' => 'http://cleanwhisker.420.am/',
1832 'phone' => $self->daytime || $self->night,
1835 $transaction->submit();
1837 if ( $transaction->is_success() && $action2 ) {
1838 my $auth = $transaction->authorization;
1839 my $ordernum = $transaction->can('order_number')
1840 ? $transaction->order_number
1844 new Business::OnlinePayment( $processor, @bop_options );
1851 password => $password,
1852 order_number => $ordernum,
1854 authorization => $auth,
1855 description => $options{'description'},
1858 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1859 transaction_sequence_num local_transaction_date
1860 local_transaction_time AVS_result_code )) {
1861 $capture{$field} = $transaction->$field() if $transaction->can($field);
1864 $capture->content( %capture );
1868 unless ( $capture->is_success ) {
1869 my $e = "Authorization sucessful but capture failed, custnum #".
1870 $self->custnum. ': '. $capture->result_code.
1871 ": ". $capture->error_message;
1878 #remove paycvv after initial transaction
1879 #false laziness w/misc/process/payment.cgi - check both to make sure working
1881 if ( defined $self->dbdef_table->column('paycvv')
1882 && length($self->paycvv)
1883 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1884 && ! length($options{'paycvv'})
1886 my $new = new FS::cust_main { $self->hash };
1888 my $error = $new->replace($self);
1890 warn "error removing cvv: $error\n";
1895 if ( $transaction->is_success() ) {
1897 my %method2payby = (
1903 my $paybatch = "$processor:". $transaction->authorization;
1904 $paybatch .= ':'. $transaction->order_number
1905 if $transaction->can('order_number')
1906 && length($transaction->order_number);
1908 my $cust_pay = new FS::cust_pay ( {
1909 'custnum' => $self->custnum,
1910 'invnum' => $options{'invnum'},
1913 'payby' => $method2payby{$method},
1914 'payinfo' => $self->payinfo,
1915 'paybatch' => $paybatch,
1917 my $error = $cust_pay->insert;
1919 $cust_pay->invnum(''); #try again with no specific invnum
1920 my $error2 = $cust_pay->insert;
1922 # gah, even with transactions.
1923 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1924 "error inserting payment ($processor): $error2".
1925 " (previously tried insert with invnum #$options{'invnum'}" .
1931 return ''; #no error
1935 my $perror = "$processor error: ". $transaction->error_message;
1937 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1938 && $conf->exists('emaildecline')
1939 && grep { $_ ne 'POST' } $self->invoicing_list
1940 && ! grep { $transaction->error_message =~ /$_/ }
1941 $conf->config('emaildecline-exclude')
1943 my @templ = $conf->config('declinetemplate');
1944 my $template = new Text::Template (
1946 SOURCE => [ map "$_\n", @templ ],
1947 ) or return "($perror) can't create template: $Text::Template::ERROR";
1948 $template->compile()
1949 or return "($perror) can't compile template: $Text::Template::ERROR";
1951 my $templ_hash = { error => $transaction->error_message };
1953 my $error = send_email(
1954 'from' => $conf->config('invoice_from'),
1955 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1956 'subject' => 'Your payment could not be processed',
1957 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1960 $perror .= " (also received error sending decline notification: $error)"
1970 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
1972 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
1973 via a Business::OnlinePayment realtime gateway. See
1974 L<http://420.am/business-onlinepayment> for supported gateways.
1976 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1978 Available options are: I<amount>, I<reason>, I<paynum>
1980 Most gateways require a reference to an original payment transaction to refund,
1981 so you probably need to specify a I<paynum>.
1983 I<amount> defaults to the original amount of the payment if not specified.
1985 I<reason> specifies a reason for the refund.
1987 Implementation note: If I<amount> is unspecified or equal to the amount of the
1988 orignal payment, first an attempt is made to "void" the transaction via
1989 the gateway (to cancel a not-yet settled transaction) and then if that fails,
1990 the normal attempt is made to "refund" ("credit") the transaction via the
1991 gateway is attempted.
1993 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1994 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1995 #if set, will override the value from the customer record.
1997 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
1998 #specified invoice. If you don't specify an I<invnum> you might want to
1999 #call the B<apply_payments> method.
2003 #some false laziness w/realtime_bop, not enough to make it worth merging
2004 #but some useful small subs should be pulled out
2005 sub realtime_refund_bop {
2006 my( $self, $method, %options ) = @_;
2008 warn "$self $method refund\n";
2009 warn " $_ => $options{$_}\n" foreach keys %options;
2013 die "Real-time processing not enabled\n"
2014 unless $conf->exists('business-onlinepayment');
2015 eval "use Business::OnlinePayment";
2019 #$self->set( $_ => $options{$_} )
2020 # foreach grep { exists($options{$_}) }
2021 # qw( payname address1 address2 city state zip payinfo paydate paycvv);
2024 my $bop_config = 'business-onlinepayment';
2025 $bop_config .= '-ach'
2026 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2027 my ( $processor, $login, $password, $unused_action, @bop_options ) =
2028 $conf->config($bop_config);
2029 #$action ||= 'normal authorization';
2030 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2031 die "No real-time processor is enabled - ".
2032 "did you set the business-onlinepayment configuration value?\n"
2036 my $amount = $options{'amount'};
2037 my( $pay_processor, $auth, $order_number );
2038 if ( $options{'paynum'} ) {
2039 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2040 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2041 or return "Unknown paynum $options{'paynum'}";
2042 $amount ||= $cust_pay->paid;
2043 $cust_pay->paybatch =~ /^(\w+):(\w+)(:(\w+))?$/
2044 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2045 $cust_pay->paybatch;
2046 ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2047 return "processor of payment $options{'paynum'} $pay_processor does not".
2048 " match current processor $processor"
2049 unless $pay_processor eq $processor;
2051 return "neither amount nor paynum specified" unless $amount;
2053 #first try void if applicable
2054 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2055 my $void = new Business::OnlinePayment( $processor, @bop_options );
2060 'password' => $password,
2061 'order_number' => $order_number,
2062 'amount' => $amount,
2063 'authorization' => $auth,
2064 'referer' => 'http://cleanwhisker.420.am/',
2067 if ( $void->is_success ) {
2068 my $error = $cust_pay->void($options{'reason'});
2070 # gah, even with transactions.
2071 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2072 "error voiding payment: $error";
2081 my $address = $self->address1;
2082 $address .= ", ". $self->address2 if $self->address2;
2084 my($payname, $payfirst, $paylast);
2085 if ( $self->payname && $method ne 'ECHECK' ) {
2086 $payname = $self->payname;
2087 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2088 or return "Illegal payname $payname";
2089 ($payfirst, $paylast) = ($1, $2);
2091 $payfirst = $self->getfield('first');
2092 $paylast = $self->getfield('last');
2093 $payname = "$payfirst $paylast";
2097 if ( $method eq 'CC' ) {
2099 $content{card_number} = $self->payinfo;
2100 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2101 $content{expiration} = "$2/$1";
2103 #$content{cvv2} = $self->paycvv
2104 # if defined $self->dbdef_table->column('paycvv')
2105 # && length($self->paycvv);
2107 #$content{recurring_billing} = 'YES'
2108 # if qsearch('cust_pay', { 'custnum' => $self->custnum,
2109 # 'payby' => 'CARD',
2110 # 'payinfo' => $self->payinfo, } );
2112 } elsif ( $method eq 'ECHECK' ) {
2113 my($account_number,$routing_code) = $self->payinfo;
2114 ( $content{account_number}, $content{routing_code} ) =
2115 split('@', $self->payinfo);
2116 $content{bank_name} = $self->payname;
2117 $content{account_type} = 'CHECKING';
2118 $content{account_name} = $payname;
2119 $content{customer_org} = $self->company ? 'B' : 'I';
2120 $content{customer_ssn} = $self->ss;
2121 } elsif ( $method eq 'LEC' ) {
2122 $content{phone} = $self->payinfo;
2126 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2129 'action' => 'credit',
2131 'password' => $password,
2132 'order_number' => $order_number,
2133 'amount' => $amount,
2134 'authorization' => $auth,
2135 'customer_id' => $self->custnum,
2136 'last_name' => $paylast,
2137 'first_name' => $payfirst,
2139 'address' => $address,
2140 'city' => $self->city,
2141 'state' => $self->state,
2142 'zip' => $self->zip,
2143 'country' => $self->country,
2144 'referer' => 'http://cleanwhisker.420.am/',
2149 return "$processor error: ". $refund->error_message
2150 unless $refund->is_success();
2152 my %method2payby = (
2158 my $paybatch = "$processor:". $refund->authorization;
2159 $paybatch .= ':'. $refund->order_number
2160 if $refund->can('order_number') && $refund->order_number;
2162 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2163 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2164 last unless @cust_bill_pay;
2165 my $cust_bill_pay = pop @cust_bill_pay;
2166 my $error = $cust_bill_pay->delete;
2170 my $cust_refund = new FS::cust_refund ( {
2171 'custnum' => $self->custnum,
2172 'paynum' => $options{'paynum'},
2173 'refund' => $amount,
2175 'payby' => $method2payby{$method},
2176 'payinfo' => $self->payinfo,
2177 'paybatch' => $paybatch,
2178 'reason' => $options{'reason'} || 'card refund',
2180 my $error = $cust_refund->insert;
2182 $cust_refund->paynum(''); #try again with no specific paynum
2183 my $error2 = $cust_refund->insert;
2185 # gah, even with transactions.
2186 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2187 "error inserting refund ($processor): $error2".
2188 " (previously tried insert with paynum #$options{'paynum'}" .
2201 Returns the total owed for this customer on all invoices
2202 (see L<FS::cust_bill/owed>).
2208 $self->total_owed_date(2145859200); #12/31/2037
2211 =item total_owed_date TIME
2213 Returns the total owed for this customer on all invoices with date earlier than
2214 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2215 see L<Time::Local> and L<Date::Parse> for conversion functions.
2219 sub total_owed_date {
2223 foreach my $cust_bill (
2224 grep { $_->_date <= $time }
2225 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2227 $total_bill += $cust_bill->owed;
2229 sprintf( "%.2f", $total_bill );
2232 =item apply_credits OPTION => VALUE ...
2234 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2235 to outstanding invoice balances in chronological order (or reverse
2236 chronological order if the I<order> option is set to B<newest>) and returns the
2237 value of any remaining unapplied credits available for refund (see
2238 L<FS::cust_refund>).
2246 return 0 unless $self->total_credited;
2248 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2249 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2251 my @invoices = $self->open_cust_bill;
2252 @invoices = sort { $b->_date <=> $a->_date } @invoices
2253 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2256 foreach my $cust_bill ( @invoices ) {
2259 if ( !defined($credit) || $credit->credited == 0) {
2260 $credit = pop @credits or last;
2263 if ($cust_bill->owed >= $credit->credited) {
2264 $amount=$credit->credited;
2266 $amount=$cust_bill->owed;
2269 my $cust_credit_bill = new FS::cust_credit_bill ( {
2270 'crednum' => $credit->crednum,
2271 'invnum' => $cust_bill->invnum,
2272 'amount' => $amount,
2274 my $error = $cust_credit_bill->insert;
2275 die $error if $error;
2277 redo if ($cust_bill->owed > 0);
2281 return $self->total_credited;
2284 =item apply_payments
2286 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2287 to outstanding invoice balances in chronological order.
2289 #and returns the value of any remaining unapplied payments.
2293 sub apply_payments {
2298 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2299 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2301 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2302 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2306 foreach my $cust_bill ( @invoices ) {
2309 if ( !defined($payment) || $payment->unapplied == 0 ) {
2310 $payment = pop @payments or last;
2313 if ( $cust_bill->owed >= $payment->unapplied ) {
2314 $amount = $payment->unapplied;
2316 $amount = $cust_bill->owed;
2319 my $cust_bill_pay = new FS::cust_bill_pay ( {
2320 'paynum' => $payment->paynum,
2321 'invnum' => $cust_bill->invnum,
2322 'amount' => $amount,
2324 my $error = $cust_bill_pay->insert;
2325 die $error if $error;
2327 redo if ( $cust_bill->owed > 0);
2331 return $self->total_unapplied_payments;
2334 =item total_credited
2336 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2337 customer. See L<FS::cust_credit/credited>.
2341 sub total_credited {
2343 my $total_credit = 0;
2344 foreach my $cust_credit ( qsearch('cust_credit', {
2345 'custnum' => $self->custnum,
2347 $total_credit += $cust_credit->credited;
2349 sprintf( "%.2f", $total_credit );
2352 =item total_unapplied_payments
2354 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2355 See L<FS::cust_pay/unapplied>.
2359 sub total_unapplied_payments {
2361 my $total_unapplied = 0;
2362 foreach my $cust_pay ( qsearch('cust_pay', {
2363 'custnum' => $self->custnum,
2365 $total_unapplied += $cust_pay->unapplied;
2367 sprintf( "%.2f", $total_unapplied );
2372 Returns the balance for this customer (total_owed minus total_credited
2373 minus total_unapplied_payments).
2380 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2384 =item balance_date TIME
2386 Returns the balance for this customer, only considering invoices with date
2387 earlier than TIME (total_owed_date minus total_credited minus
2388 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2389 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2398 $self->total_owed_date($time)
2399 - $self->total_credited
2400 - $self->total_unapplied_payments
2404 =item paydate_monthyear
2406 Returns a two-element list consisting of the month and year of this customer's
2407 paydate (credit card expiration date for CARD customers)
2411 sub paydate_monthyear {
2413 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2415 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2422 =item payinfo_masked
2424 Returns a "masked" payinfo field with all but the last four characters replaced
2425 by 'x'es. Useful for displaying credit cards.
2429 sub payinfo_masked {
2431 my $payinfo = $self->payinfo;
2432 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2435 =item invoicing_list [ ARRAYREF ]
2437 If an arguement is given, sets these email addresses as invoice recipients
2438 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2439 (except as warnings), so use check_invoicing_list first.
2441 Returns a list of email addresses (with svcnum entries expanded).
2443 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2444 check it without disturbing anything by passing nothing.
2446 This interface may change in the future.
2450 sub invoicing_list {
2451 my( $self, $arrayref ) = @_;
2453 my @cust_main_invoice;
2454 if ( $self->custnum ) {
2455 @cust_main_invoice =
2456 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2458 @cust_main_invoice = ();
2460 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2461 #warn $cust_main_invoice->destnum;
2462 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2463 #warn $cust_main_invoice->destnum;
2464 my $error = $cust_main_invoice->delete;
2465 warn $error if $error;
2468 if ( $self->custnum ) {
2469 @cust_main_invoice =
2470 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2472 @cust_main_invoice = ();
2474 my %seen = map { $_->address => 1 } @cust_main_invoice;
2475 foreach my $address ( @{$arrayref} ) {
2476 next if exists $seen{$address} && $seen{$address};
2477 $seen{$address} = 1;
2478 my $cust_main_invoice = new FS::cust_main_invoice ( {
2479 'custnum' => $self->custnum,
2482 my $error = $cust_main_invoice->insert;
2483 warn $error if $error;
2486 if ( $self->custnum ) {
2488 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2494 =item check_invoicing_list ARRAYREF
2496 Checks these arguements as valid input for the invoicing_list method. If there
2497 is an error, returns the error, otherwise returns false.
2501 sub check_invoicing_list {
2502 my( $self, $arrayref ) = @_;
2503 foreach my $address ( @{$arrayref} ) {
2504 my $cust_main_invoice = new FS::cust_main_invoice ( {
2505 'custnum' => $self->custnum,
2508 my $error = $self->custnum
2509 ? $cust_main_invoice->check
2510 : $cust_main_invoice->checkdest
2512 return $error if $error;
2517 =item set_default_invoicing_list
2519 Sets the invoicing list to all accounts associated with this customer,
2520 overwriting any previous invoicing list.
2524 sub set_default_invoicing_list {
2526 $self->invoicing_list($self->all_emails);
2531 Returns the email addresses of all accounts provisioned for this customer.
2538 foreach my $cust_pkg ( $self->all_pkgs ) {
2539 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2541 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2542 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2544 $list{$_}=1 foreach map { $_->email } @svc_acct;
2549 =item invoicing_list_addpost
2551 Adds postal invoicing to this customer. If this customer is already configured
2552 to receive postal invoices, does nothing.
2556 sub invoicing_list_addpost {
2558 return if grep { $_ eq 'POST' } $self->invoicing_list;
2559 my @invoicing_list = $self->invoicing_list;
2560 push @invoicing_list, 'POST';
2561 $self->invoicing_list(\@invoicing_list);
2564 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2566 Returns an array of customers referred by this customer (referral_custnum set
2567 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2568 customers referred by customers referred by this customer and so on, inclusive.
2569 The default behavior is DEPTH 1 (no recursion).
2573 sub referral_cust_main {
2575 my $depth = @_ ? shift : 1;
2576 my $exclude = @_ ? shift : {};
2579 map { $exclude->{$_->custnum}++; $_; }
2580 grep { ! $exclude->{ $_->custnum } }
2581 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2585 map { $_->referral_cust_main($depth-1, $exclude) }
2592 =item referral_cust_main_ncancelled
2594 Same as referral_cust_main, except only returns customers with uncancelled
2599 sub referral_cust_main_ncancelled {
2601 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2604 =item referral_cust_pkg [ DEPTH ]
2606 Like referral_cust_main, except returns a flat list of all unsuspended (and
2607 uncancelled) packages for each customer. The number of items in this list may
2608 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2612 sub referral_cust_pkg {
2614 my $depth = @_ ? shift : 1;
2616 map { $_->unsuspended_pkgs }
2617 grep { $_->unsuspended_pkgs }
2618 $self->referral_cust_main($depth);
2621 =item credit AMOUNT, REASON
2623 Applies a credit to this customer. If there is an error, returns the error,
2624 otherwise returns false.
2629 my( $self, $amount, $reason ) = @_;
2630 my $cust_credit = new FS::cust_credit {
2631 'custnum' => $self->custnum,
2632 'amount' => $amount,
2633 'reason' => $reason,
2635 $cust_credit->insert;
2638 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2640 Creates a one-time charge for this customer. If there is an error, returns
2641 the error, otherwise returns false.
2646 my ( $self, $amount ) = ( shift, shift );
2647 my $pkg = @_ ? shift : 'One-time charge';
2648 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2649 my $taxclass = @_ ? shift : '';
2651 local $SIG{HUP} = 'IGNORE';
2652 local $SIG{INT} = 'IGNORE';
2653 local $SIG{QUIT} = 'IGNORE';
2654 local $SIG{TERM} = 'IGNORE';
2655 local $SIG{TSTP} = 'IGNORE';
2656 local $SIG{PIPE} = 'IGNORE';
2658 my $oldAutoCommit = $FS::UID::AutoCommit;
2659 local $FS::UID::AutoCommit = 0;
2662 my $part_pkg = new FS::part_pkg ( {
2664 'comment' => $comment,
2669 'taxclass' => $taxclass,
2672 my $error = $part_pkg->insert;
2674 $dbh->rollback if $oldAutoCommit;
2678 my $pkgpart = $part_pkg->pkgpart;
2679 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2680 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2681 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2682 $error = $type_pkgs->insert;
2684 $dbh->rollback if $oldAutoCommit;
2689 my $cust_pkg = new FS::cust_pkg ( {
2690 'custnum' => $self->custnum,
2691 'pkgpart' => $pkgpart,
2694 $error = $cust_pkg->insert;
2696 $dbh->rollback if $oldAutoCommit;
2700 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2707 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2713 sort { $a->_date <=> $b->_date }
2714 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2717 =item open_cust_bill
2719 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2724 sub open_cust_bill {
2726 grep { $_->owed > 0 } $self->cust_bill;
2731 Returns all the credits (see L<FS::cust_credit>) for this customer.
2737 sort { $a->_date <=> $b->_date }
2738 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2743 Returns all the payments (see L<FS::cust_pay>) for this customer.
2749 sort { $a->_date <=> $b->_date }
2750 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2755 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2761 sort { $a->_date <=> $b->_date }
2762 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2768 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2774 sort { $a->_date <=> $b->_date }
2775 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2778 =item select_for_update
2780 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2785 sub select_for_update {
2787 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2792 Returns a name string for this customer, either "Company (Last, First)" or
2799 my $name = $self->get('last'). ', '. $self->first;
2800 $name = $self->company. " ($name)" if $self->company;
2806 Returns a status string for this customer, currently:
2810 =item prospect - No packages have ever been ordered
2812 =item active - One or more recurring packages is active
2814 =item suspended - All non-cancelled recurring packages are suspended
2816 =item cancelled - All recurring packages are cancelled
2824 for my $status (qw( prospect active suspended cancelled )) {
2825 my $method = $status.'_sql';
2826 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2827 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2828 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2829 return $status if $sth->fetchrow_arrayref->[0];
2835 Returns a hex triplet color string for this customer's status.
2840 'prospect' => '000000',
2841 'active' => '00CC00',
2842 'suspended' => 'FF9900',
2843 'cancelled' => 'FF0000',
2847 $statuscolor{$self->status};
2852 =head1 CLASS METHODS
2858 Returns an SQL expression identifying prospective cust_main records (customers
2859 with no packages ever ordered)
2863 sub prospect_sql { "
2864 0 = ( SELECT COUNT(*) FROM cust_pkg
2865 WHERE cust_pkg.custnum = cust_main.custnum
2871 Returns an SQL expression identifying active cust_main records.
2876 0 < ( SELECT COUNT(*) FROM cust_pkg
2877 WHERE cust_pkg.custnum = cust_main.custnum
2878 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2879 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2886 Returns an SQL expression identifying suspended cust_main records.
2890 sub suspended_sql { susp_sql(@_); }
2892 0 < ( SELECT COUNT(*) FROM cust_pkg
2893 WHERE cust_pkg.custnum = cust_main.custnum
2894 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2896 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2897 WHERE cust_pkg.custnum = cust_main.custnum
2898 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2905 Returns an SQL expression identifying cancelled cust_main records.
2909 sub cancelled_sql { cancel_sql(@_); }
2911 0 < ( SELECT COUNT(*) FROM cust_pkg
2912 WHERE cust_pkg.custnum = cust_main.custnum
2914 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2915 WHERE cust_pkg.custnum = cust_main.custnum
2916 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2926 =item check_and_rebuild_fuzzyfiles
2930 sub check_and_rebuild_fuzzyfiles {
2931 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2932 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2933 or &rebuild_fuzzyfiles;
2936 =item rebuild_fuzzyfiles
2940 sub rebuild_fuzzyfiles {
2942 use Fcntl qw(:flock);
2944 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2948 open(LASTLOCK,">>$dir/cust_main.last")
2949 or die "can't open $dir/cust_main.last: $!";
2950 flock(LASTLOCK,LOCK_EX)
2951 or die "can't lock $dir/cust_main.last: $!";
2953 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2955 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2956 if defined dbdef->table('cust_main')->column('ship_last');
2958 open (LASTCACHE,">$dir/cust_main.last.tmp")
2959 or die "can't open $dir/cust_main.last.tmp: $!";
2960 print LASTCACHE join("\n", @all_last), "\n";
2961 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2963 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2968 open(COMPANYLOCK,">>$dir/cust_main.company")
2969 or die "can't open $dir/cust_main.company: $!";
2970 flock(COMPANYLOCK,LOCK_EX)
2971 or die "can't lock $dir/cust_main.company: $!";
2973 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2975 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2976 if defined dbdef->table('cust_main')->column('ship_last');
2978 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2979 or die "can't open $dir/cust_main.company.tmp: $!";
2980 print COMPANYCACHE join("\n", @all_company), "\n";
2981 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2983 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2993 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2994 open(LASTCACHE,"<$dir/cust_main.last")
2995 or die "can't open $dir/cust_main.last: $!";
2996 my @array = map { chomp; $_; } <LASTCACHE>;
3006 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3007 open(COMPANYCACHE,"<$dir/cust_main.company")
3008 or die "can't open $dir/cust_main.last: $!";
3009 my @array = map { chomp; $_; } <COMPANYCACHE>;
3014 =item append_fuzzyfiles LASTNAME COMPANY
3018 sub append_fuzzyfiles {
3019 my( $last, $company ) = @_;
3021 &check_and_rebuild_fuzzyfiles;
3023 use Fcntl qw(:flock);
3025 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3029 open(LAST,">>$dir/cust_main.last")
3030 or die "can't open $dir/cust_main.last: $!";
3032 or die "can't lock $dir/cust_main.last: $!";
3034 print LAST "$last\n";
3037 or die "can't unlock $dir/cust_main.last: $!";
3043 open(COMPANY,">>$dir/cust_main.company")
3044 or die "can't open $dir/cust_main.company: $!";
3045 flock(COMPANY,LOCK_EX)
3046 or die "can't lock $dir/cust_main.company: $!";
3048 print COMPANY "$company\n";
3050 flock(COMPANY,LOCK_UN)
3051 or die "can't unlock $dir/cust_main.company: $!";
3065 #warn join('-',keys %$param);
3066 my $fh = $param->{filehandle};
3067 my $agentnum = $param->{agentnum};
3068 my $refnum = $param->{refnum};
3069 my $pkgpart = $param->{pkgpart};
3070 my @fields = @{$param->{fields}};
3072 eval "use Date::Parse;";
3074 eval "use Text::CSV_XS;";
3077 my $csv = new Text::CSV_XS;
3084 local $SIG{HUP} = 'IGNORE';
3085 local $SIG{INT} = 'IGNORE';
3086 local $SIG{QUIT} = 'IGNORE';
3087 local $SIG{TERM} = 'IGNORE';
3088 local $SIG{TSTP} = 'IGNORE';
3089 local $SIG{PIPE} = 'IGNORE';
3091 my $oldAutoCommit = $FS::UID::AutoCommit;
3092 local $FS::UID::AutoCommit = 0;
3095 #while ( $columns = $csv->getline($fh) ) {
3097 while ( defined($line=<$fh>) ) {
3099 $csv->parse($line) or do {
3100 $dbh->rollback if $oldAutoCommit;
3101 return "can't parse: ". $csv->error_input();
3104 my @columns = $csv->fields();
3105 #warn join('-',@columns);
3108 agentnum => $agentnum,
3110 country => $conf->config('countrydefault') || 'US',
3111 payby => 'BILL', #default
3112 paydate => '12/2037', #default
3114 my $billtime = time;
3115 my %cust_pkg = ( pkgpart => $pkgpart );
3116 foreach my $field ( @fields ) {
3117 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3118 #$cust_pkg{$1} = str2time( shift @$columns );
3119 if ( $1 eq 'setup' ) {
3120 $billtime = str2time(shift @columns);
3122 $cust_pkg{$1} = str2time( shift @columns );
3125 #$cust_main{$field} = shift @$columns;
3126 $cust_main{$field} = shift @columns;
3130 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3131 my $cust_main = new FS::cust_main ( \%cust_main );
3133 tie my %hash, 'Tie::RefHash'; #this part is important
3134 $hash{$cust_pkg} = [] if $pkgpart;
3135 my $error = $cust_main->insert( \%hash );
3138 $dbh->rollback if $oldAutoCommit;
3139 return "can't insert customer for $line: $error";
3142 #false laziness w/bill.cgi
3143 $error = $cust_main->bill( 'time' => $billtime );
3145 $dbh->rollback if $oldAutoCommit;
3146 return "can't bill customer for $line: $error";
3149 $cust_main->apply_payments;
3150 $cust_main->apply_credits;
3152 $error = $cust_main->collect();
3154 $dbh->rollback if $oldAutoCommit;
3155 return "can't collect customer for $line: $error";
3161 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3163 return "Empty file!" unless $imported;
3175 #warn join('-',keys %$param);
3176 my $fh = $param->{filehandle};
3177 my @fields = @{$param->{fields}};
3179 eval "use Date::Parse;";
3181 eval "use Text::CSV_XS;";
3184 my $csv = new Text::CSV_XS;
3191 local $SIG{HUP} = 'IGNORE';
3192 local $SIG{INT} = 'IGNORE';
3193 local $SIG{QUIT} = 'IGNORE';
3194 local $SIG{TERM} = 'IGNORE';
3195 local $SIG{TSTP} = 'IGNORE';
3196 local $SIG{PIPE} = 'IGNORE';
3198 my $oldAutoCommit = $FS::UID::AutoCommit;
3199 local $FS::UID::AutoCommit = 0;
3202 #while ( $columns = $csv->getline($fh) ) {
3204 while ( defined($line=<$fh>) ) {
3206 $csv->parse($line) or do {
3207 $dbh->rollback if $oldAutoCommit;
3208 return "can't parse: ". $csv->error_input();
3211 my @columns = $csv->fields();
3212 #warn join('-',@columns);
3215 foreach my $field ( @fields ) {
3216 $row{$field} = shift @columns;
3219 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3220 unless ( $cust_main ) {
3221 $dbh->rollback if $oldAutoCommit;
3222 return "unknown custnum $row{'custnum'}";
3225 if ( $row{'amount'} > 0 ) {
3226 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3228 $dbh->rollback if $oldAutoCommit;
3232 } elsif ( $row{'amount'} < 0 ) {
3233 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3236 $dbh->rollback if $oldAutoCommit;
3246 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3248 return "Empty file!" unless $imported;
3260 The delete method should possibly take an FS::cust_main object reference
3261 instead of a scalar customer number.
3263 Bill and collect options should probably be passed as references instead of a
3266 There should probably be a configuration file with a list of allowed credit
3269 No multiple currency support (probably a larger project than just this module).
3271 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3275 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3276 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3277 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.