4 use vars qw( @ISA $conf $Debug $import );
8 eval "use Time::Local;";
9 die "Time::Local version 1.05 required with Perl versions before 5.6"
10 if $] < 5.006 && !defined($Time::Local::VERSION);
11 eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 use Business::CreditCard;
16 use FS::UID qw( getotaker dbh );
17 use FS::Record qw( qsearchs qsearch dbdef );
20 use FS::cust_bill_pkg;
23 use FS::part_referral;
24 use FS::cust_main_county;
26 use FS::cust_main_invoice;
27 use FS::cust_credit_bill;
28 use FS::cust_bill_pay;
29 use FS::prepay_credit;
32 use FS::part_bill_event;
33 use FS::cust_bill_event;
34 use FS::cust_tax_exempt;
36 use FS::Msgcat qw(gettext);
38 @ISA = qw( FS::Record );
45 #ask FS::UID to run this stuff for us later
46 $FS::UID::callback{'FS::cust_main'} = sub {
48 #yes, need it for stuff below (prolly should be cached)
53 my ( $hashref, $cache ) = @_;
54 if ( exists $hashref->{'pkgnum'} ) {
55 # #@{ $self->{'_pkgnum'} } = ();
56 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
57 $self->{'_pkgnum'} = $subcache;
58 #push @{ $self->{'_pkgnum'} },
59 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
65 FS::cust_main - Object methods for cust_main records
71 $record = new FS::cust_main \%hash;
72 $record = new FS::cust_main { 'column' => 'value' };
74 $error = $record->insert;
76 $error = $new_record->replace($old_record);
78 $error = $record->delete;
80 $error = $record->check;
82 @cust_pkg = $record->all_pkgs;
84 @cust_pkg = $record->ncancelled_pkgs;
86 @cust_pkg = $record->suspended_pkgs;
88 $error = $record->bill;
89 $error = $record->bill %options;
90 $error = $record->bill 'time' => $time;
92 $error = $record->collect;
93 $error = $record->collect %options;
94 $error = $record->collect 'invoice_time' => $time,
95 'batch_card' => 'yes',
96 'report_badcard' => 'yes',
101 An FS::cust_main object represents a customer. FS::cust_main inherits from
102 FS::Record. The following fields are currently supported:
106 =item custnum - primary key (assigned automatically for new customers)
108 =item agentnum - agent (see L<FS::agent>)
110 =item refnum - Advertising source (see L<FS::part_referral>)
116 =item ss - social security number (optional)
118 =item company - (optional)
122 =item address2 - (optional)
126 =item county - (optional, see L<FS::cust_main_county>)
128 =item state - (see L<FS::cust_main_county>)
132 =item country - (see L<FS::cust_main_county>)
134 =item daytime - phone (optional)
136 =item night - phone (optional)
138 =item fax - phone (optional)
140 =item ship_first - name
142 =item ship_last - name
144 =item ship_company - (optional)
148 =item ship_address2 - (optional)
152 =item ship_county - (optional, see L<FS::cust_main_county>)
154 =item ship_state - (see L<FS::cust_main_county>)
158 =item ship_country - (see L<FS::cust_main_county>)
160 =item ship_daytime - phone (optional)
162 =item ship_night - phone (optional)
164 =item ship_fax - phone (optional)
166 =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)
168 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
170 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
172 =item payname - name on card or billing name
174 =item tax - tax exempt, empty or `Y'
176 =item otaker - order taker (assigned automatically, see L<FS::UID>)
178 =item comments - comments (optional)
188 Creates a new customer. To add the customer to the database, see L<"insert">.
190 Note that this stores the hash reference, not a distinct copy of the hash it
191 points to. You can ask the object for a copy with the I<hash> method.
195 sub table { 'cust_main'; }
197 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
199 Adds this customer to the database. If there is an error, returns the error,
200 otherwise returns false.
202 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
203 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
204 are inserted atomicly, or the transaction is rolled back. Passing an empty
205 hash reference is equivalent to not supplying this parameter. There should be
206 a better explanation of this, but until then, here's an example:
209 tie %hash, 'Tie::RefHash'; #this part is important
211 $cust_pkg => [ $svc_acct ],
214 $cust_main->insert( \%hash );
216 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
217 be set as the invoicing list (see L<"invoicing_list">). Errors return as
218 expected and rollback the entire transaction; it is not necessary to call
219 check_invoicing_list first. The invoicing_list is set after the records in the
220 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
221 invoicing_list destination to the newly-created svc_acct. Here's an example:
223 $cust_main->insert( {}, [ $email, 'POST' ] );
229 my $cust_pkgs = @_ ? shift : {};
230 my $invoicing_list = @_ ? shift : '';
232 local $SIG{HUP} = 'IGNORE';
233 local $SIG{INT} = 'IGNORE';
234 local $SIG{QUIT} = 'IGNORE';
235 local $SIG{TERM} = 'IGNORE';
236 local $SIG{TSTP} = 'IGNORE';
237 local $SIG{PIPE} = 'IGNORE';
239 my $oldAutoCommit = $FS::UID::AutoCommit;
240 local $FS::UID::AutoCommit = 0;
245 if ( $self->payby eq 'PREPAY' ) {
246 $self->payby('BILL');
247 my $prepay_credit = qsearchs(
249 { 'identifier' => $self->payinfo },
253 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
254 unless $prepay_credit;
255 $amount = $prepay_credit->amount;
256 $seconds = $prepay_credit->seconds;
257 my $error = $prepay_credit->delete;
259 $dbh->rollback if $oldAutoCommit;
260 return "removing prepay_credit (transaction rolled back): $error";
264 my $error = $self->SUPER::insert;
266 $dbh->rollback if $oldAutoCommit;
267 #return "inserting cust_main record (transaction rolled back): $error";
272 if ( $invoicing_list ) {
273 $error = $self->check_invoicing_list( $invoicing_list );
275 $dbh->rollback if $oldAutoCommit;
276 return "checking invoicing_list (transaction rolled back): $error";
278 $self->invoicing_list( $invoicing_list );
282 foreach my $cust_pkg ( keys %$cust_pkgs ) {
283 $cust_pkg->custnum( $self->custnum );
284 $error = $cust_pkg->insert;
286 $dbh->rollback if $oldAutoCommit;
287 return "inserting cust_pkg (transaction rolled back): $error";
289 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
290 $svc_something->pkgnum( $cust_pkg->pkgnum );
291 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
292 $svc_something->seconds( $svc_something->seconds + $seconds );
295 $error = $svc_something->insert;
297 $dbh->rollback if $oldAutoCommit;
298 #return "inserting svc_ (transaction rolled back): $error";
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 delete NEW_CUSTNUM
334 This deletes the customer. If there is an error, returns the error, otherwise
337 This will completely remove all traces of the customer record. This is not
338 what you want when a customer cancels service; for that, cancel all of the
339 customer's packages (see L</cancel>).
341 If the customer has any uncancelled packages, you need to pass a new (valid)
342 customer number for those packages to be transferred to. Cancelled packages
343 will be deleted. Did I mention that this is NOT what you want when a customer
344 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
346 You can't delete a customer with invoices (see L<FS::cust_bill>),
347 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
348 refunds (see L<FS::cust_refund>).
355 local $SIG{HUP} = 'IGNORE';
356 local $SIG{INT} = 'IGNORE';
357 local $SIG{QUIT} = 'IGNORE';
358 local $SIG{TERM} = 'IGNORE';
359 local $SIG{TSTP} = 'IGNORE';
360 local $SIG{PIPE} = 'IGNORE';
362 my $oldAutoCommit = $FS::UID::AutoCommit;
363 local $FS::UID::AutoCommit = 0;
366 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
367 $dbh->rollback if $oldAutoCommit;
368 return "Can't delete a customer with invoices";
370 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
371 $dbh->rollback if $oldAutoCommit;
372 return "Can't delete a customer with credits";
374 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
375 $dbh->rollback if $oldAutoCommit;
376 return "Can't delete a customer with payments";
378 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
379 $dbh->rollback if $oldAutoCommit;
380 return "Can't delete a customer with refunds";
383 my @cust_pkg = $self->ncancelled_pkgs;
385 my $new_custnum = shift;
386 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
387 $dbh->rollback if $oldAutoCommit;
388 return "Invalid new customer number: $new_custnum";
390 foreach my $cust_pkg ( @cust_pkg ) {
391 my %hash = $cust_pkg->hash;
392 $hash{'custnum'} = $new_custnum;
393 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
394 my $error = $new_cust_pkg->replace($cust_pkg);
396 $dbh->rollback if $oldAutoCommit;
401 my @cancelled_cust_pkg = $self->all_pkgs;
402 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
403 my $error = $cust_pkg->delete;
405 $dbh->rollback if $oldAutoCommit;
410 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
411 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
413 my $error = $cust_main_invoice->delete;
415 $dbh->rollback if $oldAutoCommit;
420 my $error = $self->SUPER::delete;
422 $dbh->rollback if $oldAutoCommit;
426 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
431 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
433 Replaces the OLD_RECORD with this one in the database. If there is an error,
434 returns the error, otherwise returns false.
436 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
437 be set as the invoicing list (see L<"invoicing_list">). Errors return as
438 expected and rollback the entire transaction; it is not necessary to call
439 check_invoicing_list first. Here's an example:
441 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
450 local $SIG{HUP} = 'IGNORE';
451 local $SIG{INT} = 'IGNORE';
452 local $SIG{QUIT} = 'IGNORE';
453 local $SIG{TERM} = 'IGNORE';
454 local $SIG{TSTP} = 'IGNORE';
455 local $SIG{PIPE} = 'IGNORE';
457 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
458 && $conf->config('users-allow_comp') ) {
459 return "You are not permitted to create complimentary accounts."
460 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
463 my $oldAutoCommit = $FS::UID::AutoCommit;
464 local $FS::UID::AutoCommit = 0;
467 my $error = $self->SUPER::replace($old);
470 $dbh->rollback if $oldAutoCommit;
474 if ( @param ) { # INVOICING_LIST_ARYREF
475 my $invoicing_list = shift @param;
476 $error = $self->check_invoicing_list( $invoicing_list );
478 $dbh->rollback if $oldAutoCommit;
481 $self->invoicing_list( $invoicing_list );
484 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
485 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
486 # card/check/lec info has changed, want to retry realtime_ invoice events
487 my $error = $self->retry_realtime;
489 $dbh->rollback if $oldAutoCommit;
494 $error = $self->queue_fuzzyfiles_update;
496 $dbh->rollback if $oldAutoCommit;
497 return "updating fuzzy search cache: $error";
500 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
505 =item queue_fuzzyfiles_update
507 Used by insert & replace to update the fuzzy search cache
511 sub queue_fuzzyfiles_update {
514 local $SIG{HUP} = 'IGNORE';
515 local $SIG{INT} = 'IGNORE';
516 local $SIG{QUIT} = 'IGNORE';
517 local $SIG{TERM} = 'IGNORE';
518 local $SIG{TSTP} = 'IGNORE';
519 local $SIG{PIPE} = 'IGNORE';
521 my $oldAutoCommit = $FS::UID::AutoCommit;
522 local $FS::UID::AutoCommit = 0;
525 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
526 my $error = $queue->insert($self->getfield('last'), $self->company);
528 $dbh->rollback if $oldAutoCommit;
529 return "queueing job (transaction rolled back): $error";
532 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
533 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
534 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
536 $dbh->rollback if $oldAutoCommit;
537 return "queueing job (transaction rolled back): $error";
541 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
548 Checks all fields to make sure this is a valid customer record. If there is
549 an error, returns the error, otherwise returns false. Called by the insert
557 #warn "BEFORE: \n". $self->_dump;
560 $self->ut_numbern('custnum')
561 || $self->ut_number('agentnum')
562 || $self->ut_number('refnum')
563 || $self->ut_name('last')
564 || $self->ut_name('first')
565 || $self->ut_textn('company')
566 || $self->ut_text('address1')
567 || $self->ut_textn('address2')
568 || $self->ut_text('city')
569 || $self->ut_textn('county')
570 || $self->ut_textn('state')
571 || $self->ut_country('country')
572 || $self->ut_anything('comments')
573 || $self->ut_numbern('referral_custnum')
575 #barf. need message catalogs. i18n. etc.
576 $error .= "Please select an advertising source."
577 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
578 return $error if $error;
580 return "Unknown agent"
581 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
583 return "Unknown refnum"
584 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
586 return "Unknown referring custnum ". $self->referral_custnum
587 unless ! $self->referral_custnum
588 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
590 if ( $self->ss eq '' ) {
595 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
596 or return "Illegal social security number: ". $self->ss;
597 $self->ss("$1-$2-$3");
601 # bad idea to disable, causes billing to fail because of no tax rates later
602 # unless ( $import ) {
603 unless ( qsearch('cust_main_county', {
604 'country' => $self->country,
607 return "Unknown state/county/country: ".
608 $self->state. "/". $self->county. "/". $self->country
609 unless qsearch('cust_main_county',{
610 'state' => $self->state,
611 'county' => $self->county,
612 'country' => $self->country,
618 $self->ut_phonen('daytime', $self->country)
619 || $self->ut_phonen('night', $self->country)
620 || $self->ut_phonen('fax', $self->country)
621 || $self->ut_zip('zip', $self->country)
623 return $error if $error;
626 last first company address1 address2 city county state zip
627 country daytime night fax
630 if ( defined $self->dbdef_table->column('ship_last') ) {
631 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
633 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
637 $self->ut_name('ship_last')
638 || $self->ut_name('ship_first')
639 || $self->ut_textn('ship_company')
640 || $self->ut_text('ship_address1')
641 || $self->ut_textn('ship_address2')
642 || $self->ut_text('ship_city')
643 || $self->ut_textn('ship_county')
644 || $self->ut_textn('ship_state')
645 || $self->ut_country('ship_country')
647 return $error if $error;
649 #false laziness with above
650 unless ( qsearchs('cust_main_county', {
651 'country' => $self->ship_country,
654 return "Unknown ship_state/ship_county/ship_country: ".
655 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
656 unless qsearchs('cust_main_county',{
657 'state' => $self->ship_state,
658 'county' => $self->ship_county,
659 'country' => $self->ship_country,
665 $self->ut_phonen('ship_daytime', $self->ship_country)
666 || $self->ut_phonen('ship_night', $self->ship_country)
667 || $self->ut_phonen('ship_fax', $self->ship_country)
668 || $self->ut_zip('ship_zip', $self->ship_country)
670 return $error if $error;
672 } else { # ship_ info eq billing info, so don't store dup info in database
673 $self->setfield("ship_$_", '')
674 foreach qw( last first company address1 address2 city county state zip
675 country daytime night fax );
679 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
680 or return "Illegal payby: ". $self->payby;
683 if ( $self->payby eq 'CARD' ) {
685 my $payinfo = $self->payinfo;
687 $payinfo =~ /^(\d{13,16})$/
688 or return gettext('invalid_card'); # . ": ". $self->payinfo;
690 $self->payinfo($payinfo);
692 or return gettext('invalid_card'); # . ": ". $self->payinfo;
693 return gettext('unknown_card_type')
694 if cardtype($self->payinfo) eq "Unknown";
696 } elsif ( $self->payby eq 'CHEK' ) {
698 my $payinfo = $self->payinfo;
699 $payinfo =~ s/[^\d\@]//g;
700 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
702 $self->payinfo($payinfo);
704 } elsif ( $self->payby eq 'LECB' ) {
706 my $payinfo = $self->payinfo;
708 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
710 $self->payinfo($payinfo);
712 } elsif ( $self->payby eq 'BILL' ) {
714 $error = $self->ut_textn('payinfo');
715 return "Illegal P.O. number: ". $self->payinfo if $error;
717 } elsif ( $self->payby eq 'COMP' ) {
719 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
720 return "You are not permitted to create complimentary accounts."
721 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
724 $error = $self->ut_textn('payinfo');
725 return "Illegal comp account issuer: ". $self->payinfo if $error;
727 } elsif ( $self->payby eq 'PREPAY' ) {
729 my $payinfo = $self->payinfo;
730 $payinfo =~ s/\W//g; #anything else would just confuse things
731 $self->payinfo($payinfo);
732 $error = $self->ut_alpha('payinfo');
733 return "Illegal prepayment identifier: ". $self->payinfo if $error;
734 return "Unknown prepayment identifier"
735 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
739 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
740 return "Expriation date required"
741 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
744 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
745 or return "Illegal expiration date: ". $self->paydate;
746 my $y = length($2) == 4 ? $2 : "20$2";
747 $self->paydate("$y-$1-01");
748 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
749 return gettext('expired_card')
750 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
753 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
754 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
755 $self->payname( $self->first. " ". $self->getfield('last') );
757 $self->payname =~ /^([\w \,\.\-\']+)$/
758 or return gettext('illegal_name'). " payname: ". $self->payname;
762 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
765 $self->otaker(getotaker);
767 #warn "AFTER: \n". $self->_dump;
774 Returns all packages (see L<FS::cust_pkg>) for this customer.
780 if ( $self->{'_pkgnum'} ) {
781 values %{ $self->{'_pkgnum'}->cache };
783 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
787 =item ncancelled_pkgs
789 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
793 sub ncancelled_pkgs {
795 if ( $self->{'_pkgnum'} ) {
796 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
798 @{ [ # force list context
799 qsearch( 'cust_pkg', {
800 'custnum' => $self->custnum,
803 qsearch( 'cust_pkg', {
804 'custnum' => $self->custnum,
813 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
819 grep { $_->susp } $self->ncancelled_pkgs;
822 =item unflagged_suspended_pkgs
824 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
825 customer (thouse packages without the `manual_flag' set).
829 sub unflagged_suspended_pkgs {
831 return $self->suspended_pkgs
832 unless dbdef->table('cust_pkg')->column('manual_flag');
833 grep { ! $_->manual_flag } $self->suspended_pkgs;
836 =item unsuspended_pkgs
838 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
843 sub unsuspended_pkgs {
845 grep { ! $_->susp } $self->ncancelled_pkgs;
850 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
851 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
852 on success or a list of errors.
858 grep { $_->unsuspend } $self->suspended_pkgs;
863 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
864 Always returns a list: an empty list on success or a list of errors.
870 grep { $_->suspend } $self->unsuspended_pkgs;
875 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
876 Always returns a list: an empty list on success or a list of errors.
882 grep { $_->cancel } $self->ncancelled_pkgs;
887 Returns the agent (see L<FS::agent>) for this customer.
893 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
898 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
899 conjunction with the collect method.
901 Options are passed as name-value pairs.
903 The only currently available option is `time', which bills the customer as if
904 it were that time. It is specified as a UNIX timestamp; see
905 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
906 functions. For example:
910 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
912 If there is an error, returns the error, otherwise returns false.
917 my( $self, %options ) = @_;
918 my $time = $options{'time'} || time;
923 local $SIG{HUP} = 'IGNORE';
924 local $SIG{INT} = 'IGNORE';
925 local $SIG{QUIT} = 'IGNORE';
926 local $SIG{TERM} = 'IGNORE';
927 local $SIG{TSTP} = 'IGNORE';
928 local $SIG{PIPE} = 'IGNORE';
930 my $oldAutoCommit = $FS::UID::AutoCommit;
931 local $FS::UID::AutoCommit = 0;
934 # find the packages which are due for billing, find out how much they are
935 # & generate invoice database.
937 my( $total_setup, $total_recur ) = ( 0, 0 );
938 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
939 my @cust_bill_pkg = ();
941 #my $taxable_charged = 0;##
944 foreach my $cust_pkg (
945 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
948 #NO!! next if $cust_pkg->cancel;
949 next if $cust_pkg->getfield('cancel');
951 #? to avoid use of uninitialized value errors... ?
952 $cust_pkg->setfield('bill', '')
953 unless defined($cust_pkg->bill);
955 my $part_pkg = $cust_pkg->part_pkg;
957 #so we don't modify cust_pkg record unnecessarily
958 my $cust_pkg_mod_flag = 0;
959 my %hash = $cust_pkg->hash;
960 my $old_cust_pkg = new FS::cust_pkg \%hash;
964 unless ( $cust_pkg->setup ) {
965 my $setup_prog = $part_pkg->getfield('setup');
966 $setup_prog =~ /^(.*)$/ or do {
967 $dbh->rollback if $oldAutoCommit;
968 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
972 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
975 ##$cpt->permit(); #what is necessary?
976 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
977 #$setup = $cpt->reval($setup_prog);
978 $setup = eval $setup_prog;
979 unless ( defined($setup) ) {
980 $dbh->rollback if $oldAutoCommit;
981 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
982 "(expression $setup_prog): $@";
984 $cust_pkg->setfield('setup',$time);
985 $cust_pkg_mod_flag=1;
991 if ( $part_pkg->getfield('freq') > 0 &&
992 ! $cust_pkg->getfield('susp') &&
993 ( $cust_pkg->getfield('bill') || 0 ) <= $time
995 my $recur_prog = $part_pkg->getfield('recur');
996 $recur_prog =~ /^(.*)$/ or do {
997 $dbh->rollback if $oldAutoCommit;
998 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1002 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1004 # shared with $recur_prog
1005 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1007 #my $cpt = new Safe;
1008 ##$cpt->permit(); #what is necessary?
1009 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1010 #$recur = $cpt->reval($recur_prog);
1011 $recur = eval $recur_prog;
1012 unless ( defined($recur) ) {
1013 $dbh->rollback if $oldAutoCommit;
1014 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1015 "(expression $recur_prog): $@";
1017 #change this bit to use Date::Manip? CAREFUL with timezones (see
1018 # mailing list archive)
1019 my ($sec,$min,$hour,$mday,$mon,$year) =
1020 (localtime($sdate) )[0,1,2,3,4,5];
1022 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1023 # only for figuring next bill date, nothing else, so, reset $sdate again
1025 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1026 $cust_pkg->last_bill($sdate)
1027 if $cust_pkg->dbdef_table->column('last_bill');
1029 $mon += $part_pkg->freq;
1030 until ( $mon < 12 ) { $mon -= 12; $year++; }
1031 $cust_pkg->setfield('bill',
1032 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1033 $cust_pkg_mod_flag = 1;
1036 warn "\$setup is undefined" unless defined($setup);
1037 warn "\$recur is undefined" unless defined($recur);
1038 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1040 my $taxable_charged = 0;
1041 if ( $cust_pkg_mod_flag ) {
1042 $error=$cust_pkg->replace($old_cust_pkg);
1043 if ( $error ) { #just in case
1044 $dbh->rollback if $oldAutoCommit;
1045 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1047 $setup = sprintf( "%.2f", $setup );
1048 $recur = sprintf( "%.2f", $recur );
1050 $dbh->rollback if $oldAutoCommit;
1051 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1054 $dbh->rollback if $oldAutoCommit;
1055 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1057 if ( $setup > 0 || $recur > 0 ) {
1058 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1059 'pkgnum' => $cust_pkg->pkgnum,
1063 'edate' => $cust_pkg->bill,
1065 push @cust_bill_pkg, $cust_bill_pkg;
1066 $total_setup += $setup;
1067 $total_recur += $recur;
1068 $taxable_charged += $setup
1069 unless $part_pkg->setuptax =~ /^Y$/i;
1070 $taxable_charged += $recur
1071 unless $part_pkg->recurtax =~ /^Y$/i;
1073 unless ( $self->tax =~ /Y/i
1074 || $self->payby eq 'COMP'
1075 || $taxable_charged == 0 ) {
1077 my $cust_main_county = qsearchs('cust_main_county',{
1078 'state' => $self->state,
1079 'county' => $self->county,
1080 'country' => $self->country,
1081 'taxclass' => $part_pkg->taxclass,
1083 $cust_main_county ||= qsearchs('cust_main_county',{
1084 'state' => $self->state,
1085 'county' => $self->county,
1086 'country' => $self->country,
1089 unless ( $cust_main_county ) {
1090 $dbh->rollback if $oldAutoCommit;
1092 "fatal: can't find tax rate for state/county/country/taxclass ".
1093 join('/', ( map $self->$_(), qw(state county country) ),
1094 $part_pkg->taxclass ). "\n";
1097 if ( $cust_main_county->exempt_amount ) {
1098 my ($mon,$year) = (localtime($sdate) )[4,5];
1100 my $freq = $part_pkg->freq || 1;
1101 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1102 foreach my $which_month ( 1 .. $freq ) {
1104 'custnum' => $self->custnum,
1105 'taxnum' => $cust_main_county->taxnum,
1106 'year' => 1900+$year,
1109 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1110 until ( $mon < 13 ) { $mon -= 12; $year++; }
1111 my $cust_tax_exempt =
1112 qsearchs('cust_tax_exempt', \%hash)
1113 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1114 my $remaining_exemption = sprintf("%.2f",
1115 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1116 if ( $remaining_exemption > 0 ) {
1117 my $addl = $remaining_exemption > $taxable_per_month
1118 ? $taxable_per_month
1119 : $remaining_exemption;
1120 $taxable_charged -= $addl;
1121 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1122 $cust_tax_exempt->hash,
1123 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1125 $error = $new_cust_tax_exempt->exemptnum
1126 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1127 : $new_cust_tax_exempt->insert;
1129 $dbh->rollback if $oldAutoCommit;
1130 return "fatal: can't update cust_tax_exempt: $error";
1133 } # if $remaining_exemption > 0
1135 } #foreach $which_month
1137 } #if $cust_main_county->exempt_amount
1139 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1140 $tax += $taxable_charged * $cust_main_county->tax / 100
1142 } #unless $self->tax =~ /Y/i
1143 # || $self->payby eq 'COMP'
1144 # || $taxable_charged == 0
1146 } #if $setup > 0 || $recur > 0
1148 } #if $cust_pkg_mod_flag
1150 } #foreach my $cust_pkg
1152 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1153 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1155 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1160 # unless ( $self->tax =~ /Y/i
1161 # || $self->payby eq 'COMP'
1162 # || $taxable_charged == 0 ) {
1163 # my $cust_main_county = qsearchs('cust_main_county',{
1164 # 'state' => $self->state,
1165 # 'county' => $self->county,
1166 # 'country' => $self->country,
1167 # } ) or die "fatal: can't find tax rate for state/county/country ".
1168 # $self->state. "/". $self->county. "/". $self->country. "\n";
1169 # my $tax = sprintf( "%.2f",
1170 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1173 $tax = sprintf("%.2f", $tax);
1175 $charged = sprintf( "%.2f", $charged+$tax );
1177 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1184 push @cust_bill_pkg, $cust_bill_pkg;
1188 my $cust_bill = new FS::cust_bill ( {
1189 'custnum' => $self->custnum,
1191 'charged' => $charged,
1193 $error = $cust_bill->insert;
1195 $dbh->rollback if $oldAutoCommit;
1196 return "can't create invoice for customer #". $self->custnum. ": $error";
1199 my $invnum = $cust_bill->invnum;
1201 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1203 $cust_bill_pkg->invnum($invnum);
1204 $error = $cust_bill_pkg->insert;
1206 $dbh->rollback if $oldAutoCommit;
1207 return "can't create invoice line item for customer #". $self->custnum.
1212 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1216 =item collect OPTIONS
1218 (Attempt to) collect money for this customer's outstanding invoices (see
1219 L<FS::cust_bill>). Usually used after the bill method.
1221 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1222 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1224 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1225 and the invoice events web interface.
1227 If there is an error, returns the error, otherwise returns false.
1229 Options are passed as name-value pairs.
1231 Currently available options are:
1233 invoice_time - Use this time when deciding when to print invoices and
1234 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>
1235 for conversion functions.
1237 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1240 retry_card - Deprecated alias for 'retry'
1242 batch_card - This option is deprecated. See the invoice events web interface
1243 to control whether cards are batched or run against a realtime gateway.
1245 report_badcard - This option is deprecated.
1247 force_print - This option is deprecated; see the invoice events web interface.
1249 quiet - set true to surpress email card/ACH decline notices.
1254 my( $self, %options ) = @_;
1255 my $invoice_time = $options{'invoice_time'} || time;
1258 local $SIG{HUP} = 'IGNORE';
1259 local $SIG{INT} = 'IGNORE';
1260 local $SIG{QUIT} = 'IGNORE';
1261 local $SIG{TERM} = 'IGNORE';
1262 local $SIG{TSTP} = 'IGNORE';
1263 local $SIG{PIPE} = 'IGNORE';
1265 my $oldAutoCommit = $FS::UID::AutoCommit;
1266 local $FS::UID::AutoCommit = 0;
1269 my $balance = $self->balance;
1270 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1271 unless ( $balance > 0 ) { #redundant?????
1272 $dbh->rollback if $oldAutoCommit; #hmm
1276 if ( exists($options{'retry_card'}) ) {
1277 carp 'retry_card option passed to collect is deprecated; use retry';
1278 $options{'retry'} ||= $options{'retry_card'};
1280 if ( exists($options{'retry'}) && $options{'retry'} ) {
1281 my $error = $self->retry_realtime;
1283 $dbh->rollback if $oldAutoCommit;
1288 foreach my $cust_bill ( $self->cust_bill ) {
1290 #this has to be before next's
1291 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1295 $balance = sprintf( "%.2f", $balance - $amount );
1297 next unless $cust_bill->owed > 0;
1299 # don't try to charge for the same invoice if it's already in a batch
1300 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1302 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1304 next unless $amount > 0;
1307 foreach my $part_bill_event (
1308 sort { $a->seconds <=> $b->seconds
1309 || $a->weight <=> $b->weight
1310 || $a->eventpart <=> $b->eventpart }
1311 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1312 && ! qsearchs( 'cust_bill_event', {
1313 'invnum' => $cust_bill->invnum,
1314 'eventpart' => $_->eventpart,
1318 qsearch('part_bill_event', { 'payby' => $self->payby,
1319 'disabled' => '', } )
1322 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1324 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1326 my $cust_main = $self; #for callback
1327 my $error = eval $part_bill_event->eventcode;
1330 my $statustext = '';
1334 } elsif ( $error ) {
1336 $statustext = $error;
1341 #add cust_bill_event
1342 my $cust_bill_event = new FS::cust_bill_event {
1343 'invnum' => $cust_bill->invnum,
1344 'eventpart' => $part_bill_event->eventpart,
1345 #'_date' => $invoice_time,
1347 'status' => $status,
1348 'statustext' => $statustext,
1350 $error = $cust_bill_event->insert;
1352 #$dbh->rollback if $oldAutoCommit;
1353 #return "error: $error";
1355 # gah, even with transactions.
1356 $dbh->commit if $oldAutoCommit; #well.
1357 my $e = 'WARNING: Event run but database not updated - '.
1358 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1359 ', eventpart '. $part_bill_event->eventpart.
1370 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1375 =item retry_realtime
1377 Schedules realtime credit card / electronic check / LEC billing events for
1378 for retry. Useful if card information has changed or manual retry is desired.
1379 The 'collect' method must be called to actually retry the transaction.
1381 Implementation details: For each of this customer's open invoices, changes
1382 the status of the first "done" (with statustext error) realtime processing
1387 sub retry_realtime {
1390 local $SIG{HUP} = 'IGNORE';
1391 local $SIG{INT} = 'IGNORE';
1392 local $SIG{QUIT} = 'IGNORE';
1393 local $SIG{TERM} = 'IGNORE';
1394 local $SIG{TSTP} = 'IGNORE';
1395 local $SIG{PIPE} = 'IGNORE';
1397 my $oldAutoCommit = $FS::UID::AutoCommit;
1398 local $FS::UID::AutoCommit = 0;
1401 foreach my $cust_bill (
1402 grep { $_->cust_bill_event }
1403 $self->open_cust_bill
1405 my @cust_bill_event =
1406 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1408 #$_->part_bill_event->plan eq 'realtime-card'
1409 $_->part_bill_event->eventcode =~
1410 /\$cust_bill\->realtime_(card|ach|lec)/
1411 && $_->status eq 'done'
1414 $cust_bill->cust_bill_event;
1415 next unless @cust_bill_event;
1416 my $error = $cust_bill_event[0]->retry;
1418 $dbh->rollback if $oldAutoCommit;
1419 return "error scheduling invoice event for retry: $error";
1424 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1431 Returns the total owed for this customer on all invoices
1432 (see L<FS::cust_bill/owed>).
1438 $self->total_owed_date(2145859200); #12/31/2037
1441 =item total_owed_date TIME
1443 Returns the total owed for this customer on all invoices with date earlier than
1444 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1445 see L<Time::Local> and L<Date::Parse> for conversion functions.
1449 sub total_owed_date {
1453 foreach my $cust_bill (
1454 grep { $_->_date <= $time }
1455 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1457 $total_bill += $cust_bill->owed;
1459 sprintf( "%.2f", $total_bill );
1464 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1465 to outstanding invoice balances in chronological order and returns the value
1466 of any remaining unapplied credits available for refund
1467 (see L<FS::cust_refund>).
1474 return 0 unless $self->total_credited;
1476 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1477 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1479 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1480 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1484 foreach my $cust_bill ( @invoices ) {
1487 if ( !defined($credit) || $credit->credited == 0) {
1488 $credit = pop @credits or last;
1491 if ($cust_bill->owed >= $credit->credited) {
1492 $amount=$credit->credited;
1494 $amount=$cust_bill->owed;
1497 my $cust_credit_bill = new FS::cust_credit_bill ( {
1498 'crednum' => $credit->crednum,
1499 'invnum' => $cust_bill->invnum,
1500 'amount' => $amount,
1502 my $error = $cust_credit_bill->insert;
1503 die $error if $error;
1505 redo if ($cust_bill->owed > 0);
1509 return $self->total_credited;
1512 =item apply_payments
1514 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1515 to outstanding invoice balances in chronological order.
1517 #and returns the value of any remaining unapplied payments.
1521 sub apply_payments {
1526 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1527 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1529 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1530 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1534 foreach my $cust_bill ( @invoices ) {
1537 if ( !defined($payment) || $payment->unapplied == 0 ) {
1538 $payment = pop @payments or last;
1541 if ( $cust_bill->owed >= $payment->unapplied ) {
1542 $amount = $payment->unapplied;
1544 $amount = $cust_bill->owed;
1547 my $cust_bill_pay = new FS::cust_bill_pay ( {
1548 'paynum' => $payment->paynum,
1549 'invnum' => $cust_bill->invnum,
1550 'amount' => $amount,
1552 my $error = $cust_bill_pay->insert;
1553 die $error if $error;
1555 redo if ( $cust_bill->owed > 0);
1559 return $self->total_unapplied_payments;
1562 =item total_credited
1564 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1565 customer. See L<FS::cust_credit/credited>.
1569 sub total_credited {
1571 my $total_credit = 0;
1572 foreach my $cust_credit ( qsearch('cust_credit', {
1573 'custnum' => $self->custnum,
1575 $total_credit += $cust_credit->credited;
1577 sprintf( "%.2f", $total_credit );
1580 =item total_unapplied_payments
1582 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1583 See L<FS::cust_pay/unapplied>.
1587 sub total_unapplied_payments {
1589 my $total_unapplied = 0;
1590 foreach my $cust_pay ( qsearch('cust_pay', {
1591 'custnum' => $self->custnum,
1593 $total_unapplied += $cust_pay->unapplied;
1595 sprintf( "%.2f", $total_unapplied );
1600 Returns the balance for this customer (total_owed minus total_credited
1601 minus total_unapplied_payments).
1608 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1612 =item balance_date TIME
1614 Returns the balance for this customer, only considering invoices with date
1615 earlier than TIME (total_owed_date minus total_credited minus
1616 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1617 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1626 $self->total_owed_date($time)
1627 - $self->total_credited
1628 - $self->total_unapplied_payments
1632 =item invoicing_list [ ARRAYREF ]
1634 If an arguement is given, sets these email addresses as invoice recipients
1635 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1636 (except as warnings), so use check_invoicing_list first.
1638 Returns a list of email addresses (with svcnum entries expanded).
1640 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1641 check it without disturbing anything by passing nothing.
1643 This interface may change in the future.
1647 sub invoicing_list {
1648 my( $self, $arrayref ) = @_;
1650 my @cust_main_invoice;
1651 if ( $self->custnum ) {
1652 @cust_main_invoice =
1653 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1655 @cust_main_invoice = ();
1657 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1658 #warn $cust_main_invoice->destnum;
1659 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1660 #warn $cust_main_invoice->destnum;
1661 my $error = $cust_main_invoice->delete;
1662 warn $error if $error;
1665 if ( $self->custnum ) {
1666 @cust_main_invoice =
1667 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1669 @cust_main_invoice = ();
1671 my %seen = map { $_->address => 1 } @cust_main_invoice;
1672 foreach my $address ( @{$arrayref} ) {
1673 next if exists $seen{$address} && $seen{$address};
1674 $seen{$address} = 1;
1675 my $cust_main_invoice = new FS::cust_main_invoice ( {
1676 'custnum' => $self->custnum,
1679 my $error = $cust_main_invoice->insert;
1680 warn $error if $error;
1683 if ( $self->custnum ) {
1685 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1691 =item check_invoicing_list ARRAYREF
1693 Checks these arguements as valid input for the invoicing_list method. If there
1694 is an error, returns the error, otherwise returns false.
1698 sub check_invoicing_list {
1699 my( $self, $arrayref ) = @_;
1700 foreach my $address ( @{$arrayref} ) {
1701 my $cust_main_invoice = new FS::cust_main_invoice ( {
1702 'custnum' => $self->custnum,
1705 my $error = $self->custnum
1706 ? $cust_main_invoice->check
1707 : $cust_main_invoice->checkdest
1709 return $error if $error;
1714 =item set_default_invoicing_list
1716 Sets the invoicing list to all accounts associated with this customer,
1717 overwriting any previous invoicing list.
1721 sub set_default_invoicing_list {
1723 $self->invoicing_list($self->all_emails);
1728 Returns the email addresses of all accounts provisioned for this customer.
1735 foreach my $cust_pkg ( $self->all_pkgs ) {
1736 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1738 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1739 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1741 $list{$_}=1 foreach map { $_->email } @svc_acct;
1746 =item invoicing_list_addpost
1748 Adds postal invoicing to this customer. If this customer is already configured
1749 to receive postal invoices, does nothing.
1753 sub invoicing_list_addpost {
1755 return if grep { $_ eq 'POST' } $self->invoicing_list;
1756 my @invoicing_list = $self->invoicing_list;
1757 push @invoicing_list, 'POST';
1758 $self->invoicing_list(\@invoicing_list);
1761 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1763 Returns an array of customers referred by this customer (referral_custnum set
1764 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1765 customers referred by customers referred by this customer and so on, inclusive.
1766 The default behavior is DEPTH 1 (no recursion).
1770 sub referral_cust_main {
1772 my $depth = @_ ? shift : 1;
1773 my $exclude = @_ ? shift : {};
1776 map { $exclude->{$_->custnum}++; $_; }
1777 grep { ! $exclude->{ $_->custnum } }
1778 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1782 map { $_->referral_cust_main($depth-1, $exclude) }
1789 =item referral_cust_main_ncancelled
1791 Same as referral_cust_main, except only returns customers with uncancelled
1796 sub referral_cust_main_ncancelled {
1798 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1801 =item referral_cust_pkg [ DEPTH ]
1803 Like referral_cust_main, except returns a flat list of all unsuspended (and
1804 uncancelled) packages for each customer. The number of items in this list may
1805 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1809 sub referral_cust_pkg {
1811 my $depth = @_ ? shift : 1;
1813 map { $_->unsuspended_pkgs }
1814 grep { $_->unsuspended_pkgs }
1815 $self->referral_cust_main($depth);
1818 =item credit AMOUNT, REASON
1820 Applies a credit to this customer. If there is an error, returns the error,
1821 otherwise returns false.
1826 my( $self, $amount, $reason ) = @_;
1827 my $cust_credit = new FS::cust_credit {
1828 'custnum' => $self->custnum,
1829 'amount' => $amount,
1830 'reason' => $reason,
1832 $cust_credit->insert;
1835 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1837 Creates a one-time charge for this customer. If there is an error, returns
1838 the error, otherwise returns false.
1843 my ( $self, $amount ) = ( shift, shift );
1844 my $pkg = @_ ? shift : 'One-time charge';
1845 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1846 my $taxclass = @_ ? shift : '';
1848 local $SIG{HUP} = 'IGNORE';
1849 local $SIG{INT} = 'IGNORE';
1850 local $SIG{QUIT} = 'IGNORE';
1851 local $SIG{TERM} = 'IGNORE';
1852 local $SIG{TSTP} = 'IGNORE';
1853 local $SIG{PIPE} = 'IGNORE';
1855 my $oldAutoCommit = $FS::UID::AutoCommit;
1856 local $FS::UID::AutoCommit = 0;
1859 my $part_pkg = new FS::part_pkg ( {
1861 'comment' => $comment,
1866 'taxclass' => $taxclass,
1869 my $error = $part_pkg->insert;
1871 $dbh->rollback if $oldAutoCommit;
1875 my $pkgpart = $part_pkg->pkgpart;
1876 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1877 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1878 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1879 $error = $type_pkgs->insert;
1881 $dbh->rollback if $oldAutoCommit;
1886 my $cust_pkg = new FS::cust_pkg ( {
1887 'custnum' => $self->custnum,
1888 'pkgpart' => $pkgpart,
1891 $error = $cust_pkg->insert;
1893 $dbh->rollback if $oldAutoCommit;
1897 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1904 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1910 sort { $a->_date <=> $b->_date }
1911 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1914 =item open_cust_bill
1916 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1921 sub open_cust_bill {
1923 grep { $_->owed > 0 } $self->cust_bill;
1932 =item check_and_rebuild_fuzzyfiles
1936 sub check_and_rebuild_fuzzyfiles {
1937 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1938 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1939 or &rebuild_fuzzyfiles;
1942 =item rebuild_fuzzyfiles
1946 sub rebuild_fuzzyfiles {
1948 use Fcntl qw(:flock);
1950 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1954 open(LASTLOCK,">>$dir/cust_main.last")
1955 or die "can't open $dir/cust_main.last: $!";
1956 flock(LASTLOCK,LOCK_EX)
1957 or die "can't lock $dir/cust_main.last: $!";
1959 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1961 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1962 if defined dbdef->table('cust_main')->column('ship_last');
1964 open (LASTCACHE,">$dir/cust_main.last.tmp")
1965 or die "can't open $dir/cust_main.last.tmp: $!";
1966 print LASTCACHE join("\n", @all_last), "\n";
1967 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1969 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1974 open(COMPANYLOCK,">>$dir/cust_main.company")
1975 or die "can't open $dir/cust_main.company: $!";
1976 flock(COMPANYLOCK,LOCK_EX)
1977 or die "can't lock $dir/cust_main.company: $!";
1979 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1981 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1982 if defined dbdef->table('cust_main')->column('ship_last');
1984 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1985 or die "can't open $dir/cust_main.company.tmp: $!";
1986 print COMPANYCACHE join("\n", @all_company), "\n";
1987 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1989 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1999 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2000 open(LASTCACHE,"<$dir/cust_main.last")
2001 or die "can't open $dir/cust_main.last: $!";
2002 my @array = map { chomp; $_; } <LASTCACHE>;
2012 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2013 open(COMPANYCACHE,"<$dir/cust_main.company")
2014 or die "can't open $dir/cust_main.last: $!";
2015 my @array = map { chomp; $_; } <COMPANYCACHE>;
2020 =item append_fuzzyfiles LASTNAME COMPANY
2024 sub append_fuzzyfiles {
2025 my( $last, $company ) = @_;
2027 &check_and_rebuild_fuzzyfiles;
2029 use Fcntl qw(:flock);
2031 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2035 open(LAST,">>$dir/cust_main.last")
2036 or die "can't open $dir/cust_main.last: $!";
2038 or die "can't lock $dir/cust_main.last: $!";
2040 print LAST "$last\n";
2043 or die "can't unlock $dir/cust_main.last: $!";
2049 open(COMPANY,">>$dir/cust_main.company")
2050 or die "can't open $dir/cust_main.company: $!";
2051 flock(COMPANY,LOCK_EX)
2052 or die "can't lock $dir/cust_main.company: $!";
2054 print COMPANY "$company\n";
2056 flock(COMPANY,LOCK_UN)
2057 or die "can't unlock $dir/cust_main.company: $!";
2071 #warn join('-',keys %$param);
2072 my $fh = $param->{filehandle};
2073 my $agentnum = $param->{agentnum};
2074 my $refnum = $param->{refnum};
2075 my $pkgpart = $param->{pkgpart};
2076 my @fields = @{$param->{fields}};
2078 eval "use Date::Parse;";
2080 eval "use Text::CSV_XS;";
2083 my $csv = new Text::CSV_XS;
2090 local $SIG{HUP} = 'IGNORE';
2091 local $SIG{INT} = 'IGNORE';
2092 local $SIG{QUIT} = 'IGNORE';
2093 local $SIG{TERM} = 'IGNORE';
2094 local $SIG{TSTP} = 'IGNORE';
2095 local $SIG{PIPE} = 'IGNORE';
2097 my $oldAutoCommit = $FS::UID::AutoCommit;
2098 local $FS::UID::AutoCommit = 0;
2101 #while ( $columns = $csv->getline($fh) ) {
2103 while ( defined($line=<$fh>) ) {
2105 $csv->parse($line) or do {
2106 $dbh->rollback if $oldAutoCommit;
2107 return "can't parse: ". $csv->error_input();
2110 my @columns = $csv->fields();
2111 #warn join('-',@columns);
2114 agentnum => $agentnum,
2116 country => 'US', #default
2117 payby => 'BILL', #default
2118 paydate => '12/2037', #default
2120 my $billtime = time;
2121 my %cust_pkg = ( pkgpart => $pkgpart );
2122 foreach my $field ( @fields ) {
2123 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2124 #$cust_pkg{$1} = str2time( shift @$columns );
2125 if ( $1 eq 'setup' ) {
2126 $billtime = str2time(shift @columns);
2128 $cust_pkg{$1} = str2time( shift @columns );
2131 #$cust_main{$field} = shift @$columns;
2132 $cust_main{$field} = shift @columns;
2136 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2137 my $cust_main = new FS::cust_main ( \%cust_main );
2139 tie my %hash, 'Tie::RefHash'; #this part is important
2140 $hash{$cust_pkg} = [] if $pkgpart;
2141 my $error = $cust_main->insert( \%hash );
2144 $dbh->rollback if $oldAutoCommit;
2145 return "can't insert customer for $line: $error";
2148 #false laziness w/bill.cgi
2149 $error = $cust_main->bill( 'time' => $billtime );
2151 $dbh->rollback if $oldAutoCommit;
2152 return "can't bill customer for $line: $error";
2155 $cust_main->apply_payments;
2156 $cust_main->apply_credits;
2158 $error = $cust_main->collect();
2160 $dbh->rollback if $oldAutoCommit;
2161 return "can't collect customer for $line: $error";
2167 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2169 return "Empty file!" unless $imported;
2181 #warn join('-',keys %$param);
2182 my $fh = $param->{filehandle};
2183 my @fields = @{$param->{fields}};
2185 eval "use Date::Parse;";
2187 eval "use Text::CSV_XS;";
2190 my $csv = new Text::CSV_XS;
2197 local $SIG{HUP} = 'IGNORE';
2198 local $SIG{INT} = 'IGNORE';
2199 local $SIG{QUIT} = 'IGNORE';
2200 local $SIG{TERM} = 'IGNORE';
2201 local $SIG{TSTP} = 'IGNORE';
2202 local $SIG{PIPE} = 'IGNORE';
2204 my $oldAutoCommit = $FS::UID::AutoCommit;
2205 local $FS::UID::AutoCommit = 0;
2208 #while ( $columns = $csv->getline($fh) ) {
2210 while ( defined($line=<$fh>) ) {
2212 $csv->parse($line) or do {
2213 $dbh->rollback if $oldAutoCommit;
2214 return "can't parse: ". $csv->error_input();
2217 my @columns = $csv->fields();
2218 #warn join('-',@columns);
2221 foreach my $field ( @fields ) {
2222 $row{$field} = shift @columns;
2225 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2226 unless ( $cust_main ) {
2227 $dbh->rollback if $oldAutoCommit;
2228 return "unknown custnum $row{'custnum'}";
2231 if ( $row{'amount'} > 0 ) {
2232 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2234 $dbh->rollback if $oldAutoCommit;
2238 } elsif ( $row{'amount'} < 0 ) {
2239 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2242 $dbh->rollback if $oldAutoCommit;
2252 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2254 return "Empty file!" unless $imported;
2266 The delete method should possibly take an FS::cust_main object reference
2267 instead of a scalar customer number.
2269 Bill and collect options should probably be passed as references instead of a
2272 There should probably be a configuration file with a list of allowed credit
2275 No multiple currency support (probably a larger project than just this module).
2279 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2280 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2281 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.