4 use vars qw( @ISA $conf $Debug $import );
10 use Business::CreditCard;
11 use FS::UID qw( getotaker dbh );
12 use FS::Record qw( qsearchs qsearch dbdef );
15 use FS::cust_bill_pkg;
18 use FS::part_referral;
19 use FS::cust_main_county;
21 use FS::cust_main_invoice;
22 use FS::cust_credit_bill;
23 use FS::cust_bill_pay;
24 use FS::prepay_credit;
27 use FS::part_bill_event;
28 use FS::cust_bill_event;
29 use FS::cust_tax_exempt;
30 use FS::Msgcat qw(gettext);
32 @ISA = qw( FS::Record );
39 #ask FS::UID to run this stuff for us later
40 $FS::UID::callback{'FS::cust_main'} = sub {
42 #yes, need it for stuff below (prolly should be cached)
47 my ( $hashref, $cache ) = @_;
48 if ( exists $hashref->{'pkgnum'} ) {
49 # #@{ $self->{'_pkgnum'} } = ();
50 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
51 $self->{'_pkgnum'} = $subcache;
52 #push @{ $self->{'_pkgnum'} },
53 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
59 FS::cust_main - Object methods for cust_main records
65 $record = new FS::cust_main \%hash;
66 $record = new FS::cust_main { 'column' => 'value' };
68 $error = $record->insert;
70 $error = $new_record->replace($old_record);
72 $error = $record->delete;
74 $error = $record->check;
76 @cust_pkg = $record->all_pkgs;
78 @cust_pkg = $record->ncancelled_pkgs;
80 @cust_pkg = $record->suspended_pkgs;
82 $error = $record->bill;
83 $error = $record->bill %options;
84 $error = $record->bill 'time' => $time;
86 $error = $record->collect;
87 $error = $record->collect %options;
88 $error = $record->collect 'invoice_time' => $time,
89 'batch_card' => 'yes',
90 'report_badcard' => 'yes',
95 An FS::cust_main object represents a customer. FS::cust_main inherits from
96 FS::Record. The following fields are currently supported:
100 =item custnum - primary key (assigned automatically for new customers)
102 =item agentnum - agent (see L<FS::agent>)
104 =item refnum - Advertising source (see L<FS::part_referral>)
110 =item ss - social security number (optional)
112 =item company - (optional)
116 =item address2 - (optional)
120 =item county - (optional, see L<FS::cust_main_county>)
122 =item state - (see L<FS::cust_main_county>)
126 =item country - (see L<FS::cust_main_county>)
128 =item daytime - phone (optional)
130 =item night - phone (optional)
132 =item fax - phone (optional)
134 =item ship_first - name
136 =item ship_last - name
138 =item ship_company - (optional)
142 =item ship_address2 - (optional)
146 =item ship_county - (optional, see L<FS::cust_main_county>)
148 =item ship_state - (see L<FS::cust_main_county>)
152 =item ship_country - (see L<FS::cust_main_county>)
154 =item ship_daytime - phone (optional)
156 =item ship_night - phone (optional)
158 =item ship_fax - phone (optional)
160 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
162 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
164 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
166 =item payname - name on card or billing name
168 =item tax - tax exempt, empty or `Y'
170 =item otaker - order taker (assigned automatically, see L<FS::UID>)
172 =item comments - comments (optional)
182 Creates a new customer. To add the customer to the database, see L<"insert">.
184 Note that this stores the hash reference, not a distinct copy of the hash it
185 points to. You can ask the object for a copy with the I<hash> method.
189 sub table { 'cust_main'; }
191 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
193 Adds this customer to the database. If there is an error, returns the error,
194 otherwise returns false.
196 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
197 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
198 are inserted atomicly, or the transaction is rolled back. Passing an empty
199 hash reference is equivalent to not supplying this parameter. There should be
200 a better explanation of this, but until then, here's an example:
203 tie %hash, 'Tie::RefHash'; #this part is important
205 $cust_pkg => [ $svc_acct ],
208 $cust_main->insert( \%hash );
210 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
211 be set as the invoicing list (see L<"invoicing_list">). Errors return as
212 expected and rollback the entire transaction; it is not necessary to call
213 check_invoicing_list first. The invoicing_list is set after the records in the
214 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
215 invoicing_list destination to the newly-created svc_acct. Here's an example:
217 $cust_main->insert( {}, [ $email, 'POST' ] );
225 local $SIG{HUP} = 'IGNORE';
226 local $SIG{INT} = 'IGNORE';
227 local $SIG{QUIT} = 'IGNORE';
228 local $SIG{TERM} = 'IGNORE';
229 local $SIG{TSTP} = 'IGNORE';
230 local $SIG{PIPE} = 'IGNORE';
232 my $oldAutoCommit = $FS::UID::AutoCommit;
233 local $FS::UID::AutoCommit = 0;
238 if ( $self->payby eq 'PREPAY' ) {
239 $self->payby('BILL');
240 my $prepay_credit = qsearchs(
242 { 'identifier' => $self->payinfo },
246 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
247 unless $prepay_credit;
248 $amount = $prepay_credit->amount;
249 $seconds = $prepay_credit->seconds;
250 my $error = $prepay_credit->delete;
252 $dbh->rollback if $oldAutoCommit;
253 return "removing prepay_credit (transaction rolled back): $error";
257 my $error = $self->SUPER::insert;
259 $dbh->rollback if $oldAutoCommit;
260 #return "inserting cust_main record (transaction rolled back): $error";
264 if ( @param ) { # CUST_PKG_HASHREF
265 my $cust_pkgs = shift @param;
266 foreach my $cust_pkg ( keys %$cust_pkgs ) {
267 $cust_pkg->custnum( $self->custnum );
268 $error = $cust_pkg->insert;
270 $dbh->rollback if $oldAutoCommit;
271 return "inserting cust_pkg (transaction rolled back): $error";
273 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
274 $svc_something->pkgnum( $cust_pkg->pkgnum );
275 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
276 $svc_something->seconds( $svc_something->seconds + $seconds );
279 $error = $svc_something->insert;
281 $dbh->rollback if $oldAutoCommit;
282 #return "inserting svc_ (transaction rolled back): $error";
290 $dbh->rollback if $oldAutoCommit;
291 return "No svc_acct record to apply pre-paid time";
294 if ( @param ) { # INVOICING_LIST_ARYREF
295 my $invoicing_list = shift @param;
296 $error = $self->check_invoicing_list( $invoicing_list );
298 $dbh->rollback if $oldAutoCommit;
299 return "checking invoicing_list (transaction rolled back): $error";
301 $self->invoicing_list( $invoicing_list );
305 my $cust_credit = new FS::cust_credit {
306 'custnum' => $self->custnum,
309 $error = $cust_credit->insert;
311 $dbh->rollback if $oldAutoCommit;
312 return "inserting credit (transaction rolled back): $error";
316 #false laziness with sub replace
317 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
318 $error = $queue->insert($self->getfield('last'), $self->company);
320 $dbh->rollback if $oldAutoCommit;
321 return "queueing job (transaction rolled back): $error";
324 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
325 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
326 $error = $queue->insert($self->getfield('last'), $self->company);
328 $dbh->rollback if $oldAutoCommit;
329 return "queueing job (transaction rolled back): $error";
334 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
339 =item delete NEW_CUSTNUM
341 This deletes the customer. If there is an error, returns the error, otherwise
344 This will completely remove all traces of the customer record. This is not
345 what you want when a customer cancels service; for that, cancel all of the
346 customer's packages (see L<FS::cust_pkg/cancel>).
348 If the customer has any uncancelled packages, you need to pass a new (valid)
349 customer number for those packages to be transferred to. Cancelled packages
350 will be deleted. Did I mention that this is NOT what you want when a customer
351 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
353 You can't delete a customer with invoices (see L<FS::cust_bill>),
354 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
355 refunds (see L<FS::cust_refund>).
362 local $SIG{HUP} = 'IGNORE';
363 local $SIG{INT} = 'IGNORE';
364 local $SIG{QUIT} = 'IGNORE';
365 local $SIG{TERM} = 'IGNORE';
366 local $SIG{TSTP} = 'IGNORE';
367 local $SIG{PIPE} = 'IGNORE';
369 my $oldAutoCommit = $FS::UID::AutoCommit;
370 local $FS::UID::AutoCommit = 0;
373 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
374 $dbh->rollback if $oldAutoCommit;
375 return "Can't delete a customer with invoices";
377 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
378 $dbh->rollback if $oldAutoCommit;
379 return "Can't delete a customer with credits";
381 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Can't delete a customer with payments";
385 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
386 $dbh->rollback if $oldAutoCommit;
387 return "Can't delete a customer with refunds";
390 my @cust_pkg = $self->ncancelled_pkgs;
392 my $new_custnum = shift;
393 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
394 $dbh->rollback if $oldAutoCommit;
395 return "Invalid new customer number: $new_custnum";
397 foreach my $cust_pkg ( @cust_pkg ) {
398 my %hash = $cust_pkg->hash;
399 $hash{'custnum'} = $new_custnum;
400 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
401 my $error = $new_cust_pkg->replace($cust_pkg);
403 $dbh->rollback if $oldAutoCommit;
408 my @cancelled_cust_pkg = $self->all_pkgs;
409 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
410 my $error = $cust_pkg->delete;
412 $dbh->rollback if $oldAutoCommit;
417 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
418 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
420 my $error = $cust_main_invoice->delete;
422 $dbh->rollback if $oldAutoCommit;
427 my $error = $self->SUPER::delete;
429 $dbh->rollback if $oldAutoCommit;
433 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
438 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
440 Replaces the OLD_RECORD with this one in the database. If there is an error,
441 returns the error, otherwise returns false.
443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
444 be set as the invoicing list (see L<"invoicing_list">). Errors return as
445 expected and rollback the entire transaction; it is not necessary to call
446 check_invoicing_list first. Here's an example:
448 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
457 local $SIG{HUP} = 'IGNORE';
458 local $SIG{INT} = 'IGNORE';
459 local $SIG{QUIT} = 'IGNORE';
460 local $SIG{TERM} = 'IGNORE';
461 local $SIG{TSTP} = 'IGNORE';
462 local $SIG{PIPE} = 'IGNORE';
464 my $oldAutoCommit = $FS::UID::AutoCommit;
465 local $FS::UID::AutoCommit = 0;
468 my $error = $self->SUPER::replace($old);
471 $dbh->rollback if $oldAutoCommit;
475 if ( @param ) { # INVOICING_LIST_ARYREF
476 my $invoicing_list = shift @param;
477 $error = $self->check_invoicing_list( $invoicing_list );
479 $dbh->rollback if $oldAutoCommit;
482 $self->invoicing_list( $invoicing_list );
485 if ( $self->payby eq 'CARD' &&
486 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
487 # card info has changed, want to retry realtime_card invoice events
488 foreach my $cust_bill_event (
490 #$_->part_bill_event->plan eq 'realtime-card'
491 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
492 && $_->status eq 'done'
495 $self->open_cust_bill->cust_bill_event
497 my $error = $cust_bill_event->retry;
499 $dbh->rollback if $oldAutoCommit;
500 return "error scheduling invoice events for retry: $error";
506 #false laziness with sub insert
507 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
508 $error = $queue->insert($self->getfield('last'), $self->company);
510 $dbh->rollback if $oldAutoCommit;
511 return "queueing job (transaction rolled back): $error";
514 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
515 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
516 $error = $queue->insert($self->getfield('last'), $self->company);
518 $dbh->rollback if $oldAutoCommit;
519 return "queueing job (transaction rolled back): $error";
524 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
531 Checks all fields to make sure this is a valid customer record. If there is
532 an error, returns the error, otherwise returns false. Called by the insert
540 #warn "BEFORE: \n". $self->_dump;
543 $self->ut_numbern('custnum')
544 || $self->ut_number('agentnum')
545 || $self->ut_number('refnum')
546 || $self->ut_name('last')
547 || $self->ut_name('first')
548 || $self->ut_textn('company')
549 || $self->ut_text('address1')
550 || $self->ut_textn('address2')
551 || $self->ut_text('city')
552 || $self->ut_textn('county')
553 || $self->ut_textn('state')
554 || $self->ut_country('country')
555 || $self->ut_anything('comments')
556 || $self->ut_numbern('referral_custnum')
558 #barf. need message catalogs. i18n. etc.
559 $error .= "Please select a advertising source."
560 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
561 return $error if $error;
563 return "Unknown agent"
564 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
566 return "Unknown refnum"
567 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
569 return "Unknown referring custnum ". $self->referral_custnum
570 unless ! $self->referral_custnum
571 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
573 if ( $self->ss eq '' ) {
578 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
579 or return "Illegal social security number: ". $self->ss;
580 $self->ss("$1-$2-$3");
584 # bad idea to disable, causes billing to fail because of no tax rates later
585 # unless ( $import ) {
586 unless ( qsearchs('cust_main_county', {
587 'country' => $self->country,
590 return "Unknown state/county/country: ".
591 $self->state. "/". $self->county. "/". $self->country
592 unless qsearchs('cust_main_county',{
593 'state' => $self->state,
594 'county' => $self->county,
595 'country' => $self->country,
601 $self->ut_phonen('daytime', $self->country)
602 || $self->ut_phonen('night', $self->country)
603 || $self->ut_phonen('fax', $self->country)
604 || $self->ut_zip('zip', $self->country)
606 return $error if $error;
609 last first company address1 address2 city county state zip
610 country daytime night fax
613 if ( defined $self->dbdef_table->column('ship_last') ) {
614 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
616 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
620 $self->ut_name('ship_last')
621 || $self->ut_name('ship_first')
622 || $self->ut_textn('ship_company')
623 || $self->ut_text('ship_address1')
624 || $self->ut_textn('ship_address2')
625 || $self->ut_text('ship_city')
626 || $self->ut_textn('ship_county')
627 || $self->ut_textn('ship_state')
628 || $self->ut_country('ship_country')
630 return $error if $error;
632 #false laziness with above
633 unless ( qsearchs('cust_main_county', {
634 'country' => $self->ship_country,
637 return "Unknown ship_state/ship_county/ship_country: ".
638 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
639 unless qsearchs('cust_main_county',{
640 'state' => $self->ship_state,
641 'county' => $self->ship_county,
642 'country' => $self->ship_country,
648 $self->ut_phonen('ship_daytime', $self->ship_country)
649 || $self->ut_phonen('ship_night', $self->ship_country)
650 || $self->ut_phonen('ship_fax', $self->ship_country)
651 || $self->ut_zip('ship_zip', $self->ship_country)
653 return $error if $error;
655 } else { # ship_ info eq billing info, so don't store dup info in database
656 $self->setfield("ship_$_", '')
657 foreach qw( last first company address1 address2 city county state zip
658 country daytime night fax );
662 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
663 or return "Illegal payby: ". $self->payby;
666 if ( $self->payby eq 'CARD' ) {
668 my $payinfo = $self->payinfo;
670 $payinfo =~ /^(\d{13,16})$/
671 or return gettext('invalid_card'); # . ": ". $self->payinfo;
673 $self->payinfo($payinfo);
675 or return gettext('invalid_card'); # . ": ". $self->payinfo;
676 return gettext('unknown_card_type')
677 if cardtype($self->payinfo) eq "Unknown";
679 } elsif ( $self->payby eq 'BILL' ) {
681 $error = $self->ut_textn('payinfo');
682 return "Illegal P.O. number: ". $self->payinfo if $error;
684 } elsif ( $self->payby eq 'COMP' ) {
686 $error = $self->ut_textn('payinfo');
687 return "Illegal comp account issuer: ". $self->payinfo if $error;
689 } elsif ( $self->payby eq 'PREPAY' ) {
691 my $payinfo = $self->payinfo;
692 $payinfo =~ s/\W//g; #anything else would just confuse things
693 $self->payinfo($payinfo);
694 $error = $self->ut_alpha('payinfo');
695 return "Illegal prepayment identifier: ". $self->payinfo if $error;
696 return "Unknown prepayment identifier"
697 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
701 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
702 return "Expriation date required"
703 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
706 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
707 or return "Illegal expiration date: ". $self->paydate;
708 my $y = length($2) == 4 ? $2 : "20$2";
709 $self->paydate("$y-$1-01");
710 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
711 return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm );
714 if ( $self->payname eq '' &&
715 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
716 $self->payname( $self->first. " ". $self->getfield('last') );
718 $self->payname =~ /^([\w \,\.\-\']+)$/
719 or return gettext('illegal_name'). " payname: ". $self->payname;
723 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
726 $self->otaker(getotaker);
728 #warn "AFTER: \n". $self->_dump;
735 Returns all packages (see L<FS::cust_pkg>) for this customer.
741 if ( $self->{'_pkgnum'} ) {
742 values %{ $self->{'_pkgnum'}->cache };
744 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
748 =item ncancelled_pkgs
750 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
754 sub ncancelled_pkgs {
756 if ( $self->{'_pkgnum'} ) {
757 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
759 @{ [ # force list context
760 qsearch( 'cust_pkg', {
761 'custnum' => $self->custnum,
764 qsearch( 'cust_pkg', {
765 'custnum' => $self->custnum,
774 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
780 grep { $_->susp } $self->ncancelled_pkgs;
783 =item unflagged_suspended_pkgs
785 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
786 customer (thouse packages without the `manual_flag' set).
790 sub unflagged_suspended_pkgs {
792 return $self->suspended_pkgs
793 unless dbdef->table('cust_pkg')->column('manual_flag');
794 grep { ! $_->manual_flag } $self->suspended_pkgs;
797 =item unsuspended_pkgs
799 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
804 sub unsuspended_pkgs {
806 grep { ! $_->susp } $self->ncancelled_pkgs;
811 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
812 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
813 on success or a list of errors.
819 grep { $_->unsuspend } $self->suspended_pkgs;
824 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
825 Always returns a list: an empty list on success or a list of errors.
831 grep { $_->suspend } $self->unsuspended_pkgs;
836 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
837 Always returns a list: an empty list on success or a list of errors.
843 grep { $_->cancel } $self->ncancelled_pkgs;
848 Returns the agent (see L<FS::agent>) for this customer.
854 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
859 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
860 conjunction with the collect method.
862 Options are passed as name-value pairs.
864 The only currently available option is `time', which bills the customer as if
865 it were that time. It is specified as a UNIX timestamp; see
866 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
867 functions. For example:
871 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
873 If there is an error, returns the error, otherwise returns false.
878 my( $self, %options ) = @_;
879 my $time = $options{'time'} || time;
884 local $SIG{HUP} = 'IGNORE';
885 local $SIG{INT} = 'IGNORE';
886 local $SIG{QUIT} = 'IGNORE';
887 local $SIG{TERM} = 'IGNORE';
888 local $SIG{TSTP} = 'IGNORE';
889 local $SIG{PIPE} = 'IGNORE';
891 my $oldAutoCommit = $FS::UID::AutoCommit;
892 local $FS::UID::AutoCommit = 0;
895 # find the packages which are due for billing, find out how much they are
896 # & generate invoice database.
898 my( $total_setup, $total_recur ) = ( 0, 0 );
899 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
900 my @cust_bill_pkg = ();
902 #my $taxable_charged = 0;##
905 foreach my $cust_pkg (
906 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
909 #NO!! next if $cust_pkg->cancel;
910 next if $cust_pkg->getfield('cancel');
912 #? to avoid use of uninitialized value errors... ?
913 $cust_pkg->setfield('bill', '')
914 unless defined($cust_pkg->bill);
916 my $part_pkg = $cust_pkg->part_pkg;
918 #so we don't modify cust_pkg record unnecessarily
919 my $cust_pkg_mod_flag = 0;
920 my %hash = $cust_pkg->hash;
921 my $old_cust_pkg = new FS::cust_pkg \%hash;
925 unless ( $cust_pkg->setup ) {
926 my $setup_prog = $part_pkg->getfield('setup');
927 $setup_prog =~ /^(.*)$/ or do {
928 $dbh->rollback if $oldAutoCommit;
929 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
935 ##$cpt->permit(); #what is necessary?
936 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
937 #$setup = $cpt->reval($setup_prog);
938 $setup = eval $setup_prog;
939 unless ( defined($setup) ) {
940 $dbh->rollback if $oldAutoCommit;
941 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
942 "(expression $setup_prog): $@";
944 $cust_pkg->setfield('setup',$time);
945 $cust_pkg_mod_flag=1;
951 if ( $part_pkg->getfield('freq') > 0 &&
952 ! $cust_pkg->getfield('susp') &&
953 ( $cust_pkg->getfield('bill') || 0 ) < $time
955 my $recur_prog = $part_pkg->getfield('recur');
956 $recur_prog =~ /^(.*)$/ or do {
957 $dbh->rollback if $oldAutoCommit;
958 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
963 # shared with $recur_prog
964 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
967 ##$cpt->permit(); #what is necessary?
968 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
969 #$recur = $cpt->reval($recur_prog);
970 $recur = eval $recur_prog;
971 unless ( defined($recur) ) {
972 $dbh->rollback if $oldAutoCommit;
973 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
974 "(expression $recur_prog): $@";
976 #change this bit to use Date::Manip? CAREFUL with timezones (see
977 # mailing list archive)
978 my ($sec,$min,$hour,$mday,$mon,$year) =
979 (localtime($sdate) )[0,1,2,3,4,5];
981 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
982 # only for figuring next bill date, nothing else, so, reset $sdate again
984 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
986 $mon += $part_pkg->freq;
987 until ( $mon < 12 ) { $mon -= 12; $year++; }
988 $cust_pkg->setfield('bill',
989 timelocal($sec,$min,$hour,$mday,$mon,$year));
990 $cust_pkg_mod_flag = 1;
993 warn "\$setup is undefined" unless defined($setup);
994 warn "\$recur is undefined" unless defined($recur);
995 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
997 my $taxable_charged = 0;
998 if ( $cust_pkg_mod_flag ) {
999 $error=$cust_pkg->replace($old_cust_pkg);
1000 if ( $error ) { #just in case
1001 $dbh->rollback if $oldAutoCommit;
1002 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1004 $setup = sprintf( "%.2f", $setup );
1005 $recur = sprintf( "%.2f", $recur );
1007 $dbh->rollback if $oldAutoCommit;
1008 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1011 $dbh->rollback if $oldAutoCommit;
1012 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1014 if ( $setup > 0 || $recur > 0 ) {
1015 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1016 'pkgnum' => $cust_pkg->pkgnum,
1020 'edate' => $cust_pkg->bill,
1022 push @cust_bill_pkg, $cust_bill_pkg;
1023 $total_setup += $setup;
1024 $total_recur += $recur;
1025 $taxable_charged += $setup
1026 unless $part_pkg->setuptax =~ /^Y$/i;
1027 $taxable_charged += $recur
1028 unless $part_pkg->recurtax =~ /^Y$/i;
1030 unless ( $self->tax =~ /Y/i
1031 || $self->payby eq 'COMP'
1032 || $taxable_charged == 0 ) {
1034 my $cust_main_county =
1035 qsearchs('cust_main_county',{
1036 'state' => $self->state,
1037 'county' => $self->county,
1038 'country' => $self->country,
1039 'taxclass' => $part_pkg->taxclass,
1041 or qsearchs('cust_main_county',{
1042 'state' => $self->state,
1043 'county' => $self->county,
1044 'country' => $self->country,
1048 $dbh->rollback if $oldAutoCommit;
1050 "fatal: can't find tax rate for state/county/country/taxclass ".
1051 join('/', map $self->$_(), qw(state county country taxclass) ).
1055 if ( $cust_main_county->exempt_amount ) {
1056 my ($mon,$year) = (localtime($sdate) )[4,5];
1058 my $freq = $part_pkg->freq || 1;
1059 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1060 foreach my $which_month ( 1 .. $freq ) {
1062 'custnum' => $self->custnum,
1063 'taxnum' => $cust_main_county->taxnum,
1064 'year' => 1900+$year,
1067 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1068 until ( $mon < 13 ) { $mon -= 12; $year++; }
1069 my $cust_tax_exempt =
1070 qsearchs('cust_tax_exempt', \%hash)
1071 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1072 my $remaining_exemption = sprintf("%.2f",
1073 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1074 if ( $remaining_exemption > 0 ) {
1075 my $addl = $remaining_exemption > $taxable_per_month
1076 ? $taxable_per_month
1077 : $remaining_exemption;
1078 $taxable_charged -= $addl;
1079 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1080 $cust_tax_exempt->hash,
1081 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1083 $error = $new_cust_tax_exempt->exemptnum
1084 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1085 : $new_cust_tax_exempt->insert;
1087 $dbh->rollback if $oldAutoCommit;
1088 return "fatal: can't update cust_tax_exempt: $error";
1091 } # if $remaining_exemption > 0
1093 } #foreach $which_month
1095 } #if $cust_main_county->exempt_amount
1097 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1098 $tax += $taxable_charged * $cust_main_county->tax / 100
1100 } #unless $self->tax =~ /Y/i
1101 # || $self->payby eq 'COMP'
1102 # || $taxable_charged == 0
1104 } #if $setup > 0 || $recur > 0
1106 } #if $cust_pkg_mod_flag
1108 } #foreach my $cust_pkg
1110 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1111 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1113 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1114 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1118 # unless ( $self->tax =~ /Y/i
1119 # || $self->payby eq 'COMP'
1120 # || $taxable_charged == 0 ) {
1121 # my $cust_main_county = qsearchs('cust_main_county',{
1122 # 'state' => $self->state,
1123 # 'county' => $self->county,
1124 # 'country' => $self->country,
1125 # } ) or die "fatal: can't find tax rate for state/county/country ".
1126 # $self->state. "/". $self->county. "/". $self->country. "\n";
1127 # my $tax = sprintf( "%.2f",
1128 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1131 $tax = sprintf("%.2f", $tax);
1133 $charged = sprintf( "%.2f", $charged+$tax );
1135 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1142 push @cust_bill_pkg, $cust_bill_pkg;
1146 my $cust_bill = new FS::cust_bill ( {
1147 'custnum' => $self->custnum,
1149 'charged' => $charged,
1151 $error = $cust_bill->insert;
1153 $dbh->rollback if $oldAutoCommit;
1154 return "can't create invoice for customer #". $self->custnum. ": $error";
1157 my $invnum = $cust_bill->invnum;
1159 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1161 $cust_bill_pkg->invnum($invnum);
1162 $error = $cust_bill_pkg->insert;
1164 $dbh->rollback if $oldAutoCommit;
1165 return "can't create invoice line item for customer #". $self->custnum.
1170 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1174 =item collect OPTIONS
1176 (Attempt to) collect money for this customer's outstanding invoices (see
1177 L<FS::cust_bill>). Usually used after the bill method.
1179 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1180 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1182 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1183 and the invoice events web interface.
1185 If there is an error, returns the error, otherwise returns false.
1187 Options are passed as name-value pairs.
1189 Currently available options are:
1191 invoice_time - Use this time when deciding when to print invoices and
1192 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>
1193 for conversion functions.
1195 batch_card - This option is deprecated. See the invoice events web interface
1196 to control whether cards are batched or run against a realtime gateway.
1198 report_badcard - This option is deprecated.
1200 force_print - This option is deprecated; see the invoice events web interface.
1205 my( $self, %options ) = @_;
1206 my $invoice_time = $options{'invoice_time'} || time;
1209 local $SIG{HUP} = 'IGNORE';
1210 local $SIG{INT} = 'IGNORE';
1211 local $SIG{QUIT} = 'IGNORE';
1212 local $SIG{TERM} = 'IGNORE';
1213 local $SIG{TSTP} = 'IGNORE';
1214 local $SIG{PIPE} = 'IGNORE';
1216 my $oldAutoCommit = $FS::UID::AutoCommit;
1217 local $FS::UID::AutoCommit = 0;
1220 my $balance = $self->balance;
1221 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1222 unless ( $balance > 0 ) { #redundant?????
1223 $dbh->rollback if $oldAutoCommit; #hmm
1227 foreach my $cust_bill ( $self->cust_bill ) {
1229 #this has to be before next's
1230 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1234 $balance = sprintf( "%.2f", $balance - $amount );
1236 next unless $cust_bill->owed > 0;
1238 # don't try to charge for the same invoice if it's already in a batch
1239 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1241 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1243 next unless $amount > 0;
1245 foreach my $part_bill_event (
1246 sort { $a->seconds <=> $b->seconds
1247 || $a->weight <=> $b->weight
1248 || $a->eventpart <=> $b->eventpart }
1249 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1250 && ! qsearchs( 'cust_bill_event', {
1251 'invnum' => $cust_bill->invnum,
1252 'eventpart' => $_->eventpart,
1256 qsearch('part_bill_event', { 'payby' => $self->payby,
1257 'disabled' => '', } )
1260 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1262 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1264 my $cust_main = $self; #for callback
1265 my $error = eval $part_bill_event->eventcode;
1268 my $statustext = '';
1272 } elsif ( $error ) {
1274 $statustext = $error;
1279 #add cust_bill_event
1280 my $cust_bill_event = new FS::cust_bill_event {
1281 'invnum' => $cust_bill->invnum,
1282 'eventpart' => $part_bill_event->eventpart,
1283 '_date' => $invoice_time,
1284 'status' => $status,
1285 'statustext' => $statustext,
1287 $error = $cust_bill_event->insert;
1289 #$dbh->rollback if $oldAutoCommit;
1290 #return "error: $error";
1292 # gah, even with transactions.
1293 $dbh->commit if $oldAutoCommit; #well.
1294 my $e = 'WARNING: Event run but database not updated - '.
1295 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1296 ', eventpart '. $part_bill_event->eventpart.
1307 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1314 Returns the total owed for this customer on all invoices
1315 (see L<FS::cust_bill/owed>).
1321 $self->total_owed_date(2145859200); #12/31/2037
1324 =item total_owed_date TIME
1326 Returns the total owed for this customer on all invoices with date earlier than
1327 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1328 see L<Time::Local> and L<Date::Parse> for conversion functions.
1332 sub total_owed_date {
1336 foreach my $cust_bill (
1337 grep { $_->_date <= $time }
1338 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1340 $total_bill += $cust_bill->owed;
1342 sprintf( "%.2f", $total_bill );
1347 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1348 to outstanding invoice balances in chronological order and returns the value
1349 of any remaining unapplied credits available for refund
1350 (see L<FS::cust_refund>).
1357 return 0 unless $self->total_credited;
1359 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1360 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1362 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1363 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1367 foreach my $cust_bill ( @invoices ) {
1370 if ( !defined($credit) || $credit->credited == 0) {
1371 $credit = pop @credits or last;
1374 if ($cust_bill->owed >= $credit->credited) {
1375 $amount=$credit->credited;
1377 $amount=$cust_bill->owed;
1380 my $cust_credit_bill = new FS::cust_credit_bill ( {
1381 'crednum' => $credit->crednum,
1382 'invnum' => $cust_bill->invnum,
1383 'amount' => $amount,
1385 my $error = $cust_credit_bill->insert;
1386 die $error if $error;
1388 redo if ($cust_bill->owed > 0);
1392 return $self->total_credited;
1395 =item apply_payments
1397 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1398 to outstanding invoice balances in chronological order.
1400 #and returns the value of any remaining unapplied payments.
1404 sub apply_payments {
1409 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1410 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1412 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1413 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1417 foreach my $cust_bill ( @invoices ) {
1420 if ( !defined($payment) || $payment->unapplied == 0 ) {
1421 $payment = pop @payments or last;
1424 if ( $cust_bill->owed >= $payment->unapplied ) {
1425 $amount = $payment->unapplied;
1427 $amount = $cust_bill->owed;
1430 my $cust_bill_pay = new FS::cust_bill_pay ( {
1431 'paynum' => $payment->paynum,
1432 'invnum' => $cust_bill->invnum,
1433 'amount' => $amount,
1435 my $error = $cust_bill_pay->insert;
1436 die $error if $error;
1438 redo if ( $cust_bill->owed > 0);
1442 return $self->total_unapplied_payments;
1445 =item total_credited
1447 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1448 customer. See L<FS::cust_credit/credited>.
1452 sub total_credited {
1454 my $total_credit = 0;
1455 foreach my $cust_credit ( qsearch('cust_credit', {
1456 'custnum' => $self->custnum,
1458 $total_credit += $cust_credit->credited;
1460 sprintf( "%.2f", $total_credit );
1463 =item total_unapplied_payments
1465 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1466 See L<FS::cust_pay/unapplied>.
1470 sub total_unapplied_payments {
1472 my $total_unapplied = 0;
1473 foreach my $cust_pay ( qsearch('cust_pay', {
1474 'custnum' => $self->custnum,
1476 $total_unapplied += $cust_pay->unapplied;
1478 sprintf( "%.2f", $total_unapplied );
1483 Returns the balance for this customer (total_owed minus total_credited
1484 minus total_unapplied_payments).
1491 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1495 =item balance_date TIME
1497 Returns the balance for this customer, only considering invoices with date
1498 earlier than TIME (total_owed_date minus total_credited minus
1499 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1500 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1509 $self->total_owed_date($time)
1510 - $self->total_credited
1511 - $self->total_unapplied_payments
1515 =item invoicing_list [ ARRAYREF ]
1517 If an arguement is given, sets these email addresses as invoice recipients
1518 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1519 (except as warnings), so use check_invoicing_list first.
1521 Returns a list of email addresses (with svcnum entries expanded).
1523 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1524 check it without disturbing anything by passing nothing.
1526 This interface may change in the future.
1530 sub invoicing_list {
1531 my( $self, $arrayref ) = @_;
1533 my @cust_main_invoice;
1534 if ( $self->custnum ) {
1535 @cust_main_invoice =
1536 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1538 @cust_main_invoice = ();
1540 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1541 #warn $cust_main_invoice->destnum;
1542 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1543 #warn $cust_main_invoice->destnum;
1544 my $error = $cust_main_invoice->delete;
1545 warn $error if $error;
1548 if ( $self->custnum ) {
1549 @cust_main_invoice =
1550 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1552 @cust_main_invoice = ();
1554 my %seen = map { $_->address => 1 } @cust_main_invoice;
1555 foreach my $address ( @{$arrayref} ) {
1556 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1557 next if exists $seen{$address} && $seen{$address};
1558 $seen{$address} = 1;
1559 my $cust_main_invoice = new FS::cust_main_invoice ( {
1560 'custnum' => $self->custnum,
1563 my $error = $cust_main_invoice->insert;
1564 warn $error if $error;
1567 if ( $self->custnum ) {
1569 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1575 =item check_invoicing_list ARRAYREF
1577 Checks these arguements as valid input for the invoicing_list method. If there
1578 is an error, returns the error, otherwise returns false.
1582 sub check_invoicing_list {
1583 my( $self, $arrayref ) = @_;
1584 foreach my $address ( @{$arrayref} ) {
1585 my $cust_main_invoice = new FS::cust_main_invoice ( {
1586 'custnum' => $self->custnum,
1589 my $error = $self->custnum
1590 ? $cust_main_invoice->check
1591 : $cust_main_invoice->checkdest
1593 return $error if $error;
1598 =item default_invoicing_list
1600 Sets the invoicing list to all accounts associated with this customer.
1604 sub default_invoicing_list {
1607 foreach my $cust_pkg ( $self->all_pkgs ) {
1608 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1610 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1611 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1613 push @list, map { $_->email } @svc_acct;
1615 $self->invoicing_list(\@list);
1618 =item invoicing_list_addpost
1620 Adds postal invoicing to this customer. If this customer is already configured
1621 to receive postal invoices, does nothing.
1625 sub invoicing_list_addpost {
1627 return if grep { $_ eq 'POST' } $self->invoicing_list;
1628 my @invoicing_list = $self->invoicing_list;
1629 push @invoicing_list, 'POST';
1630 $self->invoicing_list(\@invoicing_list);
1633 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1635 Returns an array of customers referred by this customer (referral_custnum set
1636 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1637 customers referred by customers referred by this customer and so on, inclusive.
1638 The default behavior is DEPTH 1 (no recursion).
1642 sub referral_cust_main {
1644 my $depth = @_ ? shift : 1;
1645 my $exclude = @_ ? shift : {};
1648 map { $exclude->{$_->custnum}++; $_; }
1649 grep { ! $exclude->{ $_->custnum } }
1650 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1654 map { $_->referral_cust_main($depth-1, $exclude) }
1661 =item referral_cust_main_ncancelled
1663 Same as referral_cust_main, except only returns customers with uncancelled
1668 sub referral_cust_main_ncancelled {
1670 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1673 =item referral_cust_pkg [ DEPTH ]
1675 Like referral_cust_main, except returns a flat list of all unsuspended (and
1676 uncancelled) packages for each customer. The number of items in this list may
1677 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1681 sub referral_cust_pkg {
1683 my $depth = @_ ? shift : 1;
1685 map { $_->unsuspended_pkgs }
1686 grep { $_->unsuspended_pkgs }
1687 $self->referral_cust_main($depth);
1690 =item credit AMOUNT, REASON
1692 Applies a credit to this customer. If there is an error, returns the error,
1693 otherwise returns false.
1698 my( $self, $amount, $reason ) = @_;
1699 my $cust_credit = new FS::cust_credit {
1700 'custnum' => $self->custnum,
1701 'amount' => $amount,
1702 'reason' => $reason,
1704 $cust_credit->insert;
1707 =item charge AMOUNT PKG COMMENT
1709 Creates a one-time charge for this customer. If there is an error, returns
1710 the error, otherwise returns false.
1715 my ( $self, $amount, $pkg, $comment ) = @_;
1717 my $part_pkg = new FS::part_pkg ( {
1718 'pkg' => $pkg || 'One-time charge',
1719 'comment' => $comment || '$'. sprintf("%.2f".$amount),
1732 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1738 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1741 =item open_cust_bill
1743 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1748 sub open_cust_bill {
1750 grep { $_->owed > 0 } $self->cust_bill;
1759 =item check_and_rebuild_fuzzyfiles
1763 sub check_and_rebuild_fuzzyfiles {
1764 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1765 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1766 or &rebuild_fuzzyfiles;
1769 =item rebuild_fuzzyfiles
1773 sub rebuild_fuzzyfiles {
1775 use Fcntl qw(:flock);
1777 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1781 open(LASTLOCK,">>$dir/cust_main.last")
1782 or die "can't open $dir/cust_main.last: $!";
1783 flock(LASTLOCK,LOCK_EX)
1784 or die "can't lock $dir/cust_main.last: $!";
1786 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1788 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1789 if defined dbdef->table('cust_main')->column('ship_last');
1791 open (LASTCACHE,">$dir/cust_main.last.tmp")
1792 or die "can't open $dir/cust_main.last.tmp: $!";
1793 print LASTCACHE join("\n", @all_last), "\n";
1794 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1796 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1801 open(COMPANYLOCK,">>$dir/cust_main.company")
1802 or die "can't open $dir/cust_main.company: $!";
1803 flock(COMPANYLOCK,LOCK_EX)
1804 or die "can't lock $dir/cust_main.company: $!";
1806 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1808 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1809 if defined dbdef->table('cust_main')->column('ship_last');
1811 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1812 or die "can't open $dir/cust_main.company.tmp: $!";
1813 print COMPANYCACHE join("\n", @all_company), "\n";
1814 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1816 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1826 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1827 open(LASTCACHE,"<$dir/cust_main.last")
1828 or die "can't open $dir/cust_main.last: $!";
1829 my @array = map { chomp; $_; } <LASTCACHE>;
1839 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1840 open(COMPANYCACHE,"<$dir/cust_main.company")
1841 or die "can't open $dir/cust_main.last: $!";
1842 my @array = map { chomp; $_; } <COMPANYCACHE>;
1847 =item append_fuzzyfiles LASTNAME COMPANY
1851 sub append_fuzzyfiles {
1852 my( $last, $company ) = @_;
1854 &check_and_rebuild_fuzzyfiles;
1856 use Fcntl qw(:flock);
1858 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1862 open(LAST,">>$dir/cust_main.last")
1863 or die "can't open $dir/cust_main.last: $!";
1865 or die "can't lock $dir/cust_main.last: $!";
1867 print LAST "$last\n";
1870 or die "can't unlock $dir/cust_main.last: $!";
1876 open(COMPANY,">>$dir/cust_main.company")
1877 or die "can't open $dir/cust_main.company: $!";
1878 flock(COMPANY,LOCK_EX)
1879 or die "can't lock $dir/cust_main.company: $!";
1881 print COMPANY "$company\n";
1883 flock(COMPANY,LOCK_UN)
1884 or die "can't unlock $dir/cust_main.company: $!";
1898 The delete method should possibly take an FS::cust_main object reference
1899 instead of a scalar customer number.
1901 Bill and collect options should probably be passed as references instead of a
1904 There should probably be a configuration file with a list of allowed credit
1907 No multiple currency support (probably a larger project than just this module).
1911 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1912 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1913 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.