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 my $time = $options{'time'} || time;
1106 local $SIG{HUP} = 'IGNORE';
1107 local $SIG{INT} = 'IGNORE';
1108 local $SIG{QUIT} = 'IGNORE';
1109 local $SIG{TERM} = 'IGNORE';
1110 local $SIG{TSTP} = 'IGNORE';
1111 local $SIG{PIPE} = 'IGNORE';
1113 my $oldAutoCommit = $FS::UID::AutoCommit;
1114 local $FS::UID::AutoCommit = 0;
1117 $self->select_for_update; #mutex
1119 # find the packages which are due for billing, find out how much they are
1120 # & generate invoice database.
1122 my( $total_setup, $total_recur ) = ( 0, 0 );
1123 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1124 my @cust_bill_pkg = ();
1126 #my $taxable_charged = 0;##
1131 foreach my $cust_pkg (
1132 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1135 #NO!! next if $cust_pkg->cancel;
1136 next if $cust_pkg->getfield('cancel');
1138 #? to avoid use of uninitialized value errors... ?
1139 $cust_pkg->setfield('bill', '')
1140 unless defined($cust_pkg->bill);
1142 my $part_pkg = $cust_pkg->part_pkg;
1144 #so we don't modify cust_pkg record unnecessarily
1145 my $cust_pkg_mod_flag = 0;
1146 my %hash = $cust_pkg->hash;
1147 my $old_cust_pkg = new FS::cust_pkg \%hash;
1151 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1152 my $setup_prog = $part_pkg->getfield('setup');
1153 $setup_prog =~ /^(.*)$/ or do {
1154 $dbh->rollback if $oldAutoCommit;
1155 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1159 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1161 #my $cpt = new Safe;
1162 ##$cpt->permit(); #what is necessary?
1163 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1164 #$setup = $cpt->reval($setup_prog);
1165 $setup = eval $setup_prog;
1166 unless ( defined($setup) ) {
1167 $dbh->rollback if $oldAutoCommit;
1168 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1169 "(expression $setup_prog): $@";
1171 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1172 $cust_pkg_mod_flag=1;
1178 if ( $part_pkg->getfield('freq') ne '0' &&
1179 ! $cust_pkg->getfield('susp') &&
1180 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1182 my $recur_prog = $part_pkg->getfield('recur');
1183 $recur_prog =~ /^(.*)$/ or do {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1189 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1191 # shared with $recur_prog
1192 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1194 #my $cpt = new Safe;
1195 ##$cpt->permit(); #what is necessary?
1196 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1197 #$recur = $cpt->reval($recur_prog);
1198 $recur = eval $recur_prog;
1199 unless ( defined($recur) ) {
1200 $dbh->rollback if $oldAutoCommit;
1201 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1202 "(expression $recur_prog): $@";
1204 #change this bit to use Date::Manip? CAREFUL with timezones (see
1205 # mailing list archive)
1206 my ($sec,$min,$hour,$mday,$mon,$year) =
1207 (localtime($sdate) )[0,1,2,3,4,5];
1209 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1210 # only for figuring next bill date, nothing else, so, reset $sdate again
1212 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1213 $cust_pkg->last_bill($sdate)
1214 if $cust_pkg->dbdef_table->column('last_bill');
1216 if ( $part_pkg->freq =~ /^\d+$/ ) {
1217 $mon += $part_pkg->freq;
1218 until ( $mon < 12 ) { $mon -= 12; $year++; }
1219 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1221 $mday += $weeks * 7;
1222 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1226 $dbh->rollback if $oldAutoCommit;
1227 return "unparsable frequency: ". $part_pkg->freq;
1229 $cust_pkg->setfield('bill',
1230 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1231 $cust_pkg_mod_flag = 1;
1234 warn "\$setup is undefined" unless defined($setup);
1235 warn "\$recur is undefined" unless defined($recur);
1236 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1238 if ( $cust_pkg_mod_flag ) {
1239 $error=$cust_pkg->replace($old_cust_pkg);
1240 if ( $error ) { #just in case
1241 $dbh->rollback if $oldAutoCommit;
1242 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1244 $setup = sprintf( "%.2f", $setup );
1245 $recur = sprintf( "%.2f", $recur );
1246 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1247 $dbh->rollback if $oldAutoCommit;
1248 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1250 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1251 $dbh->rollback if $oldAutoCommit;
1252 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1254 if ( $setup != 0 || $recur != 0 ) {
1255 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1256 'pkgnum' => $cust_pkg->pkgnum,
1260 'edate' => $cust_pkg->bill,
1262 push @cust_bill_pkg, $cust_bill_pkg;
1263 $total_setup += $setup;
1264 $total_recur += $recur;
1266 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1268 my @taxes = qsearch( 'cust_main_county', {
1269 'state' => $self->state,
1270 'county' => $self->county,
1271 'country' => $self->country,
1272 'taxclass' => $part_pkg->taxclass,
1275 @taxes = qsearch( 'cust_main_county', {
1276 'state' => $self->state,
1277 'county' => $self->county,
1278 'country' => $self->country,
1283 #one more try at a whole-country tax rate
1285 @taxes = qsearch( 'cust_main_county', {
1288 'country' => $self->country,
1293 # maybe eliminate this entirely, along with all the 0% records
1295 $dbh->rollback if $oldAutoCommit;
1297 "fatal: can't find tax rate for state/county/country/taxclass ".
1298 join('/', ( map $self->$_(), qw(state county country) ),
1299 $part_pkg->taxclass ). "\n";
1302 foreach my $tax ( @taxes ) {
1304 my $taxable_charged = 0;
1305 $taxable_charged += $setup
1306 unless $part_pkg->setuptax =~ /^Y$/i
1307 || $tax->setuptax =~ /^Y$/i;
1308 $taxable_charged += $recur
1309 unless $part_pkg->recurtax =~ /^Y$/i
1310 || $tax->recurtax =~ /^Y$/i;
1311 next unless $taxable_charged;
1313 if ( $tax->exempt_amount > 0 ) {
1314 my ($mon,$year) = (localtime($sdate) )[4,5];
1316 my $freq = $part_pkg->freq || 1;
1317 if ( $freq !~ /(\d+)$/ ) {
1318 $dbh->rollback if $oldAutoCommit;
1319 return "daily/weekly package definitions not (yet?)".
1320 " compatible with monthly tax exemptions";
1322 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1323 foreach my $which_month ( 1 .. $freq ) {
1325 'custnum' => $self->custnum,
1326 'taxnum' => $tax->taxnum,
1327 'year' => 1900+$year,
1330 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1331 until ( $mon < 13 ) { $mon -= 12; $year++; }
1332 my $cust_tax_exempt =
1333 qsearchs('cust_tax_exempt', \%hash)
1334 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1335 my $remaining_exemption = sprintf("%.2f",
1336 $tax->exempt_amount - $cust_tax_exempt->amount );
1337 if ( $remaining_exemption > 0 ) {
1338 my $addl = $remaining_exemption > $taxable_per_month
1339 ? $taxable_per_month
1340 : $remaining_exemption;
1341 $taxable_charged -= $addl;
1342 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1343 $cust_tax_exempt->hash,
1345 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1347 $error = $new_cust_tax_exempt->exemptnum
1348 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1349 : $new_cust_tax_exempt->insert;
1351 $dbh->rollback if $oldAutoCommit;
1352 return "fatal: can't update cust_tax_exempt: $error";
1355 } # if $remaining_exemption > 0
1357 } #foreach $which_month
1359 } #if $tax->exempt_amount
1361 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1363 #$tax += $taxable_charged * $cust_main_county->tax / 100
1364 $tax{ $tax->taxname || 'Tax' } +=
1365 $taxable_charged * $tax->tax / 100
1367 } #foreach my $tax ( @taxes )
1369 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1371 } #if $setup != 0 || $recur != 0
1373 } #if $cust_pkg_mod_flag
1375 } #foreach my $cust_pkg
1377 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1378 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1380 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1381 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1385 # unless ( $self->tax =~ /Y/i
1386 # || $self->payby eq 'COMP'
1387 # || $taxable_charged == 0 ) {
1388 # my $cust_main_county = qsearchs('cust_main_county',{
1389 # 'state' => $self->state,
1390 # 'county' => $self->county,
1391 # 'country' => $self->country,
1392 # } ) or die "fatal: can't find tax rate for state/county/country ".
1393 # $self->state. "/". $self->county. "/". $self->country. "\n";
1394 # my $tax = sprintf( "%.2f",
1395 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1398 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1400 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1401 my $tax = sprintf("%.2f", $tax{$taxname} );
1402 $charged = sprintf( "%.2f", $charged+$tax );
1404 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1410 'itemdesc' => $taxname,
1412 push @cust_bill_pkg, $cust_bill_pkg;
1415 } else { #1.4 schema
1418 foreach ( values %tax ) { $tax += $_ };
1419 $tax = sprintf("%.2f", $tax);
1421 $charged = sprintf( "%.2f", $charged+$tax );
1423 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1430 push @cust_bill_pkg, $cust_bill_pkg;
1435 my $cust_bill = new FS::cust_bill ( {
1436 'custnum' => $self->custnum,
1438 'charged' => $charged,
1440 $error = $cust_bill->insert;
1442 $dbh->rollback if $oldAutoCommit;
1443 return "can't create invoice for customer #". $self->custnum. ": $error";
1446 my $invnum = $cust_bill->invnum;
1448 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1450 $cust_bill_pkg->invnum($invnum);
1451 $error = $cust_bill_pkg->insert;
1453 $dbh->rollback if $oldAutoCommit;
1454 return "can't create invoice line item for customer #". $self->custnum.
1459 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1463 =item collect OPTIONS
1465 (Attempt to) collect money for this customer's outstanding invoices (see
1466 L<FS::cust_bill>). Usually used after the bill method.
1468 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1469 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1471 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1472 and the invoice events web interface.
1474 If there is an error, returns the error, otherwise returns false.
1476 Options are passed as name-value pairs.
1478 Currently available options are:
1480 invoice_time - Use this time when deciding when to print invoices and
1481 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>
1482 for conversion functions.
1484 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1487 retry_card - Deprecated alias for 'retry'
1489 batch_card - This option is deprecated. See the invoice events web interface
1490 to control whether cards are batched or run against a realtime gateway.
1492 report_badcard - This option is deprecated.
1494 force_print - This option is deprecated; see the invoice events web interface.
1496 quiet - set true to surpress email card/ACH decline notices.
1501 my( $self, %options ) = @_;
1502 my $invoice_time = $options{'invoice_time'} || time;
1505 local $SIG{HUP} = 'IGNORE';
1506 local $SIG{INT} = 'IGNORE';
1507 local $SIG{QUIT} = 'IGNORE';
1508 local $SIG{TERM} = 'IGNORE';
1509 local $SIG{TSTP} = 'IGNORE';
1510 local $SIG{PIPE} = 'IGNORE';
1512 my $oldAutoCommit = $FS::UID::AutoCommit;
1513 local $FS::UID::AutoCommit = 0;
1516 $self->select_for_update; #mutex
1518 my $balance = $self->balance;
1519 warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1520 unless ( $balance > 0 ) { #redundant?????
1521 $dbh->rollback if $oldAutoCommit; #hmm
1525 if ( exists($options{'retry_card'}) ) {
1526 carp 'retry_card option passed to collect is deprecated; use retry';
1527 $options{'retry'} ||= $options{'retry_card'};
1529 if ( exists($options{'retry'}) && $options{'retry'} ) {
1530 my $error = $self->retry_realtime;
1532 $dbh->rollback if $oldAutoCommit;
1537 foreach my $cust_bill ( $self->open_cust_bill ) {
1539 # don't try to charge for the same invoice if it's already in a batch
1540 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1542 last if $self->balance <= 0;
1544 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1547 foreach my $part_bill_event (
1548 sort { $a->seconds <=> $b->seconds
1549 || $a->weight <=> $b->weight
1550 || $a->eventpart <=> $b->eventpart }
1551 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1552 && ! qsearch( 'cust_bill_event', {
1553 'invnum' => $cust_bill->invnum,
1554 'eventpart' => $_->eventpart,
1558 qsearch('part_bill_event', { 'payby' => $self->payby,
1559 'disabled' => '', } )
1562 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1563 || $self->balance <= 0; # or if balance<=0
1565 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1567 my $cust_main = $self; #for callback
1571 #supress "used only once" warning
1572 $FS::cust_bill::realtime_bop_decline_quiet += 0;
1573 local $FS::cust_bill::realtime_bop_decline_quiet = 1
1574 if $options{'quiet'};
1575 $error = eval $part_bill_event->eventcode;
1579 my $statustext = '';
1583 } elsif ( $error ) {
1585 $statustext = $error;
1590 #add cust_bill_event
1591 my $cust_bill_event = new FS::cust_bill_event {
1592 'invnum' => $cust_bill->invnum,
1593 'eventpart' => $part_bill_event->eventpart,
1594 #'_date' => $invoice_time,
1596 'status' => $status,
1597 'statustext' => $statustext,
1599 $error = $cust_bill_event->insert;
1601 #$dbh->rollback if $oldAutoCommit;
1602 #return "error: $error";
1604 # gah, even with transactions.
1605 $dbh->commit if $oldAutoCommit; #well.
1606 my $e = 'WARNING: Event run but database not updated - '.
1607 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1608 ', eventpart '. $part_bill_event->eventpart.
1619 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1624 =item retry_realtime
1626 Schedules realtime credit card / electronic check / LEC billing events for
1627 for retry. Useful if card information has changed or manual retry is desired.
1628 The 'collect' method must be called to actually retry the transaction.
1630 Implementation details: For each of this customer's open invoices, changes
1631 the status of the first "done" (with statustext error) realtime processing
1636 sub retry_realtime {
1639 local $SIG{HUP} = 'IGNORE';
1640 local $SIG{INT} = 'IGNORE';
1641 local $SIG{QUIT} = 'IGNORE';
1642 local $SIG{TERM} = 'IGNORE';
1643 local $SIG{TSTP} = 'IGNORE';
1644 local $SIG{PIPE} = 'IGNORE';
1646 my $oldAutoCommit = $FS::UID::AutoCommit;
1647 local $FS::UID::AutoCommit = 0;
1650 foreach my $cust_bill (
1651 grep { $_->cust_bill_event }
1652 $self->open_cust_bill
1654 my @cust_bill_event =
1655 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1657 #$_->part_bill_event->plan eq 'realtime-card'
1658 $_->part_bill_event->eventcode =~
1659 /\$cust_bill\->realtime_(card|ach|lec)/
1660 && $_->status eq 'done'
1663 $cust_bill->cust_bill_event;
1664 next unless @cust_bill_event;
1665 my $error = $cust_bill_event[0]->retry;
1667 $dbh->rollback if $oldAutoCommit;
1668 return "error scheduling invoice event for retry: $error";
1673 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1680 Returns the total owed for this customer on all invoices
1681 (see L<FS::cust_bill/owed>).
1687 $self->total_owed_date(2145859200); #12/31/2037
1690 =item total_owed_date TIME
1692 Returns the total owed for this customer on all invoices with date earlier than
1693 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1694 see L<Time::Local> and L<Date::Parse> for conversion functions.
1698 sub total_owed_date {
1702 foreach my $cust_bill (
1703 grep { $_->_date <= $time }
1704 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1706 $total_bill += $cust_bill->owed;
1708 sprintf( "%.2f", $total_bill );
1713 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1714 to outstanding invoice balances in chronological order and returns the value
1715 of any remaining unapplied credits available for refund
1716 (see L<FS::cust_refund>).
1723 return 0 unless $self->total_credited;
1725 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1726 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1728 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1729 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1733 foreach my $cust_bill ( @invoices ) {
1736 if ( !defined($credit) || $credit->credited == 0) {
1737 $credit = pop @credits or last;
1740 if ($cust_bill->owed >= $credit->credited) {
1741 $amount=$credit->credited;
1743 $amount=$cust_bill->owed;
1746 my $cust_credit_bill = new FS::cust_credit_bill ( {
1747 'crednum' => $credit->crednum,
1748 'invnum' => $cust_bill->invnum,
1749 'amount' => $amount,
1751 my $error = $cust_credit_bill->insert;
1752 die $error if $error;
1754 redo if ($cust_bill->owed > 0);
1758 return $self->total_credited;
1761 =item apply_payments
1763 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1764 to outstanding invoice balances in chronological order.
1766 #and returns the value of any remaining unapplied payments.
1770 sub apply_payments {
1775 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1776 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1778 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1779 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1783 foreach my $cust_bill ( @invoices ) {
1786 if ( !defined($payment) || $payment->unapplied == 0 ) {
1787 $payment = pop @payments or last;
1790 if ( $cust_bill->owed >= $payment->unapplied ) {
1791 $amount = $payment->unapplied;
1793 $amount = $cust_bill->owed;
1796 my $cust_bill_pay = new FS::cust_bill_pay ( {
1797 'paynum' => $payment->paynum,
1798 'invnum' => $cust_bill->invnum,
1799 'amount' => $amount,
1801 my $error = $cust_bill_pay->insert;
1802 die $error if $error;
1804 redo if ( $cust_bill->owed > 0);
1808 return $self->total_unapplied_payments;
1811 =item total_credited
1813 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1814 customer. See L<FS::cust_credit/credited>.
1818 sub total_credited {
1820 my $total_credit = 0;
1821 foreach my $cust_credit ( qsearch('cust_credit', {
1822 'custnum' => $self->custnum,
1824 $total_credit += $cust_credit->credited;
1826 sprintf( "%.2f", $total_credit );
1829 =item total_unapplied_payments
1831 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1832 See L<FS::cust_pay/unapplied>.
1836 sub total_unapplied_payments {
1838 my $total_unapplied = 0;
1839 foreach my $cust_pay ( qsearch('cust_pay', {
1840 'custnum' => $self->custnum,
1842 $total_unapplied += $cust_pay->unapplied;
1844 sprintf( "%.2f", $total_unapplied );
1849 Returns the balance for this customer (total_owed minus total_credited
1850 minus total_unapplied_payments).
1857 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1861 =item balance_date TIME
1863 Returns the balance for this customer, only considering invoices with date
1864 earlier than TIME (total_owed_date minus total_credited minus
1865 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1866 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1875 $self->total_owed_date($time)
1876 - $self->total_credited
1877 - $self->total_unapplied_payments
1881 =item invoicing_list [ ARRAYREF ]
1883 If an arguement is given, sets these email addresses as invoice recipients
1884 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1885 (except as warnings), so use check_invoicing_list first.
1887 Returns a list of email addresses (with svcnum entries expanded).
1889 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1890 check it without disturbing anything by passing nothing.
1892 This interface may change in the future.
1896 sub invoicing_list {
1897 my( $self, $arrayref ) = @_;
1899 my @cust_main_invoice;
1900 if ( $self->custnum ) {
1901 @cust_main_invoice =
1902 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1904 @cust_main_invoice = ();
1906 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1907 #warn $cust_main_invoice->destnum;
1908 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1909 #warn $cust_main_invoice->destnum;
1910 my $error = $cust_main_invoice->delete;
1911 warn $error if $error;
1914 if ( $self->custnum ) {
1915 @cust_main_invoice =
1916 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1918 @cust_main_invoice = ();
1920 my %seen = map { $_->address => 1 } @cust_main_invoice;
1921 foreach my $address ( @{$arrayref} ) {
1922 next if exists $seen{$address} && $seen{$address};
1923 $seen{$address} = 1;
1924 my $cust_main_invoice = new FS::cust_main_invoice ( {
1925 'custnum' => $self->custnum,
1928 my $error = $cust_main_invoice->insert;
1929 warn $error if $error;
1932 if ( $self->custnum ) {
1934 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1940 =item check_invoicing_list ARRAYREF
1942 Checks these arguements as valid input for the invoicing_list method. If there
1943 is an error, returns the error, otherwise returns false.
1947 sub check_invoicing_list {
1948 my( $self, $arrayref ) = @_;
1949 foreach my $address ( @{$arrayref} ) {
1950 my $cust_main_invoice = new FS::cust_main_invoice ( {
1951 'custnum' => $self->custnum,
1954 my $error = $self->custnum
1955 ? $cust_main_invoice->check
1956 : $cust_main_invoice->checkdest
1958 return $error if $error;
1963 =item set_default_invoicing_list
1965 Sets the invoicing list to all accounts associated with this customer,
1966 overwriting any previous invoicing list.
1970 sub set_default_invoicing_list {
1972 $self->invoicing_list($self->all_emails);
1977 Returns the email addresses of all accounts provisioned for this customer.
1984 foreach my $cust_pkg ( $self->all_pkgs ) {
1985 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1987 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1988 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1990 $list{$_}=1 foreach map { $_->email } @svc_acct;
1995 =item invoicing_list_addpost
1997 Adds postal invoicing to this customer. If this customer is already configured
1998 to receive postal invoices, does nothing.
2002 sub invoicing_list_addpost {
2004 return if grep { $_ eq 'POST' } $self->invoicing_list;
2005 my @invoicing_list = $self->invoicing_list;
2006 push @invoicing_list, 'POST';
2007 $self->invoicing_list(\@invoicing_list);
2010 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2012 Returns an array of customers referred by this customer (referral_custnum set
2013 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2014 customers referred by customers referred by this customer and so on, inclusive.
2015 The default behavior is DEPTH 1 (no recursion).
2019 sub referral_cust_main {
2021 my $depth = @_ ? shift : 1;
2022 my $exclude = @_ ? shift : {};
2025 map { $exclude->{$_->custnum}++; $_; }
2026 grep { ! $exclude->{ $_->custnum } }
2027 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2031 map { $_->referral_cust_main($depth-1, $exclude) }
2038 =item referral_cust_main_ncancelled
2040 Same as referral_cust_main, except only returns customers with uncancelled
2045 sub referral_cust_main_ncancelled {
2047 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2050 =item referral_cust_pkg [ DEPTH ]
2052 Like referral_cust_main, except returns a flat list of all unsuspended (and
2053 uncancelled) packages for each customer. The number of items in this list may
2054 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2058 sub referral_cust_pkg {
2060 my $depth = @_ ? shift : 1;
2062 map { $_->unsuspended_pkgs }
2063 grep { $_->unsuspended_pkgs }
2064 $self->referral_cust_main($depth);
2067 =item credit AMOUNT, REASON
2069 Applies a credit to this customer. If there is an error, returns the error,
2070 otherwise returns false.
2075 my( $self, $amount, $reason ) = @_;
2076 my $cust_credit = new FS::cust_credit {
2077 'custnum' => $self->custnum,
2078 'amount' => $amount,
2079 'reason' => $reason,
2081 $cust_credit->insert;
2084 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2086 Creates a one-time charge for this customer. If there is an error, returns
2087 the error, otherwise returns false.
2092 my ( $self, $amount ) = ( shift, shift );
2093 my $pkg = @_ ? shift : 'One-time charge';
2094 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2095 my $taxclass = @_ ? shift : '';
2097 local $SIG{HUP} = 'IGNORE';
2098 local $SIG{INT} = 'IGNORE';
2099 local $SIG{QUIT} = 'IGNORE';
2100 local $SIG{TERM} = 'IGNORE';
2101 local $SIG{TSTP} = 'IGNORE';
2102 local $SIG{PIPE} = 'IGNORE';
2104 my $oldAutoCommit = $FS::UID::AutoCommit;
2105 local $FS::UID::AutoCommit = 0;
2108 my $part_pkg = new FS::part_pkg ( {
2110 'comment' => $comment,
2115 'taxclass' => $taxclass,
2118 my $error = $part_pkg->insert;
2120 $dbh->rollback if $oldAutoCommit;
2124 my $pkgpart = $part_pkg->pkgpart;
2125 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2126 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2127 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2128 $error = $type_pkgs->insert;
2130 $dbh->rollback if $oldAutoCommit;
2135 my $cust_pkg = new FS::cust_pkg ( {
2136 'custnum' => $self->custnum,
2137 'pkgpart' => $pkgpart,
2140 $error = $cust_pkg->insert;
2142 $dbh->rollback if $oldAutoCommit;
2146 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2153 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2159 sort { $a->_date <=> $b->_date }
2160 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2163 =item open_cust_bill
2165 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2170 sub open_cust_bill {
2172 grep { $_->owed > 0 } $self->cust_bill;
2177 Returns all the credits (see L<FS::cust_credit>) for this customer.
2183 sort { $a->_date <=> $b->_date }
2184 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2189 Returns all the payments (see L<FS::cust_pay>) for this customer.
2195 sort { $a->_date <=> $b->_date }
2196 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2201 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2207 sort { $a->_date <=> $b->_date }
2208 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2211 =item select_for_update
2213 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2218 sub select_for_update {
2220 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2229 =item check_and_rebuild_fuzzyfiles
2233 sub check_and_rebuild_fuzzyfiles {
2234 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2235 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2236 or &rebuild_fuzzyfiles;
2239 =item rebuild_fuzzyfiles
2243 sub rebuild_fuzzyfiles {
2245 use Fcntl qw(:flock);
2247 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2251 open(LASTLOCK,">>$dir/cust_main.last")
2252 or die "can't open $dir/cust_main.last: $!";
2253 flock(LASTLOCK,LOCK_EX)
2254 or die "can't lock $dir/cust_main.last: $!";
2256 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2258 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2259 if defined dbdef->table('cust_main')->column('ship_last');
2261 open (LASTCACHE,">$dir/cust_main.last.tmp")
2262 or die "can't open $dir/cust_main.last.tmp: $!";
2263 print LASTCACHE join("\n", @all_last), "\n";
2264 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2266 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2271 open(COMPANYLOCK,">>$dir/cust_main.company")
2272 or die "can't open $dir/cust_main.company: $!";
2273 flock(COMPANYLOCK,LOCK_EX)
2274 or die "can't lock $dir/cust_main.company: $!";
2276 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2278 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2279 if defined dbdef->table('cust_main')->column('ship_last');
2281 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2282 or die "can't open $dir/cust_main.company.tmp: $!";
2283 print COMPANYCACHE join("\n", @all_company), "\n";
2284 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2286 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2296 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2297 open(LASTCACHE,"<$dir/cust_main.last")
2298 or die "can't open $dir/cust_main.last: $!";
2299 my @array = map { chomp; $_; } <LASTCACHE>;
2309 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2310 open(COMPANYCACHE,"<$dir/cust_main.company")
2311 or die "can't open $dir/cust_main.last: $!";
2312 my @array = map { chomp; $_; } <COMPANYCACHE>;
2317 =item append_fuzzyfiles LASTNAME COMPANY
2321 sub append_fuzzyfiles {
2322 my( $last, $company ) = @_;
2324 &check_and_rebuild_fuzzyfiles;
2326 use Fcntl qw(:flock);
2328 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2332 open(LAST,">>$dir/cust_main.last")
2333 or die "can't open $dir/cust_main.last: $!";
2335 or die "can't lock $dir/cust_main.last: $!";
2337 print LAST "$last\n";
2340 or die "can't unlock $dir/cust_main.last: $!";
2346 open(COMPANY,">>$dir/cust_main.company")
2347 or die "can't open $dir/cust_main.company: $!";
2348 flock(COMPANY,LOCK_EX)
2349 or die "can't lock $dir/cust_main.company: $!";
2351 print COMPANY "$company\n";
2353 flock(COMPANY,LOCK_UN)
2354 or die "can't unlock $dir/cust_main.company: $!";
2368 #warn join('-',keys %$param);
2369 my $fh = $param->{filehandle};
2370 my $agentnum = $param->{agentnum};
2371 my $refnum = $param->{refnum};
2372 my $pkgpart = $param->{pkgpart};
2373 my @fields = @{$param->{fields}};
2375 eval "use Date::Parse;";
2377 eval "use Text::CSV_XS;";
2380 my $csv = new Text::CSV_XS;
2387 local $SIG{HUP} = 'IGNORE';
2388 local $SIG{INT} = 'IGNORE';
2389 local $SIG{QUIT} = 'IGNORE';
2390 local $SIG{TERM} = 'IGNORE';
2391 local $SIG{TSTP} = 'IGNORE';
2392 local $SIG{PIPE} = 'IGNORE';
2394 my $oldAutoCommit = $FS::UID::AutoCommit;
2395 local $FS::UID::AutoCommit = 0;
2398 #while ( $columns = $csv->getline($fh) ) {
2400 while ( defined($line=<$fh>) ) {
2402 $csv->parse($line) or do {
2403 $dbh->rollback if $oldAutoCommit;
2404 return "can't parse: ". $csv->error_input();
2407 my @columns = $csv->fields();
2408 #warn join('-',@columns);
2411 agentnum => $agentnum,
2413 country => $conf->config('countrydefault') || 'US',
2414 payby => 'BILL', #default
2415 paydate => '12/2037', #default
2417 my $billtime = time;
2418 my %cust_pkg = ( pkgpart => $pkgpart );
2419 foreach my $field ( @fields ) {
2420 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2421 #$cust_pkg{$1} = str2time( shift @$columns );
2422 if ( $1 eq 'setup' ) {
2423 $billtime = str2time(shift @columns);
2425 $cust_pkg{$1} = str2time( shift @columns );
2428 #$cust_main{$field} = shift @$columns;
2429 $cust_main{$field} = shift @columns;
2433 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2434 my $cust_main = new FS::cust_main ( \%cust_main );
2436 tie my %hash, 'Tie::RefHash'; #this part is important
2437 $hash{$cust_pkg} = [] if $pkgpart;
2438 my $error = $cust_main->insert( \%hash );
2441 $dbh->rollback if $oldAutoCommit;
2442 return "can't insert customer for $line: $error";
2445 #false laziness w/bill.cgi
2446 $error = $cust_main->bill( 'time' => $billtime );
2448 $dbh->rollback if $oldAutoCommit;
2449 return "can't bill customer for $line: $error";
2452 $cust_main->apply_payments;
2453 $cust_main->apply_credits;
2455 $error = $cust_main->collect();
2457 $dbh->rollback if $oldAutoCommit;
2458 return "can't collect customer for $line: $error";
2464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2466 return "Empty file!" unless $imported;
2478 #warn join('-',keys %$param);
2479 my $fh = $param->{filehandle};
2480 my @fields = @{$param->{fields}};
2482 eval "use Date::Parse;";
2484 eval "use Text::CSV_XS;";
2487 my $csv = new Text::CSV_XS;
2494 local $SIG{HUP} = 'IGNORE';
2495 local $SIG{INT} = 'IGNORE';
2496 local $SIG{QUIT} = 'IGNORE';
2497 local $SIG{TERM} = 'IGNORE';
2498 local $SIG{TSTP} = 'IGNORE';
2499 local $SIG{PIPE} = 'IGNORE';
2501 my $oldAutoCommit = $FS::UID::AutoCommit;
2502 local $FS::UID::AutoCommit = 0;
2505 #while ( $columns = $csv->getline($fh) ) {
2507 while ( defined($line=<$fh>) ) {
2509 $csv->parse($line) or do {
2510 $dbh->rollback if $oldAutoCommit;
2511 return "can't parse: ". $csv->error_input();
2514 my @columns = $csv->fields();
2515 #warn join('-',@columns);
2518 foreach my $field ( @fields ) {
2519 $row{$field} = shift @columns;
2522 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2523 unless ( $cust_main ) {
2524 $dbh->rollback if $oldAutoCommit;
2525 return "unknown custnum $row{'custnum'}";
2528 if ( $row{'amount'} > 0 ) {
2529 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2531 $dbh->rollback if $oldAutoCommit;
2535 } elsif ( $row{'amount'} < 0 ) {
2536 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2539 $dbh->rollback if $oldAutoCommit;
2549 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2551 return "Empty file!" unless $imported;
2563 The delete method should possibly take an FS::cust_main object reference
2564 instead of a scalar customer number.
2566 Bill and collect options should probably be passed as references instead of a
2569 There should probably be a configuration file with a list of allowed credit
2572 No multiple currency support (probably a larger project than just this module).
2576 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2577 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2578 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.