4 use vars qw( @ISA $conf $DEBUG $import );
8 eval "use Time::Local;";
9 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
10 if $] < 5.006 && !defined($Time::Local::VERSION);
11 eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 use Business::CreditCard;
16 use FS::UID qw( getotaker dbh );
17 use FS::Record qw( qsearchs qsearch dbdef );
20 use FS::cust_bill_pkg;
24 use FS::part_referral;
25 use FS::cust_main_county;
27 use FS::cust_main_invoice;
28 use FS::cust_credit_bill;
29 use FS::cust_bill_pay;
30 use FS::prepay_credit;
33 use FS::part_bill_event;
34 use FS::cust_bill_event;
35 use FS::cust_tax_exempt;
37 use FS::Msgcat qw(gettext);
39 @ISA = qw( FS::Record );
46 #ask FS::UID to run this stuff for us later
47 $FS::UID::callback{'FS::cust_main'} = sub {
49 #yes, need it for stuff below (prolly should be cached)
54 my ( $hashref, $cache ) = @_;
55 if ( exists $hashref->{'pkgnum'} ) {
56 # #@{ $self->{'_pkgnum'} } = ();
57 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
58 $self->{'_pkgnum'} = $subcache;
59 #push @{ $self->{'_pkgnum'} },
60 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
66 FS::cust_main - Object methods for cust_main records
72 $record = new FS::cust_main \%hash;
73 $record = new FS::cust_main { 'column' => 'value' };
75 $error = $record->insert;
77 $error = $new_record->replace($old_record);
79 $error = $record->delete;
81 $error = $record->check;
83 @cust_pkg = $record->all_pkgs;
85 @cust_pkg = $record->ncancelled_pkgs;
87 @cust_pkg = $record->suspended_pkgs;
89 $error = $record->bill;
90 $error = $record->bill %options;
91 $error = $record->bill 'time' => $time;
93 $error = $record->collect;
94 $error = $record->collect %options;
95 $error = $record->collect 'invoice_time' => $time,
96 'batch_card' => 'yes',
97 'report_badcard' => 'yes',
102 An FS::cust_main object represents a customer. FS::cust_main inherits from
103 FS::Record. The following fields are currently supported:
107 =item custnum - primary key (assigned automatically for new customers)
109 =item agentnum - agent (see L<FS::agent>)
111 =item refnum - Advertising source (see L<FS::part_referral>)
117 =item ss - social security number (optional)
119 =item company - (optional)
123 =item address2 - (optional)
127 =item county - (optional, see L<FS::cust_main_county>)
129 =item state - (see L<FS::cust_main_county>)
133 =item country - (see L<FS::cust_main_county>)
135 =item daytime - phone (optional)
137 =item night - phone (optional)
139 =item fax - phone (optional)
141 =item ship_first - name
143 =item ship_last - name
145 =item ship_company - (optional)
149 =item ship_address2 - (optional)
153 =item ship_county - (optional, see L<FS::cust_main_county>)
155 =item ship_state - (see L<FS::cust_main_county>)
159 =item ship_country - (see L<FS::cust_main_county>)
161 =item ship_daytime - phone (optional)
163 =item ship_night - phone (optional)
165 =item ship_fax - phone (optional)
167 =item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
169 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
171 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
173 =item payname - name on card or billing name
175 =item tax - tax exempt, empty or `Y'
177 =item otaker - order taker (assigned automatically, see L<FS::UID>)
179 =item comments - comments (optional)
189 Creates a new customer. To add the customer to the database, see L<"insert">.
191 Note that this stores the hash reference, not a distinct copy of the hash it
192 points to. You can ask the object for a copy with the I<hash> method.
196 sub table { 'cust_main'; }
198 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
200 Adds this customer to the database. If there is an error, returns the error,
201 otherwise returns false.
203 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
204 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
205 are inserted atomicly, or the transaction is rolled back. Passing an empty
206 hash reference is equivalent to not supplying this parameter. There should be
207 a better explanation of this, but until then, here's an example:
210 tie %hash, 'Tie::RefHash'; #this part is important
212 $cust_pkg => [ $svc_acct ],
215 $cust_main->insert( \%hash );
217 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
218 be set as the invoicing list (see L<"invoicing_list">). Errors return as
219 expected and rollback the entire transaction; it is not necessary to call
220 check_invoicing_list first. The invoicing_list is set after the records in the
221 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
222 invoicing_list destination to the newly-created svc_acct. Here's an example:
224 $cust_main->insert( {}, [ $email, 'POST' ] );
226 Currently available options are: I<depend_jobnum> and I<noexport>.
228 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
229 on the supplied jobnum (they will not run until the specific job completes).
230 This can be used to defer provisioning until some action completes (such
231 as running the customer's credit card sucessfully).
233 The I<noexport> option is deprecated. If I<noexport> is set true, no
234 provisioning jobs (exports) are scheduled. (You can schedule them later with
235 the B<reexport> method.)
241 my $cust_pkgs = @_ ? shift : {};
242 my $invoicing_list = @_ ? shift : '';
244 warn "FS::cust_main::insert called with options ".
245 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
248 local $SIG{HUP} = 'IGNORE';
249 local $SIG{INT} = 'IGNORE';
250 local $SIG{QUIT} = 'IGNORE';
251 local $SIG{TERM} = 'IGNORE';
252 local $SIG{TSTP} = 'IGNORE';
253 local $SIG{PIPE} = 'IGNORE';
255 my $oldAutoCommit = $FS::UID::AutoCommit;
256 local $FS::UID::AutoCommit = 0;
261 if ( $self->payby eq 'PREPAY' ) {
262 $self->payby('BILL');
263 my $prepay_credit = qsearchs(
265 { 'identifier' => $self->payinfo },
269 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
270 unless $prepay_credit;
271 $amount = $prepay_credit->amount;
272 $seconds = $prepay_credit->seconds;
273 my $error = $prepay_credit->delete;
275 $dbh->rollback if $oldAutoCommit;
276 return "removing prepay_credit (transaction rolled back): $error";
280 my $error = $self->SUPER::insert;
282 $dbh->rollback if $oldAutoCommit;
283 #return "inserting cust_main record (transaction rolled back): $error";
288 if ( $invoicing_list ) {
289 $error = $self->check_invoicing_list( $invoicing_list );
291 $dbh->rollback if $oldAutoCommit;
292 return "checking invoicing_list (transaction rolled back): $error";
294 $self->invoicing_list( $invoicing_list );
298 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
300 $dbh->rollback if $oldAutoCommit;
305 $dbh->rollback if $oldAutoCommit;
306 return "No svc_acct record to apply pre-paid time";
310 my $cust_credit = new FS::cust_credit {
311 'custnum' => $self->custnum,
314 $error = $cust_credit->insert;
316 $dbh->rollback if $oldAutoCommit;
317 return "inserting credit (transaction rolled back): $error";
321 $error = $self->queue_fuzzyfiles_update;
323 $dbh->rollback if $oldAutoCommit;
324 return "updating fuzzy search cache: $error";
327 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
332 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
334 Like the insert method on an existing record, this method orders a package
335 and included services atomicaly. Pass a Tie::RefHash data structure to this
336 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
337 be a better explanation of this, but until then, here's an example:
340 tie %hash, 'Tie::RefHash'; #this part is important
342 $cust_pkg => [ $svc_acct ],
345 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
347 Currently available options are: I<depend_jobnum> and I<noexport>.
349 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
350 on the supplied jobnum (they will not run until the specific job completes).
351 This can be used to defer provisioning until some action completes (such
352 as running the customer's credit card sucessfully).
354 The I<noexport> option is deprecated. If I<noexport> is set true, no
355 provisioning jobs (exports) are scheduled. (You can schedule them later with
356 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
357 on the cust_main object is not recommended, as existing services will also be
364 my $cust_pkgs = shift;
367 my %svc_options = ();
368 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
369 if exists $options{'depend_jobnum'};
370 warn "FS::cust_main::order_pkgs called with options ".
371 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
374 local $SIG{HUP} = 'IGNORE';
375 local $SIG{INT} = 'IGNORE';
376 local $SIG{QUIT} = 'IGNORE';
377 local $SIG{TERM} = 'IGNORE';
378 local $SIG{TSTP} = 'IGNORE';
379 local $SIG{PIPE} = 'IGNORE';
381 my $oldAutoCommit = $FS::UID::AutoCommit;
382 local $FS::UID::AutoCommit = 0;
385 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
387 foreach my $cust_pkg ( keys %$cust_pkgs ) {
388 $cust_pkg->custnum( $self->custnum );
389 my $error = $cust_pkg->insert;
391 $dbh->rollback if $oldAutoCommit;
392 return "inserting cust_pkg (transaction rolled back): $error";
394 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
395 $svc_something->pkgnum( $cust_pkg->pkgnum );
396 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
397 $svc_something->seconds( $svc_something->seconds + $$seconds );
400 $error = $svc_something->insert(%svc_options);
402 $dbh->rollback if $oldAutoCommit;
403 #return "inserting svc_ (transaction rolled back): $error";
409 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
415 This method is deprecated. See the I<depend_jobnum> option to the insert and
416 order_pkgs methods for a better way to defer provisioning.
418 Re-schedules all exports by calling the B<reexport> method of all associated
419 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
420 otherwise returns false.
427 carp "warning: FS::cust_main::reexport is deprectated; ".
428 "use the depend_jobnum option to insert or order_pkgs to delay export";
430 local $SIG{HUP} = 'IGNORE';
431 local $SIG{INT} = 'IGNORE';
432 local $SIG{QUIT} = 'IGNORE';
433 local $SIG{TERM} = 'IGNORE';
434 local $SIG{TSTP} = 'IGNORE';
435 local $SIG{PIPE} = 'IGNORE';
437 my $oldAutoCommit = $FS::UID::AutoCommit;
438 local $FS::UID::AutoCommit = 0;
441 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
442 my $error = $cust_pkg->reexport;
444 $dbh->rollback if $oldAutoCommit;
449 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
454 =item delete NEW_CUSTNUM
456 This deletes the customer. If there is an error, returns the error, otherwise
459 This will completely remove all traces of the customer record. This is not
460 what you want when a customer cancels service; for that, cancel all of the
461 customer's packages (see L</cancel>).
463 If the customer has any uncancelled packages, you need to pass a new (valid)
464 customer number for those packages to be transferred to. Cancelled packages
465 will be deleted. Did I mention that this is NOT what you want when a customer
466 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
468 You can't delete a customer with invoices (see L<FS::cust_bill>),
469 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
470 refunds (see L<FS::cust_refund>).
477 local $SIG{HUP} = 'IGNORE';
478 local $SIG{INT} = 'IGNORE';
479 local $SIG{QUIT} = 'IGNORE';
480 local $SIG{TERM} = 'IGNORE';
481 local $SIG{TSTP} = 'IGNORE';
482 local $SIG{PIPE} = 'IGNORE';
484 my $oldAutoCommit = $FS::UID::AutoCommit;
485 local $FS::UID::AutoCommit = 0;
488 if ( $self->cust_bill ) {
489 $dbh->rollback if $oldAutoCommit;
490 return "Can't delete a customer with invoices";
492 if ( $self->cust_credit ) {
493 $dbh->rollback if $oldAutoCommit;
494 return "Can't delete a customer with credits";
496 if ( $self->cust_pay ) {
497 $dbh->rollback if $oldAutoCommit;
498 return "Can't delete a customer with payments";
500 if ( $self->cust_refund ) {
501 $dbh->rollback if $oldAutoCommit;
502 return "Can't delete a customer with refunds";
505 my @cust_pkg = $self->ncancelled_pkgs;
507 my $new_custnum = shift;
508 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
509 $dbh->rollback if $oldAutoCommit;
510 return "Invalid new customer number: $new_custnum";
512 foreach my $cust_pkg ( @cust_pkg ) {
513 my %hash = $cust_pkg->hash;
514 $hash{'custnum'} = $new_custnum;
515 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
516 my $error = $new_cust_pkg->replace($cust_pkg);
518 $dbh->rollback if $oldAutoCommit;
523 my @cancelled_cust_pkg = $self->all_pkgs;
524 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
525 my $error = $cust_pkg->delete;
527 $dbh->rollback if $oldAutoCommit;
532 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
533 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
535 my $error = $cust_main_invoice->delete;
537 $dbh->rollback if $oldAutoCommit;
542 my $error = $self->SUPER::delete;
544 $dbh->rollback if $oldAutoCommit;
548 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
553 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
555 Replaces the OLD_RECORD with this one in the database. If there is an error,
556 returns the error, otherwise returns false.
558 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
559 be set as the invoicing list (see L<"invoicing_list">). Errors return as
560 expected and rollback the entire transaction; it is not necessary to call
561 check_invoicing_list first. Here's an example:
563 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
572 local $SIG{HUP} = 'IGNORE';
573 local $SIG{INT} = 'IGNORE';
574 local $SIG{QUIT} = 'IGNORE';
575 local $SIG{TERM} = 'IGNORE';
576 local $SIG{TSTP} = 'IGNORE';
577 local $SIG{PIPE} = 'IGNORE';
579 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
580 && $conf->config('users-allow_comp') ) {
581 return "You are not permitted to create complimentary accounts."
582 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
585 my $oldAutoCommit = $FS::UID::AutoCommit;
586 local $FS::UID::AutoCommit = 0;
589 my $error = $self->SUPER::replace($old);
592 $dbh->rollback if $oldAutoCommit;
596 if ( @param ) { # INVOICING_LIST_ARYREF
597 my $invoicing_list = shift @param;
598 $error = $self->check_invoicing_list( $invoicing_list );
600 $dbh->rollback if $oldAutoCommit;
603 $self->invoicing_list( $invoicing_list );
606 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
607 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
608 # card/check/lec info has changed, want to retry realtime_ invoice events
609 my $error = $self->retry_realtime;
611 $dbh->rollback if $oldAutoCommit;
616 $error = $self->queue_fuzzyfiles_update;
618 $dbh->rollback if $oldAutoCommit;
619 return "updating fuzzy search cache: $error";
622 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
627 =item queue_fuzzyfiles_update
629 Used by insert & replace to update the fuzzy search cache
633 sub queue_fuzzyfiles_update {
636 local $SIG{HUP} = 'IGNORE';
637 local $SIG{INT} = 'IGNORE';
638 local $SIG{QUIT} = 'IGNORE';
639 local $SIG{TERM} = 'IGNORE';
640 local $SIG{TSTP} = 'IGNORE';
641 local $SIG{PIPE} = 'IGNORE';
643 my $oldAutoCommit = $FS::UID::AutoCommit;
644 local $FS::UID::AutoCommit = 0;
647 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
648 my $error = $queue->insert($self->getfield('last'), $self->company);
650 $dbh->rollback if $oldAutoCommit;
651 return "queueing job (transaction rolled back): $error";
654 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
655 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
656 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
658 $dbh->rollback if $oldAutoCommit;
659 return "queueing job (transaction rolled back): $error";
663 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
670 Checks all fields to make sure this is a valid customer record. If there is
671 an error, returns the error, otherwise returns false. Called by the insert
679 #warn "BEFORE: \n". $self->_dump;
682 $self->ut_numbern('custnum')
683 || $self->ut_number('agentnum')
684 || $self->ut_number('refnum')
685 || $self->ut_name('last')
686 || $self->ut_name('first')
687 || $self->ut_textn('company')
688 || $self->ut_text('address1')
689 || $self->ut_textn('address2')
690 || $self->ut_text('city')
691 || $self->ut_textn('county')
692 || $self->ut_textn('state')
693 || $self->ut_country('country')
694 || $self->ut_anything('comments')
695 || $self->ut_numbern('referral_custnum')
697 #barf. need message catalogs. i18n. etc.
698 $error .= "Please select an advertising source."
699 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
700 return $error if $error;
702 return "Unknown agent"
703 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
705 return "Unknown refnum"
706 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
708 return "Unknown referring custnum ". $self->referral_custnum
709 unless ! $self->referral_custnum
710 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
712 if ( $self->ss eq '' ) {
717 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
718 or return "Illegal social security number: ". $self->ss;
719 $self->ss("$1-$2-$3");
723 # bad idea to disable, causes billing to fail because of no tax rates later
724 # unless ( $import ) {
725 unless ( qsearch('cust_main_county', {
726 'country' => $self->country,
729 return "Unknown state/county/country: ".
730 $self->state. "/". $self->county. "/". $self->country
731 unless qsearch('cust_main_county',{
732 'state' => $self->state,
733 'county' => $self->county,
734 'country' => $self->country,
740 $self->ut_phonen('daytime', $self->country)
741 || $self->ut_phonen('night', $self->country)
742 || $self->ut_phonen('fax', $self->country)
743 || $self->ut_zip('zip', $self->country)
745 return $error if $error;
748 last first company address1 address2 city county state zip
749 country daytime night fax
752 if ( defined $self->dbdef_table->column('ship_last') ) {
753 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
755 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
759 $self->ut_name('ship_last')
760 || $self->ut_name('ship_first')
761 || $self->ut_textn('ship_company')
762 || $self->ut_text('ship_address1')
763 || $self->ut_textn('ship_address2')
764 || $self->ut_text('ship_city')
765 || $self->ut_textn('ship_county')
766 || $self->ut_textn('ship_state')
767 || $self->ut_country('ship_country')
769 return $error if $error;
771 #false laziness with above
772 unless ( qsearchs('cust_main_county', {
773 'country' => $self->ship_country,
776 return "Unknown ship_state/ship_county/ship_country: ".
777 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
778 unless qsearchs('cust_main_county',{
779 'state' => $self->ship_state,
780 'county' => $self->ship_county,
781 'country' => $self->ship_country,
787 $self->ut_phonen('ship_daytime', $self->ship_country)
788 || $self->ut_phonen('ship_night', $self->ship_country)
789 || $self->ut_phonen('ship_fax', $self->ship_country)
790 || $self->ut_zip('ship_zip', $self->ship_country)
792 return $error if $error;
794 } else { # ship_ info eq billing info, so don't store dup info in database
795 $self->setfield("ship_$_", '')
796 foreach qw( last first company address1 address2 city county state zip
797 country daytime night fax );
801 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
802 or return "Illegal payby: ". $self->payby;
805 if ( $self->payby eq 'CARD' ) {
807 my $payinfo = $self->payinfo;
809 $payinfo =~ /^(\d{13,16})$/
810 or return gettext('invalid_card'); # . ": ". $self->payinfo;
812 $self->payinfo($payinfo);
814 or return gettext('invalid_card'); # . ": ". $self->payinfo;
815 return gettext('unknown_card_type')
816 if cardtype($self->payinfo) eq "Unknown";
817 if ( defined $self->dbdef_table->column('paycvv') ) {
818 if ( length($self->paycvv) ) {
819 if ( cardtype($self->payinfo) eq 'American Express card' ) {
820 $self->paycvv =~ /^(\d{4})$/
821 or return "CVV2 (CID) for American Express cards is four digits.";
824 $self->paycvv =~ /^(\d{3})$/
825 or return "CVV2 (CVC2/CID) is three digits.";
833 } elsif ( $self->payby eq 'CHEK' ) {
835 my $payinfo = $self->payinfo;
836 $payinfo =~ s/[^\d\@]//g;
837 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
839 $self->payinfo($payinfo);
840 $self->paycvv('') if $self->dbdef_table->column('paycvv');
842 } elsif ( $self->payby eq 'LECB' ) {
844 my $payinfo = $self->payinfo;
846 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
848 $self->payinfo($payinfo);
849 $self->paycvv('') if $self->dbdef_table->column('paycvv');
851 } elsif ( $self->payby eq 'BILL' ) {
853 $error = $self->ut_textn('payinfo');
854 return "Illegal P.O. number: ". $self->payinfo if $error;
855 $self->paycvv('') if $self->dbdef_table->column('paycvv');
857 } elsif ( $self->payby eq 'COMP' ) {
859 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
860 return "You are not permitted to create complimentary accounts."
861 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
864 $error = $self->ut_textn('payinfo');
865 return "Illegal comp account issuer: ". $self->payinfo if $error;
866 $self->paycvv('') if $self->dbdef_table->column('paycvv');
868 } elsif ( $self->payby eq 'PREPAY' ) {
870 my $payinfo = $self->payinfo;
871 $payinfo =~ s/\W//g; #anything else would just confuse things
872 $self->payinfo($payinfo);
873 $error = $self->ut_alpha('payinfo');
874 return "Illegal prepayment identifier: ". $self->payinfo if $error;
875 return "Unknown prepayment identifier"
876 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
877 $self->paycvv('') if $self->dbdef_table->column('paycvv');
881 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
882 return "Expriation date required"
883 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
886 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
887 or return "Illegal expiration date: ". $self->paydate;
888 my $y = length($2) == 4 ? $2 : "20$2";
889 $self->paydate("$y-$1-01");
890 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
891 return gettext('expired_card')
892 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
895 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
896 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
897 $self->payname( $self->first. " ". $self->getfield('last') );
899 $self->payname =~ /^([\w \,\.\-\']+)$/
900 or return gettext('illegal_name'). " payname: ". $self->payname;
904 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
907 $self->otaker(getotaker) unless $self->otaker;
909 #warn "AFTER: \n". $self->_dump;
916 Returns all packages (see L<FS::cust_pkg>) for this customer.
922 if ( $self->{'_pkgnum'} ) {
923 values %{ $self->{'_pkgnum'}->cache };
925 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
929 =item ncancelled_pkgs
931 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
935 sub ncancelled_pkgs {
937 if ( $self->{'_pkgnum'} ) {
938 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
940 @{ [ # force list context
941 qsearch( 'cust_pkg', {
942 'custnum' => $self->custnum,
945 qsearch( 'cust_pkg', {
946 'custnum' => $self->custnum,
955 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
961 grep { $_->susp } $self->ncancelled_pkgs;
964 =item unflagged_suspended_pkgs
966 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
967 customer (thouse packages without the `manual_flag' set).
971 sub unflagged_suspended_pkgs {
973 return $self->suspended_pkgs
974 unless dbdef->table('cust_pkg')->column('manual_flag');
975 grep { ! $_->manual_flag } $self->suspended_pkgs;
978 =item unsuspended_pkgs
980 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
985 sub unsuspended_pkgs {
987 grep { ! $_->susp } $self->ncancelled_pkgs;
992 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
993 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
994 on success or a list of errors.
1000 grep { $_->unsuspend } $self->suspended_pkgs;
1005 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1006 Always returns a list: an empty list on success or a list of errors.
1012 grep { $_->suspend } $self->unsuspended_pkgs;
1015 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1017 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1018 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1019 success or a list of errors.
1023 sub suspend_if_pkgpart {
1026 grep { $_->suspend }
1027 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1028 $self->unsuspended_pkgs;
1031 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1033 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1034 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1035 on success or a list of errors.
1039 sub suspend_unless_pkgpart {
1042 grep { $_->suspend }
1043 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1044 $self->unsuspended_pkgs;
1047 =item cancel [ OPTION => VALUE ... ]
1049 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1051 Available options are: I<quiet>
1053 I<quiet> can be set true to supress email cancellation notices.
1055 Always returns a list: an empty list on success or a list of errors.
1061 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1066 Returns the agent (see L<FS::agent>) for this customer.
1072 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1077 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1078 conjunction with the collect method.
1080 Options are passed as name-value pairs.
1082 Currently available options are:
1084 resetup - if set true, re-charges setup fees.
1086 time - bills the customer as if it were that time. Specified as a UNIX
1087 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1088 L<Date::Parse> for conversion functions. For example:
1092 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1095 If there is an error, returns the error, otherwise returns false.
1100 my( $self, %options ) = @_;
1101 return '' if $self->payby eq 'COMP';
1102 my $time = $options{'time'} || time;
1107 local $SIG{HUP} = 'IGNORE';
1108 local $SIG{INT} = 'IGNORE';
1109 local $SIG{QUIT} = 'IGNORE';
1110 local $SIG{TERM} = 'IGNORE';
1111 local $SIG{TSTP} = 'IGNORE';
1112 local $SIG{PIPE} = 'IGNORE';
1114 my $oldAutoCommit = $FS::UID::AutoCommit;
1115 local $FS::UID::AutoCommit = 0;
1118 $self->select_for_update; #mutex
1120 # find the packages which are due for billing, find out how much they are
1121 # & generate invoice database.
1123 my( $total_setup, $total_recur ) = ( 0, 0 );
1124 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1125 my @cust_bill_pkg = ();
1127 #my $taxable_charged = 0;##
1132 foreach my $cust_pkg (
1133 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1136 #NO!! next if $cust_pkg->cancel;
1137 next if $cust_pkg->getfield('cancel');
1139 #? to avoid use of uninitialized value errors... ?
1140 $cust_pkg->setfield('bill', '')
1141 unless defined($cust_pkg->bill);
1143 my $part_pkg = $cust_pkg->part_pkg;
1145 #so we don't modify cust_pkg record unnecessarily
1146 my $cust_pkg_mod_flag = 0;
1147 my %hash = $cust_pkg->hash;
1148 my $old_cust_pkg = new FS::cust_pkg \%hash;
1152 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1153 my $setup_prog = $part_pkg->getfield('setup');
1154 $setup_prog =~ /^(.*)$/ or do {
1155 $dbh->rollback if $oldAutoCommit;
1156 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1160 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1162 #my $cpt = new Safe;
1163 ##$cpt->permit(); #what is necessary?
1164 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1165 #$setup = $cpt->reval($setup_prog);
1166 $setup = eval $setup_prog;
1167 unless ( defined($setup) ) {
1168 $dbh->rollback if $oldAutoCommit;
1169 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1170 "(expression $setup_prog): $@";
1172 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1173 $cust_pkg_mod_flag=1;
1179 if ( $part_pkg->getfield('freq') ne '0' &&
1180 ! $cust_pkg->getfield('susp') &&
1181 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1183 my $recur_prog = $part_pkg->getfield('recur');
1184 $recur_prog =~ /^(.*)$/ or do {
1185 $dbh->rollback if $oldAutoCommit;
1186 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1190 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1192 # shared with $recur_prog
1193 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1195 #my $cpt = new Safe;
1196 ##$cpt->permit(); #what is necessary?
1197 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1198 #$recur = $cpt->reval($recur_prog);
1199 $recur = eval $recur_prog;
1200 unless ( defined($recur) ) {
1201 $dbh->rollback if $oldAutoCommit;
1202 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1203 "(expression $recur_prog): $@";
1205 #change this bit to use Date::Manip? CAREFUL with timezones (see
1206 # mailing list archive)
1207 my ($sec,$min,$hour,$mday,$mon,$year) =
1208 (localtime($sdate) )[0,1,2,3,4,5];
1210 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1211 # only for figuring next bill date, nothing else, so, reset $sdate again
1213 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1214 $cust_pkg->last_bill($sdate)
1215 if $cust_pkg->dbdef_table->column('last_bill');
1217 if ( $part_pkg->freq =~ /^\d+$/ ) {
1218 $mon += $part_pkg->freq;
1219 until ( $mon < 12 ) { $mon -= 12; $year++; }
1220 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1222 $mday += $weeks * 7;
1223 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1227 $dbh->rollback if $oldAutoCommit;
1228 return "unparsable frequency: ". $part_pkg->freq;
1230 $cust_pkg->setfield('bill',
1231 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1232 $cust_pkg_mod_flag = 1;
1235 warn "\$setup is undefined" unless defined($setup);
1236 warn "\$recur is undefined" unless defined($recur);
1237 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1239 if ( $cust_pkg_mod_flag ) {
1240 $error=$cust_pkg->replace($old_cust_pkg);
1241 if ( $error ) { #just in case
1242 $dbh->rollback if $oldAutoCommit;
1243 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1245 $setup = sprintf( "%.2f", $setup );
1246 $recur = sprintf( "%.2f", $recur );
1247 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1248 $dbh->rollback if $oldAutoCommit;
1249 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1251 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1252 $dbh->rollback if $oldAutoCommit;
1253 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1255 if ( $setup != 0 || $recur != 0 ) {
1256 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1257 'pkgnum' => $cust_pkg->pkgnum,
1261 'edate' => $cust_pkg->bill,
1263 push @cust_bill_pkg, $cust_bill_pkg;
1264 $total_setup += $setup;
1265 $total_recur += $recur;
1267 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1269 my @taxes = qsearch( 'cust_main_county', {
1270 'state' => $self->state,
1271 'county' => $self->county,
1272 'country' => $self->country,
1273 'taxclass' => $part_pkg->taxclass,
1276 @taxes = qsearch( 'cust_main_county', {
1277 'state' => $self->state,
1278 'county' => $self->county,
1279 'country' => $self->country,
1284 #one more try at a whole-country tax rate
1286 @taxes = qsearch( 'cust_main_county', {
1289 'country' => $self->country,
1294 # maybe eliminate this entirely, along with all the 0% records
1296 $dbh->rollback if $oldAutoCommit;
1298 "fatal: can't find tax rate for state/county/country/taxclass ".
1299 join('/', ( map $self->$_(), qw(state county country) ),
1300 $part_pkg->taxclass ). "\n";
1303 foreach my $tax ( @taxes ) {
1305 my $taxable_charged = 0;
1306 $taxable_charged += $setup
1307 unless $part_pkg->setuptax =~ /^Y$/i
1308 || $tax->setuptax =~ /^Y$/i;
1309 $taxable_charged += $recur
1310 unless $part_pkg->recurtax =~ /^Y$/i
1311 || $tax->recurtax =~ /^Y$/i;
1312 next unless $taxable_charged;
1314 if ( $tax->exempt_amount > 0 ) {
1315 my ($mon,$year) = (localtime($sdate) )[4,5];
1317 my $freq = $part_pkg->freq || 1;
1318 if ( $freq !~ /(\d+)$/ ) {
1319 $dbh->rollback if $oldAutoCommit;
1320 return "daily/weekly package definitions not (yet?)".
1321 " compatible with monthly tax exemptions";
1323 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1324 foreach my $which_month ( 1 .. $freq ) {
1326 'custnum' => $self->custnum,
1327 'taxnum' => $tax->taxnum,
1328 'year' => 1900+$year,
1331 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1332 until ( $mon < 13 ) { $mon -= 12; $year++; }
1333 my $cust_tax_exempt =
1334 qsearchs('cust_tax_exempt', \%hash)
1335 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1336 my $remaining_exemption = sprintf("%.2f",
1337 $tax->exempt_amount - $cust_tax_exempt->amount );
1338 if ( $remaining_exemption > 0 ) {
1339 my $addl = $remaining_exemption > $taxable_per_month
1340 ? $taxable_per_month
1341 : $remaining_exemption;
1342 $taxable_charged -= $addl;
1343 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1344 $cust_tax_exempt->hash,
1346 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1348 $error = $new_cust_tax_exempt->exemptnum
1349 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1350 : $new_cust_tax_exempt->insert;
1352 $dbh->rollback if $oldAutoCommit;
1353 return "fatal: can't update cust_tax_exempt: $error";
1356 } # if $remaining_exemption > 0
1358 } #foreach $which_month
1360 } #if $tax->exempt_amount
1362 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1364 #$tax += $taxable_charged * $cust_main_county->tax / 100
1365 $tax{ $tax->taxname || 'Tax' } +=
1366 $taxable_charged * $tax->tax / 100
1368 } #foreach my $tax ( @taxes )
1370 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1372 } #if $setup != 0 || $recur != 0
1374 } #if $cust_pkg_mod_flag
1376 } #foreach my $cust_pkg
1378 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1379 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1381 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1382 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1386 # unless ( $self->tax =~ /Y/i
1387 # || $self->payby eq 'COMP'
1388 # || $taxable_charged == 0 ) {
1389 # my $cust_main_county = qsearchs('cust_main_county',{
1390 # 'state' => $self->state,
1391 # 'county' => $self->county,
1392 # 'country' => $self->country,
1393 # } ) or die "fatal: can't find tax rate for state/county/country ".
1394 # $self->state. "/". $self->county. "/". $self->country. "\n";
1395 # my $tax = sprintf( "%.2f",
1396 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1399 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1401 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1402 my $tax = sprintf("%.2f", $tax{$taxname} );
1403 $charged = sprintf( "%.2f", $charged+$tax );
1405 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1411 'itemdesc' => $taxname,
1413 push @cust_bill_pkg, $cust_bill_pkg;
1416 } else { #1.4 schema
1419 foreach ( values %tax ) { $tax += $_ };
1420 $tax = sprintf("%.2f", $tax);
1422 $charged = sprintf( "%.2f", $charged+$tax );
1424 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1431 push @cust_bill_pkg, $cust_bill_pkg;
1436 my $cust_bill = new FS::cust_bill ( {
1437 'custnum' => $self->custnum,
1439 'charged' => $charged,
1441 $error = $cust_bill->insert;
1443 $dbh->rollback if $oldAutoCommit;
1444 return "can't create invoice for customer #". $self->custnum. ": $error";
1447 my $invnum = $cust_bill->invnum;
1449 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1451 $cust_bill_pkg->invnum($invnum);
1452 $error = $cust_bill_pkg->insert;
1454 $dbh->rollback if $oldAutoCommit;
1455 return "can't create invoice line item for customer #". $self->custnum.
1460 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1464 =item collect OPTIONS
1466 (Attempt to) collect money for this customer's outstanding invoices (see
1467 L<FS::cust_bill>). Usually used after the bill method.
1469 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1470 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1472 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1473 and the invoice events web interface.
1475 If there is an error, returns the error, otherwise returns false.
1477 Options are passed as name-value pairs.
1479 Currently available options are:
1481 invoice_time - Use this time when deciding when to print invoices and
1482 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>
1483 for conversion functions.
1485 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1488 retry_card - Deprecated alias for 'retry'
1490 batch_card - This option is deprecated. See the invoice events web interface
1491 to control whether cards are batched or run against a realtime gateway.
1493 report_badcard - This option is deprecated.
1495 force_print - This option is deprecated; see the invoice events web interface.
1497 quiet - set true to surpress email card/ACH decline notices.
1502 my( $self, %options ) = @_;
1503 my $invoice_time = $options{'invoice_time'} || time;
1506 local $SIG{HUP} = 'IGNORE';
1507 local $SIG{INT} = 'IGNORE';
1508 local $SIG{QUIT} = 'IGNORE';
1509 local $SIG{TERM} = 'IGNORE';
1510 local $SIG{TSTP} = 'IGNORE';
1511 local $SIG{PIPE} = 'IGNORE';
1513 my $oldAutoCommit = $FS::UID::AutoCommit;
1514 local $FS::UID::AutoCommit = 0;
1517 $self->select_for_update; #mutex
1519 my $balance = $self->balance;
1520 warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1521 unless ( $balance > 0 ) { #redundant?????
1522 $dbh->rollback if $oldAutoCommit; #hmm
1526 if ( exists($options{'retry_card'}) ) {
1527 carp 'retry_card option passed to collect is deprecated; use retry';
1528 $options{'retry'} ||= $options{'retry_card'};
1530 if ( exists($options{'retry'}) && $options{'retry'} ) {
1531 my $error = $self->retry_realtime;
1533 $dbh->rollback if $oldAutoCommit;
1538 foreach my $cust_bill ( $self->open_cust_bill ) {
1540 # don't try to charge for the same invoice if it's already in a batch
1541 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1543 last if $self->balance <= 0;
1545 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1548 foreach my $part_bill_event (
1549 sort { $a->seconds <=> $b->seconds
1550 || $a->weight <=> $b->weight
1551 || $a->eventpart <=> $b->eventpart }
1552 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1553 && ! qsearch( 'cust_bill_event', {
1554 'invnum' => $cust_bill->invnum,
1555 'eventpart' => $_->eventpart,
1559 qsearch('part_bill_event', { 'payby' => $self->payby,
1560 'disabled' => '', } )
1563 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1564 || $self->balance <= 0; # or if balance<=0
1566 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1568 my $cust_main = $self; #for callback
1572 #supress "used only once" warning
1573 $FS::cust_bill::realtime_bop_decline_quiet += 0;
1574 local $FS::cust_bill::realtime_bop_decline_quiet = 1
1575 if $options{'quiet'};
1576 $error = eval $part_bill_event->eventcode;
1580 my $statustext = '';
1584 } elsif ( $error ) {
1586 $statustext = $error;
1591 #add cust_bill_event
1592 my $cust_bill_event = new FS::cust_bill_event {
1593 'invnum' => $cust_bill->invnum,
1594 'eventpart' => $part_bill_event->eventpart,
1595 #'_date' => $invoice_time,
1597 'status' => $status,
1598 'statustext' => $statustext,
1600 $error = $cust_bill_event->insert;
1602 #$dbh->rollback if $oldAutoCommit;
1603 #return "error: $error";
1605 # gah, even with transactions.
1606 $dbh->commit if $oldAutoCommit; #well.
1607 my $e = 'WARNING: Event run but database not updated - '.
1608 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1609 ', eventpart '. $part_bill_event->eventpart.
1620 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1625 =item retry_realtime
1627 Schedules realtime credit card / electronic check / LEC billing events for
1628 for retry. Useful if card information has changed or manual retry is desired.
1629 The 'collect' method must be called to actually retry the transaction.
1631 Implementation details: For each of this customer's open invoices, changes
1632 the status of the first "done" (with statustext error) realtime processing
1637 sub retry_realtime {
1640 local $SIG{HUP} = 'IGNORE';
1641 local $SIG{INT} = 'IGNORE';
1642 local $SIG{QUIT} = 'IGNORE';
1643 local $SIG{TERM} = 'IGNORE';
1644 local $SIG{TSTP} = 'IGNORE';
1645 local $SIG{PIPE} = 'IGNORE';
1647 my $oldAutoCommit = $FS::UID::AutoCommit;
1648 local $FS::UID::AutoCommit = 0;
1651 foreach my $cust_bill (
1652 grep { $_->cust_bill_event }
1653 $self->open_cust_bill
1655 my @cust_bill_event =
1656 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1658 #$_->part_bill_event->plan eq 'realtime-card'
1659 $_->part_bill_event->eventcode =~
1660 /\$cust_bill\->realtime_(card|ach|lec)/
1661 && $_->status eq 'done'
1664 $cust_bill->cust_bill_event;
1665 next unless @cust_bill_event;
1666 my $error = $cust_bill_event[0]->retry;
1668 $dbh->rollback if $oldAutoCommit;
1669 return "error scheduling invoice event for retry: $error";
1674 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1681 Returns the total owed for this customer on all invoices
1682 (see L<FS::cust_bill/owed>).
1688 $self->total_owed_date(2145859200); #12/31/2037
1691 =item total_owed_date TIME
1693 Returns the total owed for this customer on all invoices with date earlier than
1694 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1695 see L<Time::Local> and L<Date::Parse> for conversion functions.
1699 sub total_owed_date {
1703 foreach my $cust_bill (
1704 grep { $_->_date <= $time }
1705 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1707 $total_bill += $cust_bill->owed;
1709 sprintf( "%.2f", $total_bill );
1714 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1715 to outstanding invoice balances in chronological order and returns the value
1716 of any remaining unapplied credits available for refund
1717 (see L<FS::cust_refund>).
1724 return 0 unless $self->total_credited;
1726 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1727 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1729 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1730 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1734 foreach my $cust_bill ( @invoices ) {
1737 if ( !defined($credit) || $credit->credited == 0) {
1738 $credit = pop @credits or last;
1741 if ($cust_bill->owed >= $credit->credited) {
1742 $amount=$credit->credited;
1744 $amount=$cust_bill->owed;
1747 my $cust_credit_bill = new FS::cust_credit_bill ( {
1748 'crednum' => $credit->crednum,
1749 'invnum' => $cust_bill->invnum,
1750 'amount' => $amount,
1752 my $error = $cust_credit_bill->insert;
1753 die $error if $error;
1755 redo if ($cust_bill->owed > 0);
1759 return $self->total_credited;
1762 =item apply_payments
1764 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1765 to outstanding invoice balances in chronological order.
1767 #and returns the value of any remaining unapplied payments.
1771 sub apply_payments {
1776 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1777 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1779 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1780 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1784 foreach my $cust_bill ( @invoices ) {
1787 if ( !defined($payment) || $payment->unapplied == 0 ) {
1788 $payment = pop @payments or last;
1791 if ( $cust_bill->owed >= $payment->unapplied ) {
1792 $amount = $payment->unapplied;
1794 $amount = $cust_bill->owed;
1797 my $cust_bill_pay = new FS::cust_bill_pay ( {
1798 'paynum' => $payment->paynum,
1799 'invnum' => $cust_bill->invnum,
1800 'amount' => $amount,
1802 my $error = $cust_bill_pay->insert;
1803 die $error if $error;
1805 redo if ( $cust_bill->owed > 0);
1809 return $self->total_unapplied_payments;
1812 =item total_credited
1814 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1815 customer. See L<FS::cust_credit/credited>.
1819 sub total_credited {
1821 my $total_credit = 0;
1822 foreach my $cust_credit ( qsearch('cust_credit', {
1823 'custnum' => $self->custnum,
1825 $total_credit += $cust_credit->credited;
1827 sprintf( "%.2f", $total_credit );
1830 =item total_unapplied_payments
1832 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1833 See L<FS::cust_pay/unapplied>.
1837 sub total_unapplied_payments {
1839 my $total_unapplied = 0;
1840 foreach my $cust_pay ( qsearch('cust_pay', {
1841 'custnum' => $self->custnum,
1843 $total_unapplied += $cust_pay->unapplied;
1845 sprintf( "%.2f", $total_unapplied );
1850 Returns the balance for this customer (total_owed minus total_credited
1851 minus total_unapplied_payments).
1858 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1862 =item balance_date TIME
1864 Returns the balance for this customer, only considering invoices with date
1865 earlier than TIME (total_owed_date minus total_credited minus
1866 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1867 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1876 $self->total_owed_date($time)
1877 - $self->total_credited
1878 - $self->total_unapplied_payments
1882 =item invoicing_list [ ARRAYREF ]
1884 If an arguement is given, sets these email addresses as invoice recipients
1885 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1886 (except as warnings), so use check_invoicing_list first.
1888 Returns a list of email addresses (with svcnum entries expanded).
1890 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1891 check it without disturbing anything by passing nothing.
1893 This interface may change in the future.
1897 sub invoicing_list {
1898 my( $self, $arrayref ) = @_;
1900 my @cust_main_invoice;
1901 if ( $self->custnum ) {
1902 @cust_main_invoice =
1903 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1905 @cust_main_invoice = ();
1907 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1908 #warn $cust_main_invoice->destnum;
1909 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1910 #warn $cust_main_invoice->destnum;
1911 my $error = $cust_main_invoice->delete;
1912 warn $error if $error;
1915 if ( $self->custnum ) {
1916 @cust_main_invoice =
1917 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1919 @cust_main_invoice = ();
1921 my %seen = map { $_->address => 1 } @cust_main_invoice;
1922 foreach my $address ( @{$arrayref} ) {
1923 next if exists $seen{$address} && $seen{$address};
1924 $seen{$address} = 1;
1925 my $cust_main_invoice = new FS::cust_main_invoice ( {
1926 'custnum' => $self->custnum,
1929 my $error = $cust_main_invoice->insert;
1930 warn $error if $error;
1933 if ( $self->custnum ) {
1935 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1941 =item check_invoicing_list ARRAYREF
1943 Checks these arguements as valid input for the invoicing_list method. If there
1944 is an error, returns the error, otherwise returns false.
1948 sub check_invoicing_list {
1949 my( $self, $arrayref ) = @_;
1950 foreach my $address ( @{$arrayref} ) {
1951 my $cust_main_invoice = new FS::cust_main_invoice ( {
1952 'custnum' => $self->custnum,
1955 my $error = $self->custnum
1956 ? $cust_main_invoice->check
1957 : $cust_main_invoice->checkdest
1959 return $error if $error;
1964 =item set_default_invoicing_list
1966 Sets the invoicing list to all accounts associated with this customer,
1967 overwriting any previous invoicing list.
1971 sub set_default_invoicing_list {
1973 $self->invoicing_list($self->all_emails);
1978 Returns the email addresses of all accounts provisioned for this customer.
1985 foreach my $cust_pkg ( $self->all_pkgs ) {
1986 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1988 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1989 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1991 $list{$_}=1 foreach map { $_->email } @svc_acct;
1996 =item invoicing_list_addpost
1998 Adds postal invoicing to this customer. If this customer is already configured
1999 to receive postal invoices, does nothing.
2003 sub invoicing_list_addpost {
2005 return if grep { $_ eq 'POST' } $self->invoicing_list;
2006 my @invoicing_list = $self->invoicing_list;
2007 push @invoicing_list, 'POST';
2008 $self->invoicing_list(\@invoicing_list);
2011 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2013 Returns an array of customers referred by this customer (referral_custnum set
2014 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2015 customers referred by customers referred by this customer and so on, inclusive.
2016 The default behavior is DEPTH 1 (no recursion).
2020 sub referral_cust_main {
2022 my $depth = @_ ? shift : 1;
2023 my $exclude = @_ ? shift : {};
2026 map { $exclude->{$_->custnum}++; $_; }
2027 grep { ! $exclude->{ $_->custnum } }
2028 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2032 map { $_->referral_cust_main($depth-1, $exclude) }
2039 =item referral_cust_main_ncancelled
2041 Same as referral_cust_main, except only returns customers with uncancelled
2046 sub referral_cust_main_ncancelled {
2048 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2051 =item referral_cust_pkg [ DEPTH ]
2053 Like referral_cust_main, except returns a flat list of all unsuspended (and
2054 uncancelled) packages for each customer. The number of items in this list may
2055 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2059 sub referral_cust_pkg {
2061 my $depth = @_ ? shift : 1;
2063 map { $_->unsuspended_pkgs }
2064 grep { $_->unsuspended_pkgs }
2065 $self->referral_cust_main($depth);
2068 =item credit AMOUNT, REASON
2070 Applies a credit to this customer. If there is an error, returns the error,
2071 otherwise returns false.
2076 my( $self, $amount, $reason ) = @_;
2077 my $cust_credit = new FS::cust_credit {
2078 'custnum' => $self->custnum,
2079 'amount' => $amount,
2080 'reason' => $reason,
2082 $cust_credit->insert;
2085 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2087 Creates a one-time charge for this customer. If there is an error, returns
2088 the error, otherwise returns false.
2093 my ( $self, $amount ) = ( shift, shift );
2094 my $pkg = @_ ? shift : 'One-time charge';
2095 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2096 my $taxclass = @_ ? shift : '';
2098 local $SIG{HUP} = 'IGNORE';
2099 local $SIG{INT} = 'IGNORE';
2100 local $SIG{QUIT} = 'IGNORE';
2101 local $SIG{TERM} = 'IGNORE';
2102 local $SIG{TSTP} = 'IGNORE';
2103 local $SIG{PIPE} = 'IGNORE';
2105 my $oldAutoCommit = $FS::UID::AutoCommit;
2106 local $FS::UID::AutoCommit = 0;
2109 my $part_pkg = new FS::part_pkg ( {
2111 'comment' => $comment,
2116 'taxclass' => $taxclass,
2119 my $error = $part_pkg->insert;
2121 $dbh->rollback if $oldAutoCommit;
2125 my $pkgpart = $part_pkg->pkgpart;
2126 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2127 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2128 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2129 $error = $type_pkgs->insert;
2131 $dbh->rollback if $oldAutoCommit;
2136 my $cust_pkg = new FS::cust_pkg ( {
2137 'custnum' => $self->custnum,
2138 'pkgpart' => $pkgpart,
2141 $error = $cust_pkg->insert;
2143 $dbh->rollback if $oldAutoCommit;
2147 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2154 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2160 sort { $a->_date <=> $b->_date }
2161 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2164 =item open_cust_bill
2166 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2171 sub open_cust_bill {
2173 grep { $_->owed > 0 } $self->cust_bill;
2178 Returns all the credits (see L<FS::cust_credit>) for this customer.
2184 sort { $a->_date <=> $b->_date }
2185 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2190 Returns all the payments (see L<FS::cust_pay>) for this customer.
2196 sort { $a->_date <=> $b->_date }
2197 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2202 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2208 sort { $a->_date <=> $b->_date }
2209 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2212 =item select_for_update
2214 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2219 sub select_for_update {
2221 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2230 =item check_and_rebuild_fuzzyfiles
2234 sub check_and_rebuild_fuzzyfiles {
2235 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2236 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2237 or &rebuild_fuzzyfiles;
2240 =item rebuild_fuzzyfiles
2244 sub rebuild_fuzzyfiles {
2246 use Fcntl qw(:flock);
2248 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2252 open(LASTLOCK,">>$dir/cust_main.last")
2253 or die "can't open $dir/cust_main.last: $!";
2254 flock(LASTLOCK,LOCK_EX)
2255 or die "can't lock $dir/cust_main.last: $!";
2257 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2259 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2260 if defined dbdef->table('cust_main')->column('ship_last');
2262 open (LASTCACHE,">$dir/cust_main.last.tmp")
2263 or die "can't open $dir/cust_main.last.tmp: $!";
2264 print LASTCACHE join("\n", @all_last), "\n";
2265 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2267 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2272 open(COMPANYLOCK,">>$dir/cust_main.company")
2273 or die "can't open $dir/cust_main.company: $!";
2274 flock(COMPANYLOCK,LOCK_EX)
2275 or die "can't lock $dir/cust_main.company: $!";
2277 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2279 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2280 if defined dbdef->table('cust_main')->column('ship_last');
2282 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2283 or die "can't open $dir/cust_main.company.tmp: $!";
2284 print COMPANYCACHE join("\n", @all_company), "\n";
2285 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2287 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2297 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2298 open(LASTCACHE,"<$dir/cust_main.last")
2299 or die "can't open $dir/cust_main.last: $!";
2300 my @array = map { chomp; $_; } <LASTCACHE>;
2310 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2311 open(COMPANYCACHE,"<$dir/cust_main.company")
2312 or die "can't open $dir/cust_main.last: $!";
2313 my @array = map { chomp; $_; } <COMPANYCACHE>;
2318 =item append_fuzzyfiles LASTNAME COMPANY
2322 sub append_fuzzyfiles {
2323 my( $last, $company ) = @_;
2325 &check_and_rebuild_fuzzyfiles;
2327 use Fcntl qw(:flock);
2329 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2333 open(LAST,">>$dir/cust_main.last")
2334 or die "can't open $dir/cust_main.last: $!";
2336 or die "can't lock $dir/cust_main.last: $!";
2338 print LAST "$last\n";
2341 or die "can't unlock $dir/cust_main.last: $!";
2347 open(COMPANY,">>$dir/cust_main.company")
2348 or die "can't open $dir/cust_main.company: $!";
2349 flock(COMPANY,LOCK_EX)
2350 or die "can't lock $dir/cust_main.company: $!";
2352 print COMPANY "$company\n";
2354 flock(COMPANY,LOCK_UN)
2355 or die "can't unlock $dir/cust_main.company: $!";
2369 #warn join('-',keys %$param);
2370 my $fh = $param->{filehandle};
2371 my $agentnum = $param->{agentnum};
2372 my $refnum = $param->{refnum};
2373 my $pkgpart = $param->{pkgpart};
2374 my @fields = @{$param->{fields}};
2376 eval "use Date::Parse;";
2378 eval "use Text::CSV_XS;";
2381 my $csv = new Text::CSV_XS;
2388 local $SIG{HUP} = 'IGNORE';
2389 local $SIG{INT} = 'IGNORE';
2390 local $SIG{QUIT} = 'IGNORE';
2391 local $SIG{TERM} = 'IGNORE';
2392 local $SIG{TSTP} = 'IGNORE';
2393 local $SIG{PIPE} = 'IGNORE';
2395 my $oldAutoCommit = $FS::UID::AutoCommit;
2396 local $FS::UID::AutoCommit = 0;
2399 #while ( $columns = $csv->getline($fh) ) {
2401 while ( defined($line=<$fh>) ) {
2403 $csv->parse($line) or do {
2404 $dbh->rollback if $oldAutoCommit;
2405 return "can't parse: ". $csv->error_input();
2408 my @columns = $csv->fields();
2409 #warn join('-',@columns);
2412 agentnum => $agentnum,
2414 country => $conf->config('countrydefault') || 'US',
2415 payby => 'BILL', #default
2416 paydate => '12/2037', #default
2418 my $billtime = time;
2419 my %cust_pkg = ( pkgpart => $pkgpart );
2420 foreach my $field ( @fields ) {
2421 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2422 #$cust_pkg{$1} = str2time( shift @$columns );
2423 if ( $1 eq 'setup' ) {
2424 $billtime = str2time(shift @columns);
2426 $cust_pkg{$1} = str2time( shift @columns );
2429 #$cust_main{$field} = shift @$columns;
2430 $cust_main{$field} = shift @columns;
2434 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2435 my $cust_main = new FS::cust_main ( \%cust_main );
2437 tie my %hash, 'Tie::RefHash'; #this part is important
2438 $hash{$cust_pkg} = [] if $pkgpart;
2439 my $error = $cust_main->insert( \%hash );
2442 $dbh->rollback if $oldAutoCommit;
2443 return "can't insert customer for $line: $error";
2446 #false laziness w/bill.cgi
2447 $error = $cust_main->bill( 'time' => $billtime );
2449 $dbh->rollback if $oldAutoCommit;
2450 return "can't bill customer for $line: $error";
2453 $cust_main->apply_payments;
2454 $cust_main->apply_credits;
2456 $error = $cust_main->collect();
2458 $dbh->rollback if $oldAutoCommit;
2459 return "can't collect customer for $line: $error";
2465 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2467 return "Empty file!" unless $imported;
2479 #warn join('-',keys %$param);
2480 my $fh = $param->{filehandle};
2481 my @fields = @{$param->{fields}};
2483 eval "use Date::Parse;";
2485 eval "use Text::CSV_XS;";
2488 my $csv = new Text::CSV_XS;
2495 local $SIG{HUP} = 'IGNORE';
2496 local $SIG{INT} = 'IGNORE';
2497 local $SIG{QUIT} = 'IGNORE';
2498 local $SIG{TERM} = 'IGNORE';
2499 local $SIG{TSTP} = 'IGNORE';
2500 local $SIG{PIPE} = 'IGNORE';
2502 my $oldAutoCommit = $FS::UID::AutoCommit;
2503 local $FS::UID::AutoCommit = 0;
2506 #while ( $columns = $csv->getline($fh) ) {
2508 while ( defined($line=<$fh>) ) {
2510 $csv->parse($line) or do {
2511 $dbh->rollback if $oldAutoCommit;
2512 return "can't parse: ". $csv->error_input();
2515 my @columns = $csv->fields();
2516 #warn join('-',@columns);
2519 foreach my $field ( @fields ) {
2520 $row{$field} = shift @columns;
2523 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2524 unless ( $cust_main ) {
2525 $dbh->rollback if $oldAutoCommit;
2526 return "unknown custnum $row{'custnum'}";
2529 if ( $row{'amount'} > 0 ) {
2530 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2532 $dbh->rollback if $oldAutoCommit;
2536 } elsif ( $row{'amount'} < 0 ) {
2537 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2540 $dbh->rollback if $oldAutoCommit;
2550 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2552 return "Empty file!" unless $imported;
2564 The delete method should possibly take an FS::cust_main object reference
2565 instead of a scalar customer number.
2567 Bill and collect options should probably be passed as references instead of a
2570 There should probably be a configuration file with a list of allowed credit
2573 No multiple currency support (probably a larger project than just this module).
2577 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2578 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2579 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.