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 #false laziness with sub insert
486 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
487 $error = $queue->insert($self->getfield('last'), $self->company);
489 $dbh->rollback if $oldAutoCommit;
490 return "queueing job (transaction rolled back): $error";
493 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
494 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
495 $error = $queue->insert($self->getfield('last'), $self->company);
497 $dbh->rollback if $oldAutoCommit;
498 return "queueing job (transaction rolled back): $error";
503 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
510 Checks all fields to make sure this is a valid customer record. If there is
511 an error, returns the error, otherwise returns false. Called by the insert
519 #warn "BEFORE: \n". $self->_dump;
522 $self->ut_numbern('custnum')
523 || $self->ut_number('agentnum')
524 || $self->ut_number('refnum')
525 || $self->ut_name('last')
526 || $self->ut_name('first')
527 || $self->ut_textn('company')
528 || $self->ut_text('address1')
529 || $self->ut_textn('address2')
530 || $self->ut_text('city')
531 || $self->ut_textn('county')
532 || $self->ut_textn('state')
533 || $self->ut_country('country')
534 || $self->ut_anything('comments')
535 || $self->ut_numbern('referral_custnum')
537 #barf. need message catalogs. i18n. etc.
538 $error .= "Please select a advertising source."
539 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
540 return $error if $error;
542 return "Unknown agent"
543 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
545 return "Unknown refnum"
546 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
548 return "Unknown referring custnum ". $self->referral_custnum
549 unless ! $self->referral_custnum
550 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
552 if ( $self->ss eq '' ) {
557 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
558 or return "Illegal social security number: ". $self->ss;
559 $self->ss("$1-$2-$3");
563 # bad idea to disable, causes billing to fail because of no tax rates later
564 # unless ( $import ) {
565 unless ( qsearchs('cust_main_county', {
566 'country' => $self->country,
569 return "Unknown state/county/country: ".
570 $self->state. "/". $self->county. "/". $self->country
571 unless qsearchs('cust_main_county',{
572 'state' => $self->state,
573 'county' => $self->county,
574 'country' => $self->country,
580 $self->ut_phonen('daytime', $self->country)
581 || $self->ut_phonen('night', $self->country)
582 || $self->ut_phonen('fax', $self->country)
583 || $self->ut_zip('zip', $self->country)
585 return $error if $error;
588 last first company address1 address2 city county state zip
589 country daytime night fax
592 if ( defined $self->dbdef_table->column('ship_last') ) {
593 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
595 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
599 $self->ut_name('ship_last')
600 || $self->ut_name('ship_first')
601 || $self->ut_textn('ship_company')
602 || $self->ut_text('ship_address1')
603 || $self->ut_textn('ship_address2')
604 || $self->ut_text('ship_city')
605 || $self->ut_textn('ship_county')
606 || $self->ut_textn('ship_state')
607 || $self->ut_country('ship_country')
609 return $error if $error;
611 #false laziness with above
612 unless ( qsearchs('cust_main_county', {
613 'country' => $self->ship_country,
616 return "Unknown ship_state/ship_county/ship_country: ".
617 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
618 unless qsearchs('cust_main_county',{
619 'state' => $self->ship_state,
620 'county' => $self->ship_county,
621 'country' => $self->ship_country,
627 $self->ut_phonen('ship_daytime', $self->ship_country)
628 || $self->ut_phonen('ship_night', $self->ship_country)
629 || $self->ut_phonen('ship_fax', $self->ship_country)
630 || $self->ut_zip('ship_zip', $self->ship_country)
632 return $error if $error;
634 } else { # ship_ info eq billing info, so don't store dup info in database
635 $self->setfield("ship_$_", '')
636 foreach qw( last first company address1 address2 city county state zip
637 country daytime night fax );
641 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
642 or return "Illegal payby: ". $self->payby;
645 if ( $self->payby eq 'CARD' ) {
647 my $payinfo = $self->payinfo;
649 $payinfo =~ /^(\d{13,16})$/
650 or return gettext('invalid_card'); # . ": ". $self->payinfo;
652 $self->payinfo($payinfo);
654 or return gettext('invalid_card'); # . ": ". $self->payinfo;
655 return gettext('unknown_card_type')
656 if cardtype($self->payinfo) eq "Unknown";
658 } elsif ( $self->payby eq 'BILL' ) {
660 $error = $self->ut_textn('payinfo');
661 return "Illegal P.O. number: ". $self->payinfo if $error;
663 } elsif ( $self->payby eq 'COMP' ) {
665 $error = $self->ut_textn('payinfo');
666 return "Illegal comp account issuer: ". $self->payinfo if $error;
668 } elsif ( $self->payby eq 'PREPAY' ) {
670 my $payinfo = $self->payinfo;
671 $payinfo =~ s/\W//g; #anything else would just confuse things
672 $self->payinfo($payinfo);
673 $error = $self->ut_alpha('payinfo');
674 return "Illegal prepayment identifier: ". $self->payinfo if $error;
675 return "Unknown prepayment identifier"
676 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
680 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
681 return "Expriation date required"
682 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
685 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
686 or return "Illegal expiration date: ". $self->paydate;
687 my $y = length($2) == 4 ? $2 : "20$2";
688 $self->paydate("$y-$1-01");
689 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
690 return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm );
693 if ( $self->payname eq '' &&
694 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
695 $self->payname( $self->first. " ". $self->getfield('last') );
697 $self->payname =~ /^([\w \,\.\-\']+)$/
698 or return gettext('illegal_name'). " payname: ". $self->payname;
702 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
705 $self->otaker(getotaker);
707 #warn "AFTER: \n". $self->_dump;
714 Returns all packages (see L<FS::cust_pkg>) for this customer.
720 if ( $self->{'_pkgnum'} ) {
721 values %{ $self->{'_pkgnum'}->cache };
723 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
727 =item ncancelled_pkgs
729 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
733 sub ncancelled_pkgs {
735 if ( $self->{'_pkgnum'} ) {
736 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
738 @{ [ # force list context
739 qsearch( 'cust_pkg', {
740 'custnum' => $self->custnum,
743 qsearch( 'cust_pkg', {
744 'custnum' => $self->custnum,
753 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
759 grep { $_->susp } $self->ncancelled_pkgs;
762 =item unflagged_suspended_pkgs
764 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
765 customer (thouse packages without the `manual_flag' set).
769 sub unflagged_suspended_pkgs {
771 return $self->suspended_pkgs
772 unless dbdef->table('cust_pkg')->column('manual_flag');
773 grep { ! $_->manual_flag } $self->suspended_pkgs;
776 =item unsuspended_pkgs
778 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
783 sub unsuspended_pkgs {
785 grep { ! $_->susp } $self->ncancelled_pkgs;
790 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
791 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
792 on success or a list of errors.
798 grep { $_->unsuspend } $self->suspended_pkgs;
803 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
804 Always returns a list: an empty list on success or a list of errors.
810 grep { $_->suspend } $self->unsuspended_pkgs;
815 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
816 Always returns a list: an empty list on success or a list of errors.
822 grep { $_->cancel } $self->ncancelled_pkgs;
827 Returns the agent (see L<FS::agent>) for this customer.
833 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
838 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
839 conjunction with the collect method.
841 Options are passed as name-value pairs.
843 The only currently available option is `time', which bills the customer as if
844 it were that time. It is specified as a UNIX timestamp; see
845 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
846 functions. For example:
850 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
852 If there is an error, returns the error, otherwise returns false.
857 my( $self, %options ) = @_;
858 my $time = $options{'time'} || time;
863 local $SIG{HUP} = 'IGNORE';
864 local $SIG{INT} = 'IGNORE';
865 local $SIG{QUIT} = 'IGNORE';
866 local $SIG{TERM} = 'IGNORE';
867 local $SIG{TSTP} = 'IGNORE';
868 local $SIG{PIPE} = 'IGNORE';
870 my $oldAutoCommit = $FS::UID::AutoCommit;
871 local $FS::UID::AutoCommit = 0;
874 # find the packages which are due for billing, find out how much they are
875 # & generate invoice database.
877 my( $total_setup, $total_recur ) = ( 0, 0 );
878 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
879 my @cust_bill_pkg = ();
881 #my $taxable_charged = 0;##
884 foreach my $cust_pkg (
885 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
888 #NO!! next if $cust_pkg->cancel;
889 next if $cust_pkg->getfield('cancel');
891 #? to avoid use of uninitialized value errors... ?
892 $cust_pkg->setfield('bill', '')
893 unless defined($cust_pkg->bill);
895 my $part_pkg = $cust_pkg->part_pkg;
897 #so we don't modify cust_pkg record unnecessarily
898 my $cust_pkg_mod_flag = 0;
899 my %hash = $cust_pkg->hash;
900 my $old_cust_pkg = new FS::cust_pkg \%hash;
904 unless ( $cust_pkg->setup ) {
905 my $setup_prog = $part_pkg->getfield('setup');
906 $setup_prog =~ /^(.*)$/ or do {
907 $dbh->rollback if $oldAutoCommit;
908 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
914 ##$cpt->permit(); #what is necessary?
915 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
916 #$setup = $cpt->reval($setup_prog);
917 $setup = eval $setup_prog;
918 unless ( defined($setup) ) {
919 $dbh->rollback if $oldAutoCommit;
920 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
921 "(expression $setup_prog): $@";
923 $cust_pkg->setfield('setup',$time);
924 $cust_pkg_mod_flag=1;
930 if ( $part_pkg->getfield('freq') > 0 &&
931 ! $cust_pkg->getfield('susp') &&
932 ( $cust_pkg->getfield('bill') || 0 ) < $time
934 my $recur_prog = $part_pkg->getfield('recur');
935 $recur_prog =~ /^(.*)$/ or do {
936 $dbh->rollback if $oldAutoCommit;
937 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
942 # shared with $recur_prog
943 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
946 ##$cpt->permit(); #what is necessary?
947 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
948 #$recur = $cpt->reval($recur_prog);
949 $recur = eval $recur_prog;
950 unless ( defined($recur) ) {
951 $dbh->rollback if $oldAutoCommit;
952 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
953 "(expression $recur_prog): $@";
955 #change this bit to use Date::Manip? CAREFUL with timezones (see
956 # mailing list archive)
957 my ($sec,$min,$hour,$mday,$mon,$year) =
958 (localtime($sdate) )[0,1,2,3,4,5];
960 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
961 # only for figuring next bill date, nothing else, so, reset $sdate again
963 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
965 $mon += $part_pkg->freq;
966 until ( $mon < 12 ) { $mon -= 12; $year++; }
967 $cust_pkg->setfield('bill',
968 timelocal($sec,$min,$hour,$mday,$mon,$year));
969 $cust_pkg_mod_flag = 1;
972 warn "\$setup is undefined" unless defined($setup);
973 warn "\$recur is undefined" unless defined($recur);
974 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
976 my $taxable_charged = 0;
977 if ( $cust_pkg_mod_flag ) {
978 $error=$cust_pkg->replace($old_cust_pkg);
979 if ( $error ) { #just in case
980 $dbh->rollback if $oldAutoCommit;
981 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
983 $setup = sprintf( "%.2f", $setup );
984 $recur = sprintf( "%.2f", $recur );
986 $dbh->rollback if $oldAutoCommit;
987 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
990 $dbh->rollback if $oldAutoCommit;
991 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
993 if ( $setup > 0 || $recur > 0 ) {
994 my $cust_bill_pkg = new FS::cust_bill_pkg ({
995 'pkgnum' => $cust_pkg->pkgnum,
999 'edate' => $cust_pkg->bill,
1001 push @cust_bill_pkg, $cust_bill_pkg;
1002 $total_setup += $setup;
1003 $total_recur += $recur;
1004 $taxable_charged += $setup
1005 unless $part_pkg->setuptax =~ /^Y$/i;
1006 $taxable_charged += $recur
1007 unless $part_pkg->recurtax =~ /^Y$/i;
1009 unless ( $self->tax =~ /Y/i
1010 || $self->payby eq 'COMP'
1011 || $taxable_charged == 0 ) {
1013 my $cust_main_county =
1014 qsearchs('cust_main_county',{
1015 'state' => $self->state,
1016 'county' => $self->county,
1017 'country' => $self->country,
1018 'taxclass' => $part_pkg->taxclass,
1020 or qsearchs('cust_main_county',{
1021 'state' => $self->state,
1022 'county' => $self->county,
1023 'country' => $self->country,
1027 $dbh->rollback if $oldAutoCommit;
1029 "fatal: can't find tax rate for state/county/country/taxclass ".
1030 join('/', map $self->$_(), qw(state county country taxclass) ).
1034 if ( $cust_main_county->exempt_amount ) {
1035 my ($mon,$year) = (localtime($sdate) )[4,5];
1037 my $freq = $part_pkg->freq || 1;
1038 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1039 foreach my $which_month ( 1 .. $freq ) {
1041 'custnum' => $self->custnum,
1042 'taxnum' => $cust_main_county->taxnum,
1043 'year' => 1900+$year,
1046 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1047 until ( $mon < 13 ) { $mon -= 12; $year++; }
1048 my $cust_tax_exempt =
1049 qsearchs('cust_tax_exempt', \%hash)
1050 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1051 my $remaining_exemption = sprintf("%.2f",
1052 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1053 if ( $remaining_exemption > 0 ) {
1054 my $addl = $remaining_exemption > $taxable_per_month
1055 ? $taxable_per_month
1056 : $remaining_exemption;
1057 $taxable_charged -= $addl;
1058 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1059 $cust_tax_exempt->hash,
1060 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1062 $error = $new_cust_tax_exempt->exemptnum
1063 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1064 : $new_cust_tax_exempt->insert;
1066 $dbh->rollback if $oldAutoCommit;
1067 return "fatal: can't update cust_tax_exempt: $error";
1070 } # if $remaining_exemption > 0
1072 } #foreach $which_month
1074 } #if $cust_main_county->exempt_amount
1076 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1077 $tax += $taxable_charged * $cust_main_county->tax / 100
1079 } #unless $self->tax =~ /Y/i
1080 # || $self->payby eq 'COMP'
1081 # || $taxable_charged == 0
1083 } #if $setup > 0 || $recur > 0
1085 } #if $cust_pkg_mod_flag
1087 } #foreach my $cust_pkg
1089 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1090 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1092 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1093 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1097 # unless ( $self->tax =~ /Y/i
1098 # || $self->payby eq 'COMP'
1099 # || $taxable_charged == 0 ) {
1100 # my $cust_main_county = qsearchs('cust_main_county',{
1101 # 'state' => $self->state,
1102 # 'county' => $self->county,
1103 # 'country' => $self->country,
1104 # } ) or die "fatal: can't find tax rate for state/county/country ".
1105 # $self->state. "/". $self->county. "/". $self->country. "\n";
1106 # my $tax = sprintf( "%.2f",
1107 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1110 $tax = sprintf("%.2f", $tax);
1112 $charged = sprintf( "%.2f", $charged+$tax );
1114 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1121 push @cust_bill_pkg, $cust_bill_pkg;
1125 my $cust_bill = new FS::cust_bill ( {
1126 'custnum' => $self->custnum,
1128 'charged' => $charged,
1130 $error = $cust_bill->insert;
1132 $dbh->rollback if $oldAutoCommit;
1133 return "can't create invoice for customer #". $self->custnum. ": $error";
1136 my $invnum = $cust_bill->invnum;
1138 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1140 $cust_bill_pkg->invnum($invnum);
1141 $error = $cust_bill_pkg->insert;
1143 $dbh->rollback if $oldAutoCommit;
1144 return "can't create invoice line item for customer #". $self->custnum.
1149 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1153 =item collect OPTIONS
1155 (Attempt to) collect money for this customer's outstanding invoices (see
1156 L<FS::cust_bill>). Usually used after the bill method.
1158 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1159 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1161 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1162 and the invoice events web interface.
1164 If there is an error, returns the error, otherwise returns false.
1166 Options are passed as name-value pairs.
1168 Currently available options are:
1170 invoice_time - Use this time when deciding when to print invoices and
1171 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>
1172 for conversion functions.
1174 batch_card - This option is deprecated. See the invoice events web interface
1175 to control whether cards are batched or run against a realtime gateway.
1177 report_badcard - This option is deprecated.
1179 force_print - This option is deprecated; see the invoice events web interface.
1184 my( $self, %options ) = @_;
1185 my $invoice_time = $options{'invoice_time'} || time;
1188 local $SIG{HUP} = 'IGNORE';
1189 local $SIG{INT} = 'IGNORE';
1190 local $SIG{QUIT} = 'IGNORE';
1191 local $SIG{TERM} = 'IGNORE';
1192 local $SIG{TSTP} = 'IGNORE';
1193 local $SIG{PIPE} = 'IGNORE';
1195 my $oldAutoCommit = $FS::UID::AutoCommit;
1196 local $FS::UID::AutoCommit = 0;
1199 my $balance = $self->balance;
1200 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1201 unless ( $balance > 0 ) { #redundant?????
1202 $dbh->rollback if $oldAutoCommit; #hmm
1206 foreach my $cust_bill (
1207 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1210 #this has to be before next's
1211 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1215 $balance = sprintf( "%.2f", $balance - $amount );
1217 next unless $cust_bill->owed > 0;
1219 # don't try to charge for the same invoice if it's already in a batch
1220 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1222 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1224 next unless $amount > 0;
1226 foreach my $part_bill_event (
1227 sort { $a->seconds <=> $b->seconds
1228 || $a->weight <=> $b->weight
1229 || $a->eventpart <=> $b->eventpart }
1230 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1231 && ! qsearchs( 'cust_bill_event', {
1232 'invnum' => $cust_bill->invnum,
1233 'eventpart' => $_->eventpart,
1237 qsearch('part_bill_event', { 'payby' => $self->payby,
1238 'disabled' => '', } )
1241 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1243 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1245 my $cust_main = $self; #for callback
1246 my $error = eval $part_bill_event->eventcode;
1249 my $statustext = '';
1253 } elsif ( $error ) {
1255 $statustext = $error;
1260 #add cust_bill_event
1261 my $cust_bill_event = new FS::cust_bill_event {
1262 'invnum' => $cust_bill->invnum,
1263 'eventpart' => $part_bill_event->eventpart,
1264 '_date' => $invoice_time,
1265 'status' => $status,
1266 'statustext' => $statustext,
1268 $error = $cust_bill_event->insert;
1270 #$dbh->rollback if $oldAutoCommit;
1271 #return "error: $error";
1273 # gah, even with transactions.
1274 $dbh->commit if $oldAutoCommit; #well.
1275 my $e = 'WARNING: Event run but database not updated - '.
1276 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1277 ', eventpart '. $part_bill_event->eventpart.
1288 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1295 Returns the total owed for this customer on all invoices
1296 (see L<FS::cust_bill/owed>).
1302 $self->total_owed_date(2145859200); #12/31/2037
1305 =item total_owed_date TIME
1307 Returns the total owed for this customer on all invoices with date earlier than
1308 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1309 see L<Time::Local> and L<Date::Parse> for conversion functions.
1313 sub total_owed_date {
1317 foreach my $cust_bill (
1318 grep { $_->_date <= $time }
1319 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1321 $total_bill += $cust_bill->owed;
1323 sprintf( "%.2f", $total_bill );
1328 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1329 to outstanding invoice balances in chronological order and returns the value
1330 of any remaining unapplied credits available for refund
1331 (see L<FS::cust_refund>).
1338 return 0 unless $self->total_credited;
1340 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1341 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1343 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1344 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1348 foreach my $cust_bill ( @invoices ) {
1351 if ( !defined($credit) || $credit->credited == 0) {
1352 $credit = pop @credits or last;
1355 if ($cust_bill->owed >= $credit->credited) {
1356 $amount=$credit->credited;
1358 $amount=$cust_bill->owed;
1361 my $cust_credit_bill = new FS::cust_credit_bill ( {
1362 'crednum' => $credit->crednum,
1363 'invnum' => $cust_bill->invnum,
1364 'amount' => $amount,
1366 my $error = $cust_credit_bill->insert;
1367 die $error if $error;
1369 redo if ($cust_bill->owed > 0);
1373 return $self->total_credited;
1376 =item apply_payments
1378 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1379 to outstanding invoice balances in chronological order.
1381 #and returns the value of any remaining unapplied payments.
1385 sub apply_payments {
1390 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1391 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1393 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1394 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1398 foreach my $cust_bill ( @invoices ) {
1401 if ( !defined($payment) || $payment->unapplied == 0 ) {
1402 $payment = pop @payments or last;
1405 if ( $cust_bill->owed >= $payment->unapplied ) {
1406 $amount = $payment->unapplied;
1408 $amount = $cust_bill->owed;
1411 my $cust_bill_pay = new FS::cust_bill_pay ( {
1412 'paynum' => $payment->paynum,
1413 'invnum' => $cust_bill->invnum,
1414 'amount' => $amount,
1416 my $error = $cust_bill_pay->insert;
1417 die $error if $error;
1419 redo if ( $cust_bill->owed > 0);
1423 return $self->total_unapplied_payments;
1426 =item total_credited
1428 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1429 customer. See L<FS::cust_credit/credited>.
1433 sub total_credited {
1435 my $total_credit = 0;
1436 foreach my $cust_credit ( qsearch('cust_credit', {
1437 'custnum' => $self->custnum,
1439 $total_credit += $cust_credit->credited;
1441 sprintf( "%.2f", $total_credit );
1444 =item total_unapplied_payments
1446 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1447 See L<FS::cust_pay/unapplied>.
1451 sub total_unapplied_payments {
1453 my $total_unapplied = 0;
1454 foreach my $cust_pay ( qsearch('cust_pay', {
1455 'custnum' => $self->custnum,
1457 $total_unapplied += $cust_pay->unapplied;
1459 sprintf( "%.2f", $total_unapplied );
1464 Returns the balance for this customer (total_owed minus total_credited
1465 minus total_unapplied_payments).
1472 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1476 =item balance_date TIME
1478 Returns the balance for this customer, only considering invoices with date
1479 earlier than TIME (total_owed_date minus total_credited minus
1480 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1481 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1490 $self->total_owed_date($time)
1491 - $self->total_credited
1492 - $self->total_unapplied_payments
1496 =item invoicing_list [ ARRAYREF ]
1498 If an arguement is given, sets these email addresses as invoice recipients
1499 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1500 (except as warnings), so use check_invoicing_list first.
1502 Returns a list of email addresses (with svcnum entries expanded).
1504 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1505 check it without disturbing anything by passing nothing.
1507 This interface may change in the future.
1511 sub invoicing_list {
1512 my( $self, $arrayref ) = @_;
1514 my @cust_main_invoice;
1515 if ( $self->custnum ) {
1516 @cust_main_invoice =
1517 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1519 @cust_main_invoice = ();
1521 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1522 #warn $cust_main_invoice->destnum;
1523 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1524 #warn $cust_main_invoice->destnum;
1525 my $error = $cust_main_invoice->delete;
1526 warn $error if $error;
1529 if ( $self->custnum ) {
1530 @cust_main_invoice =
1531 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1533 @cust_main_invoice = ();
1535 my %seen = map { $_->address => 1 } @cust_main_invoice;
1536 foreach my $address ( @{$arrayref} ) {
1537 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1538 next if exists $seen{$address} && $seen{$address};
1539 $seen{$address} = 1;
1540 my $cust_main_invoice = new FS::cust_main_invoice ( {
1541 'custnum' => $self->custnum,
1544 my $error = $cust_main_invoice->insert;
1545 warn $error if $error;
1548 if ( $self->custnum ) {
1550 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1556 =item check_invoicing_list ARRAYREF
1558 Checks these arguements as valid input for the invoicing_list method. If there
1559 is an error, returns the error, otherwise returns false.
1563 sub check_invoicing_list {
1564 my( $self, $arrayref ) = @_;
1565 foreach my $address ( @{$arrayref} ) {
1566 my $cust_main_invoice = new FS::cust_main_invoice ( {
1567 'custnum' => $self->custnum,
1570 my $error = $self->custnum
1571 ? $cust_main_invoice->check
1572 : $cust_main_invoice->checkdest
1574 return $error if $error;
1579 =item default_invoicing_list
1581 Sets the invoicing list to all accounts associated with this customer.
1585 sub default_invoicing_list {
1588 foreach my $cust_pkg ( $self->all_pkgs ) {
1589 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1591 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1592 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1594 push @list, map { $_->email } @svc_acct;
1596 $self->invoicing_list(\@list);
1599 =item invoicing_list_addpost
1601 Adds postal invoicing to this customer. If this customer is already configured
1602 to receive postal invoices, does nothing.
1606 sub invoicing_list_addpost {
1608 return if grep { $_ eq 'POST' } $self->invoicing_list;
1609 my @invoicing_list = $self->invoicing_list;
1610 push @invoicing_list, 'POST';
1611 $self->invoicing_list(\@invoicing_list);
1614 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1616 Returns an array of customers referred by this customer (referral_custnum set
1617 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1618 customers referred by customers referred by this customer and so on, inclusive.
1619 The default behavior is DEPTH 1 (no recursion).
1623 sub referral_cust_main {
1625 my $depth = @_ ? shift : 1;
1626 my $exclude = @_ ? shift : {};
1629 map { $exclude->{$_->custnum}++; $_; }
1630 grep { ! $exclude->{ $_->custnum } }
1631 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1635 map { $_->referral_cust_main($depth-1, $exclude) }
1642 =item referral_cust_main_ncancelled
1644 Same as referral_cust_main, except only returns customers with uncancelled
1649 sub referral_cust_main_ncancelled {
1651 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1654 =item referral_cust_pkg [ DEPTH ]
1656 Like referral_cust_main, except returns a flat list of all unsuspended (and
1657 uncancelled) packages for each customer. The number of items in this list may
1658 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1662 sub referral_cust_pkg {
1664 my $depth = @_ ? shift : 1;
1666 map { $_->unsuspended_pkgs }
1667 grep { $_->unsuspended_pkgs }
1668 $self->referral_cust_main($depth);
1671 =item credit AMOUNT, REASON
1673 Applies a credit to this customer. If there is an error, returns the error,
1674 otherwise returns false.
1679 my( $self, $amount, $reason ) = @_;
1680 my $cust_credit = new FS::cust_credit {
1681 'custnum' => $self->custnum,
1682 'amount' => $amount,
1683 'reason' => $reason,
1685 $cust_credit->insert;
1688 =item charge AMOUNT PKG COMMENT
1690 Creates a one-time charge for this customer. If there is an error, returns
1691 the error, otherwise returns false.
1696 my ( $self, $amount, $pkg, $comment ) = @_;
1698 my $part_pkg = new FS::part_pkg ( {
1699 'pkg' => $pkg || 'One-time charge',
1700 'comment' => $comment || '$'. sprintf("%.2f".$amount),
1717 =item check_and_rebuild_fuzzyfiles
1721 sub check_and_rebuild_fuzzyfiles {
1722 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1723 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1724 or &rebuild_fuzzyfiles;
1727 =item rebuild_fuzzyfiles
1731 sub rebuild_fuzzyfiles {
1733 use Fcntl qw(:flock);
1735 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1739 open(LASTLOCK,">>$dir/cust_main.last")
1740 or die "can't open $dir/cust_main.last: $!";
1741 flock(LASTLOCK,LOCK_EX)
1742 or die "can't lock $dir/cust_main.last: $!";
1744 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1746 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1747 if defined dbdef->table('cust_main')->column('ship_last');
1749 open (LASTCACHE,">$dir/cust_main.last.tmp")
1750 or die "can't open $dir/cust_main.last.tmp: $!";
1751 print LASTCACHE join("\n", @all_last), "\n";
1752 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1754 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1759 open(COMPANYLOCK,">>$dir/cust_main.company")
1760 or die "can't open $dir/cust_main.company: $!";
1761 flock(COMPANYLOCK,LOCK_EX)
1762 or die "can't lock $dir/cust_main.company: $!";
1764 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1766 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1767 if defined dbdef->table('cust_main')->column('ship_last');
1769 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1770 or die "can't open $dir/cust_main.company.tmp: $!";
1771 print COMPANYCACHE join("\n", @all_company), "\n";
1772 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1774 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1784 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1785 open(LASTCACHE,"<$dir/cust_main.last")
1786 or die "can't open $dir/cust_main.last: $!";
1787 my @array = map { chomp; $_; } <LASTCACHE>;
1797 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1798 open(COMPANYCACHE,"<$dir/cust_main.company")
1799 or die "can't open $dir/cust_main.last: $!";
1800 my @array = map { chomp; $_; } <COMPANYCACHE>;
1805 =item append_fuzzyfiles LASTNAME COMPANY
1809 sub append_fuzzyfiles {
1810 my( $last, $company ) = @_;
1812 &check_and_rebuild_fuzzyfiles;
1814 use Fcntl qw(:flock);
1816 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1820 open(LAST,">>$dir/cust_main.last")
1821 or die "can't open $dir/cust_main.last: $!";
1823 or die "can't lock $dir/cust_main.last: $!";
1825 print LAST "$last\n";
1828 or die "can't unlock $dir/cust_main.last: $!";
1834 open(COMPANY,">>$dir/cust_main.company")
1835 or die "can't open $dir/cust_main.company: $!";
1836 flock(COMPANY,LOCK_EX)
1837 or die "can't lock $dir/cust_main.company: $!";
1839 print COMPANY "$company\n";
1841 flock(COMPANY,LOCK_UN)
1842 or die "can't unlock $dir/cust_main.company: $!";
1856 The delete method should possibly take an FS::cust_main object reference
1857 instead of a scalar customer number.
1859 Bill and collect options should probably be passed as references instead of a
1862 There should probably be a configuration file with a list of allowed credit
1865 No multiple currency support (probably a larger project than just this module).
1869 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1870 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1871 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.