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.
1252 my( $self, %options ) = @_;
1253 my $invoice_time = $options{'invoice_time'} || time;
1256 local $SIG{HUP} = 'IGNORE';
1257 local $SIG{INT} = 'IGNORE';
1258 local $SIG{QUIT} = 'IGNORE';
1259 local $SIG{TERM} = 'IGNORE';
1260 local $SIG{TSTP} = 'IGNORE';
1261 local $SIG{PIPE} = 'IGNORE';
1263 my $oldAutoCommit = $FS::UID::AutoCommit;
1264 local $FS::UID::AutoCommit = 0;
1267 my $balance = $self->balance;
1268 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1269 unless ( $balance > 0 ) { #redundant?????
1270 $dbh->rollback if $oldAutoCommit; #hmm
1274 if ( exists($options{'retry_card'}) ) {
1275 carp 'retry_card option passed to collect is deprecated; use retry';
1276 $options{'retry'} ||= $options{'retry_card'};
1278 if ( exists($options{'retry'}) && $options{'retry'} ) {
1279 my $error = $self->retry_realtime;
1281 $dbh->rollback if $oldAutoCommit;
1286 foreach my $cust_bill ( $self->cust_bill ) {
1288 #this has to be before next's
1289 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1293 $balance = sprintf( "%.2f", $balance - $amount );
1295 next unless $cust_bill->owed > 0;
1297 # don't try to charge for the same invoice if it's already in a batch
1298 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1300 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1302 next unless $amount > 0;
1305 foreach my $part_bill_event (
1306 sort { $a->seconds <=> $b->seconds
1307 || $a->weight <=> $b->weight
1308 || $a->eventpart <=> $b->eventpart }
1309 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1310 && ! qsearchs( 'cust_bill_event', {
1311 'invnum' => $cust_bill->invnum,
1312 'eventpart' => $_->eventpart,
1316 qsearch('part_bill_event', { 'payby' => $self->payby,
1317 'disabled' => '', } )
1320 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1322 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1324 my $cust_main = $self; #for callback
1325 my $error = eval $part_bill_event->eventcode;
1328 my $statustext = '';
1332 } elsif ( $error ) {
1334 $statustext = $error;
1339 #add cust_bill_event
1340 my $cust_bill_event = new FS::cust_bill_event {
1341 'invnum' => $cust_bill->invnum,
1342 'eventpart' => $part_bill_event->eventpart,
1343 #'_date' => $invoice_time,
1345 'status' => $status,
1346 'statustext' => $statustext,
1348 $error = $cust_bill_event->insert;
1350 #$dbh->rollback if $oldAutoCommit;
1351 #return "error: $error";
1353 # gah, even with transactions.
1354 $dbh->commit if $oldAutoCommit; #well.
1355 my $e = 'WARNING: Event run but database not updated - '.
1356 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1357 ', eventpart '. $part_bill_event->eventpart.
1368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1373 =item retry_realtime
1375 Schedules realtime credit card / electronic check / LEC billing events for
1376 for retry. Useful if card information has changed or manual retry is desired.
1377 The 'collect' method must be called to actually retry the transaction.
1379 Implementation details: For each of this customer's open invoices, changes
1380 the status of the first "done" (with statustext error) realtime processing
1385 sub retry_realtime {
1388 local $SIG{HUP} = 'IGNORE';
1389 local $SIG{INT} = 'IGNORE';
1390 local $SIG{QUIT} = 'IGNORE';
1391 local $SIG{TERM} = 'IGNORE';
1392 local $SIG{TSTP} = 'IGNORE';
1393 local $SIG{PIPE} = 'IGNORE';
1395 my $oldAutoCommit = $FS::UID::AutoCommit;
1396 local $FS::UID::AutoCommit = 0;
1399 foreach my $cust_bill (
1400 grep { $_->cust_bill_event }
1401 $self->open_cust_bill
1403 my @cust_bill_event =
1404 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1406 #$_->part_bill_event->plan eq 'realtime-card'
1407 $_->part_bill_event->eventcode =~
1408 /\$cust_bill\->realtime_(card|ach|lec)/
1409 && $_->status eq 'done'
1412 $cust_bill->cust_bill_event;
1413 next unless @cust_bill_event;
1414 my $error = $cust_bill_event[0]->retry;
1416 $dbh->rollback if $oldAutoCommit;
1417 return "error scheduling invoice event for retry: $error";
1422 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1429 Returns the total owed for this customer on all invoices
1430 (see L<FS::cust_bill/owed>).
1436 $self->total_owed_date(2145859200); #12/31/2037
1439 =item total_owed_date TIME
1441 Returns the total owed for this customer on all invoices with date earlier than
1442 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1443 see L<Time::Local> and L<Date::Parse> for conversion functions.
1447 sub total_owed_date {
1451 foreach my $cust_bill (
1452 grep { $_->_date <= $time }
1453 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1455 $total_bill += $cust_bill->owed;
1457 sprintf( "%.2f", $total_bill );
1462 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1463 to outstanding invoice balances in chronological order and returns the value
1464 of any remaining unapplied credits available for refund
1465 (see L<FS::cust_refund>).
1472 return 0 unless $self->total_credited;
1474 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1475 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1477 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1478 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1482 foreach my $cust_bill ( @invoices ) {
1485 if ( !defined($credit) || $credit->credited == 0) {
1486 $credit = pop @credits or last;
1489 if ($cust_bill->owed >= $credit->credited) {
1490 $amount=$credit->credited;
1492 $amount=$cust_bill->owed;
1495 my $cust_credit_bill = new FS::cust_credit_bill ( {
1496 'crednum' => $credit->crednum,
1497 'invnum' => $cust_bill->invnum,
1498 'amount' => $amount,
1500 my $error = $cust_credit_bill->insert;
1501 die $error if $error;
1503 redo if ($cust_bill->owed > 0);
1507 return $self->total_credited;
1510 =item apply_payments
1512 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1513 to outstanding invoice balances in chronological order.
1515 #and returns the value of any remaining unapplied payments.
1519 sub apply_payments {
1524 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1525 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1527 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1528 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1532 foreach my $cust_bill ( @invoices ) {
1535 if ( !defined($payment) || $payment->unapplied == 0 ) {
1536 $payment = pop @payments or last;
1539 if ( $cust_bill->owed >= $payment->unapplied ) {
1540 $amount = $payment->unapplied;
1542 $amount = $cust_bill->owed;
1545 my $cust_bill_pay = new FS::cust_bill_pay ( {
1546 'paynum' => $payment->paynum,
1547 'invnum' => $cust_bill->invnum,
1548 'amount' => $amount,
1550 my $error = $cust_bill_pay->insert;
1551 die $error if $error;
1553 redo if ( $cust_bill->owed > 0);
1557 return $self->total_unapplied_payments;
1560 =item total_credited
1562 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1563 customer. See L<FS::cust_credit/credited>.
1567 sub total_credited {
1569 my $total_credit = 0;
1570 foreach my $cust_credit ( qsearch('cust_credit', {
1571 'custnum' => $self->custnum,
1573 $total_credit += $cust_credit->credited;
1575 sprintf( "%.2f", $total_credit );
1578 =item total_unapplied_payments
1580 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1581 See L<FS::cust_pay/unapplied>.
1585 sub total_unapplied_payments {
1587 my $total_unapplied = 0;
1588 foreach my $cust_pay ( qsearch('cust_pay', {
1589 'custnum' => $self->custnum,
1591 $total_unapplied += $cust_pay->unapplied;
1593 sprintf( "%.2f", $total_unapplied );
1598 Returns the balance for this customer (total_owed minus total_credited
1599 minus total_unapplied_payments).
1606 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1610 =item balance_date TIME
1612 Returns the balance for this customer, only considering invoices with date
1613 earlier than TIME (total_owed_date minus total_credited minus
1614 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1615 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1624 $self->total_owed_date($time)
1625 - $self->total_credited
1626 - $self->total_unapplied_payments
1630 =item invoicing_list [ ARRAYREF ]
1632 If an arguement is given, sets these email addresses as invoice recipients
1633 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1634 (except as warnings), so use check_invoicing_list first.
1636 Returns a list of email addresses (with svcnum entries expanded).
1638 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1639 check it without disturbing anything by passing nothing.
1641 This interface may change in the future.
1645 sub invoicing_list {
1646 my( $self, $arrayref ) = @_;
1648 my @cust_main_invoice;
1649 if ( $self->custnum ) {
1650 @cust_main_invoice =
1651 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1653 @cust_main_invoice = ();
1655 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1656 #warn $cust_main_invoice->destnum;
1657 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1658 #warn $cust_main_invoice->destnum;
1659 my $error = $cust_main_invoice->delete;
1660 warn $error if $error;
1663 if ( $self->custnum ) {
1664 @cust_main_invoice =
1665 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1667 @cust_main_invoice = ();
1669 my %seen = map { $_->address => 1 } @cust_main_invoice;
1670 foreach my $address ( @{$arrayref} ) {
1671 next if exists $seen{$address} && $seen{$address};
1672 $seen{$address} = 1;
1673 my $cust_main_invoice = new FS::cust_main_invoice ( {
1674 'custnum' => $self->custnum,
1677 my $error = $cust_main_invoice->insert;
1678 warn $error if $error;
1681 if ( $self->custnum ) {
1683 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1689 =item check_invoicing_list ARRAYREF
1691 Checks these arguements as valid input for the invoicing_list method. If there
1692 is an error, returns the error, otherwise returns false.
1696 sub check_invoicing_list {
1697 my( $self, $arrayref ) = @_;
1698 foreach my $address ( @{$arrayref} ) {
1699 my $cust_main_invoice = new FS::cust_main_invoice ( {
1700 'custnum' => $self->custnum,
1703 my $error = $self->custnum
1704 ? $cust_main_invoice->check
1705 : $cust_main_invoice->checkdest
1707 return $error if $error;
1712 =item set_default_invoicing_list
1714 Sets the invoicing list to all accounts associated with this customer,
1715 overwriting any previous invoicing list.
1719 sub set_default_invoicing_list {
1721 $self->invoicing_list($self->all_emails);
1726 Returns the email addresses of all accounts provisioned for this customer.
1733 foreach my $cust_pkg ( $self->all_pkgs ) {
1734 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1736 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1737 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1739 $list{$_}=1 foreach map { $_->email } @svc_acct;
1744 =item invoicing_list_addpost
1746 Adds postal invoicing to this customer. If this customer is already configured
1747 to receive postal invoices, does nothing.
1751 sub invoicing_list_addpost {
1753 return if grep { $_ eq 'POST' } $self->invoicing_list;
1754 my @invoicing_list = $self->invoicing_list;
1755 push @invoicing_list, 'POST';
1756 $self->invoicing_list(\@invoicing_list);
1759 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1761 Returns an array of customers referred by this customer (referral_custnum set
1762 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1763 customers referred by customers referred by this customer and so on, inclusive.
1764 The default behavior is DEPTH 1 (no recursion).
1768 sub referral_cust_main {
1770 my $depth = @_ ? shift : 1;
1771 my $exclude = @_ ? shift : {};
1774 map { $exclude->{$_->custnum}++; $_; }
1775 grep { ! $exclude->{ $_->custnum } }
1776 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1780 map { $_->referral_cust_main($depth-1, $exclude) }
1787 =item referral_cust_main_ncancelled
1789 Same as referral_cust_main, except only returns customers with uncancelled
1794 sub referral_cust_main_ncancelled {
1796 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1799 =item referral_cust_pkg [ DEPTH ]
1801 Like referral_cust_main, except returns a flat list of all unsuspended (and
1802 uncancelled) packages for each customer. The number of items in this list may
1803 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1807 sub referral_cust_pkg {
1809 my $depth = @_ ? shift : 1;
1811 map { $_->unsuspended_pkgs }
1812 grep { $_->unsuspended_pkgs }
1813 $self->referral_cust_main($depth);
1816 =item credit AMOUNT, REASON
1818 Applies a credit to this customer. If there is an error, returns the error,
1819 otherwise returns false.
1824 my( $self, $amount, $reason ) = @_;
1825 my $cust_credit = new FS::cust_credit {
1826 'custnum' => $self->custnum,
1827 'amount' => $amount,
1828 'reason' => $reason,
1830 $cust_credit->insert;
1833 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1835 Creates a one-time charge for this customer. If there is an error, returns
1836 the error, otherwise returns false.
1841 my ( $self, $amount ) = ( shift, shift );
1842 my $pkg = @_ ? shift : 'One-time charge';
1843 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1844 my $taxclass = @_ ? shift : '';
1846 local $SIG{HUP} = 'IGNORE';
1847 local $SIG{INT} = 'IGNORE';
1848 local $SIG{QUIT} = 'IGNORE';
1849 local $SIG{TERM} = 'IGNORE';
1850 local $SIG{TSTP} = 'IGNORE';
1851 local $SIG{PIPE} = 'IGNORE';
1853 my $oldAutoCommit = $FS::UID::AutoCommit;
1854 local $FS::UID::AutoCommit = 0;
1857 my $part_pkg = new FS::part_pkg ( {
1859 'comment' => $comment,
1864 'taxclass' => $taxclass,
1867 my $error = $part_pkg->insert;
1869 $dbh->rollback if $oldAutoCommit;
1873 my $pkgpart = $part_pkg->pkgpart;
1874 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1875 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1876 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1877 $error = $type_pkgs->insert;
1879 $dbh->rollback if $oldAutoCommit;
1884 my $cust_pkg = new FS::cust_pkg ( {
1885 'custnum' => $self->custnum,
1886 'pkgpart' => $pkgpart,
1889 $error = $cust_pkg->insert;
1891 $dbh->rollback if $oldAutoCommit;
1895 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1902 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1908 sort { $a->_date <=> $b->_date }
1909 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1912 =item open_cust_bill
1914 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1919 sub open_cust_bill {
1921 grep { $_->owed > 0 } $self->cust_bill;
1930 =item check_and_rebuild_fuzzyfiles
1934 sub check_and_rebuild_fuzzyfiles {
1935 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1936 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1937 or &rebuild_fuzzyfiles;
1940 =item rebuild_fuzzyfiles
1944 sub rebuild_fuzzyfiles {
1946 use Fcntl qw(:flock);
1948 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1952 open(LASTLOCK,">>$dir/cust_main.last")
1953 or die "can't open $dir/cust_main.last: $!";
1954 flock(LASTLOCK,LOCK_EX)
1955 or die "can't lock $dir/cust_main.last: $!";
1957 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1959 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1960 if defined dbdef->table('cust_main')->column('ship_last');
1962 open (LASTCACHE,">$dir/cust_main.last.tmp")
1963 or die "can't open $dir/cust_main.last.tmp: $!";
1964 print LASTCACHE join("\n", @all_last), "\n";
1965 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1967 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1972 open(COMPANYLOCK,">>$dir/cust_main.company")
1973 or die "can't open $dir/cust_main.company: $!";
1974 flock(COMPANYLOCK,LOCK_EX)
1975 or die "can't lock $dir/cust_main.company: $!";
1977 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1979 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1980 if defined dbdef->table('cust_main')->column('ship_last');
1982 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1983 or die "can't open $dir/cust_main.company.tmp: $!";
1984 print COMPANYCACHE join("\n", @all_company), "\n";
1985 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1987 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1997 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1998 open(LASTCACHE,"<$dir/cust_main.last")
1999 or die "can't open $dir/cust_main.last: $!";
2000 my @array = map { chomp; $_; } <LASTCACHE>;
2010 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2011 open(COMPANYCACHE,"<$dir/cust_main.company")
2012 or die "can't open $dir/cust_main.last: $!";
2013 my @array = map { chomp; $_; } <COMPANYCACHE>;
2018 =item append_fuzzyfiles LASTNAME COMPANY
2022 sub append_fuzzyfiles {
2023 my( $last, $company ) = @_;
2025 &check_and_rebuild_fuzzyfiles;
2027 use Fcntl qw(:flock);
2029 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2033 open(LAST,">>$dir/cust_main.last")
2034 or die "can't open $dir/cust_main.last: $!";
2036 or die "can't lock $dir/cust_main.last: $!";
2038 print LAST "$last\n";
2041 or die "can't unlock $dir/cust_main.last: $!";
2047 open(COMPANY,">>$dir/cust_main.company")
2048 or die "can't open $dir/cust_main.company: $!";
2049 flock(COMPANY,LOCK_EX)
2050 or die "can't lock $dir/cust_main.company: $!";
2052 print COMPANY "$company\n";
2054 flock(COMPANY,LOCK_UN)
2055 or die "can't unlock $dir/cust_main.company: $!";
2069 #warn join('-',keys %$param);
2070 my $fh = $param->{filehandle};
2071 my $agentnum = $param->{agentnum};
2072 my $refnum = $param->{refnum};
2073 my $pkgpart = $param->{pkgpart};
2074 my @fields = @{$param->{fields}};
2076 eval "use Date::Parse;";
2078 eval "use Text::CSV_XS;";
2081 my $csv = new Text::CSV_XS;
2088 local $SIG{HUP} = 'IGNORE';
2089 local $SIG{INT} = 'IGNORE';
2090 local $SIG{QUIT} = 'IGNORE';
2091 local $SIG{TERM} = 'IGNORE';
2092 local $SIG{TSTP} = 'IGNORE';
2093 local $SIG{PIPE} = 'IGNORE';
2095 my $oldAutoCommit = $FS::UID::AutoCommit;
2096 local $FS::UID::AutoCommit = 0;
2099 #while ( $columns = $csv->getline($fh) ) {
2101 while ( defined($line=<$fh>) ) {
2103 $csv->parse($line) or do {
2104 $dbh->rollback if $oldAutoCommit;
2105 return "can't parse: ". $csv->error_input();
2108 my @columns = $csv->fields();
2109 #warn join('-',@columns);
2112 agentnum => $agentnum,
2114 country => 'US', #default
2115 payby => 'BILL', #default
2116 paydate => '12/2037', #default
2118 my $billtime = time;
2119 my %cust_pkg = ( pkgpart => $pkgpart );
2120 foreach my $field ( @fields ) {
2121 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2122 #$cust_pkg{$1} = str2time( shift @$columns );
2123 if ( $1 eq 'setup' ) {
2124 $billtime = str2time(shift @columns);
2126 $cust_pkg{$1} = str2time( shift @columns );
2129 #$cust_main{$field} = shift @$columns;
2130 $cust_main{$field} = shift @columns;
2134 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2135 my $cust_main = new FS::cust_main ( \%cust_main );
2137 tie my %hash, 'Tie::RefHash'; #this part is important
2138 $hash{$cust_pkg} = [] if $pkgpart;
2139 my $error = $cust_main->insert( \%hash );
2142 $dbh->rollback if $oldAutoCommit;
2143 return "can't insert customer for $line: $error";
2146 #false laziness w/bill.cgi
2147 $error = $cust_main->bill( 'time' => $billtime );
2149 $dbh->rollback if $oldAutoCommit;
2150 return "can't bill customer for $line: $error";
2153 $cust_main->apply_payments;
2154 $cust_main->apply_credits;
2156 $error = $cust_main->collect();
2158 $dbh->rollback if $oldAutoCommit;
2159 return "can't collect customer for $line: $error";
2165 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2167 return "Empty file!" unless $imported;
2179 #warn join('-',keys %$param);
2180 my $fh = $param->{filehandle};
2181 my @fields = @{$param->{fields}};
2183 eval "use Date::Parse;";
2185 eval "use Text::CSV_XS;";
2188 my $csv = new Text::CSV_XS;
2195 local $SIG{HUP} = 'IGNORE';
2196 local $SIG{INT} = 'IGNORE';
2197 local $SIG{QUIT} = 'IGNORE';
2198 local $SIG{TERM} = 'IGNORE';
2199 local $SIG{TSTP} = 'IGNORE';
2200 local $SIG{PIPE} = 'IGNORE';
2202 my $oldAutoCommit = $FS::UID::AutoCommit;
2203 local $FS::UID::AutoCommit = 0;
2206 #while ( $columns = $csv->getline($fh) ) {
2208 while ( defined($line=<$fh>) ) {
2210 $csv->parse($line) or do {
2211 $dbh->rollback if $oldAutoCommit;
2212 return "can't parse: ". $csv->error_input();
2215 my @columns = $csv->fields();
2216 #warn join('-',@columns);
2219 foreach my $field ( @fields ) {
2220 $row{$field} = shift @columns;
2223 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2224 unless ( $cust_main ) {
2225 $dbh->rollback if $oldAutoCommit;
2226 return "unknown custnum $row{'custnum'}";
2229 if ( $row{'amount'} > 0 ) {
2230 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2232 $dbh->rollback if $oldAutoCommit;
2236 } elsif ( $row{'amount'} < 0 ) {
2237 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2240 $dbh->rollback if $oldAutoCommit;
2250 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2252 return "Empty file!" unless $imported;
2264 The delete method should possibly take an FS::cust_main object reference
2265 instead of a scalar customer number.
2267 Bill and collect options should probably be passed as references instead of a
2270 There should probably be a configuration file with a list of allowed credit
2273 No multiple currency support (probably a larger project than just this module).
2277 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2278 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2279 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.