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' ] );
223 my $cust_pkgs = @_ ? shift : {};
224 my $invoicing_list = @_ ? shift : '';
226 local $SIG{HUP} = 'IGNORE';
227 local $SIG{INT} = 'IGNORE';
228 local $SIG{QUIT} = 'IGNORE';
229 local $SIG{TERM} = 'IGNORE';
230 local $SIG{TSTP} = 'IGNORE';
231 local $SIG{PIPE} = 'IGNORE';
233 my $oldAutoCommit = $FS::UID::AutoCommit;
234 local $FS::UID::AutoCommit = 0;
239 if ( $self->payby eq 'PREPAY' ) {
240 $self->payby('BILL');
241 my $prepay_credit = qsearchs(
243 { 'identifier' => $self->payinfo },
247 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
248 unless $prepay_credit;
249 $amount = $prepay_credit->amount;
250 $seconds = $prepay_credit->seconds;
251 my $error = $prepay_credit->delete;
253 $dbh->rollback if $oldAutoCommit;
254 return "removing prepay_credit (transaction rolled back): $error";
258 my $error = $self->SUPER::insert;
260 $dbh->rollback if $oldAutoCommit;
261 #return "inserting cust_main record (transaction rolled back): $error";
266 if ( $invoicing_list ) {
267 $error = $self->check_invoicing_list( $invoicing_list );
269 $dbh->rollback if $oldAutoCommit;
270 return "checking invoicing_list (transaction rolled back): $error";
272 $self->invoicing_list( $invoicing_list );
276 foreach my $cust_pkg ( keys %$cust_pkgs ) {
277 $cust_pkg->custnum( $self->custnum );
278 $error = $cust_pkg->insert;
280 $dbh->rollback if $oldAutoCommit;
281 return "inserting cust_pkg (transaction rolled back): $error";
283 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
284 $svc_something->pkgnum( $cust_pkg->pkgnum );
285 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
286 $svc_something->seconds( $svc_something->seconds + $seconds );
289 $error = $svc_something->insert;
291 $dbh->rollback if $oldAutoCommit;
292 #return "inserting svc_ (transaction rolled back): $error";
299 $dbh->rollback if $oldAutoCommit;
300 return "No svc_acct record to apply pre-paid time";
304 my $cust_credit = new FS::cust_credit {
305 'custnum' => $self->custnum,
308 $error = $cust_credit->insert;
310 $dbh->rollback if $oldAutoCommit;
311 return "inserting credit (transaction rolled back): $error";
315 #false laziness with sub replace
316 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
317 $error = $queue->insert($self->getfield('last'), $self->company);
319 $dbh->rollback if $oldAutoCommit;
320 return "queueing job (transaction rolled back): $error";
323 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
324 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
325 $error = $queue->insert($self->getfield('last'), $self->company);
327 $dbh->rollback if $oldAutoCommit;
328 return "queueing job (transaction rolled back): $error";
333 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
338 =item delete NEW_CUSTNUM
340 This deletes the customer. If there is an error, returns the error, otherwise
343 This will completely remove all traces of the customer record. This is not
344 what you want when a customer cancels service; for that, cancel all of the
345 customer's packages (see L<FS::cust_pkg/cancel>).
347 If the customer has any uncancelled packages, you need to pass a new (valid)
348 customer number for those packages to be transferred to. Cancelled packages
349 will be deleted. Did I mention that this is NOT what you want when a customer
350 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
352 You can't delete a customer with invoices (see L<FS::cust_bill>),
353 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
354 refunds (see L<FS::cust_refund>).
361 local $SIG{HUP} = 'IGNORE';
362 local $SIG{INT} = 'IGNORE';
363 local $SIG{QUIT} = 'IGNORE';
364 local $SIG{TERM} = 'IGNORE';
365 local $SIG{TSTP} = 'IGNORE';
366 local $SIG{PIPE} = 'IGNORE';
368 my $oldAutoCommit = $FS::UID::AutoCommit;
369 local $FS::UID::AutoCommit = 0;
372 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
373 $dbh->rollback if $oldAutoCommit;
374 return "Can't delete a customer with invoices";
376 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
377 $dbh->rollback if $oldAutoCommit;
378 return "Can't delete a customer with credits";
380 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
381 $dbh->rollback if $oldAutoCommit;
382 return "Can't delete a customer with payments";
384 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
385 $dbh->rollback if $oldAutoCommit;
386 return "Can't delete a customer with refunds";
389 my @cust_pkg = $self->ncancelled_pkgs;
391 my $new_custnum = shift;
392 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
393 $dbh->rollback if $oldAutoCommit;
394 return "Invalid new customer number: $new_custnum";
396 foreach my $cust_pkg ( @cust_pkg ) {
397 my %hash = $cust_pkg->hash;
398 $hash{'custnum'} = $new_custnum;
399 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
400 my $error = $new_cust_pkg->replace($cust_pkg);
402 $dbh->rollback if $oldAutoCommit;
407 my @cancelled_cust_pkg = $self->all_pkgs;
408 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
409 my $error = $cust_pkg->delete;
411 $dbh->rollback if $oldAutoCommit;
416 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
417 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
419 my $error = $cust_main_invoice->delete;
421 $dbh->rollback if $oldAutoCommit;
426 my $error = $self->SUPER::delete;
428 $dbh->rollback if $oldAutoCommit;
432 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
437 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
439 Replaces the OLD_RECORD with this one in the database. If there is an error,
440 returns the error, otherwise returns false.
442 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
443 be set as the invoicing list (see L<"invoicing_list">). Errors return as
444 expected and rollback the entire transaction; it is not necessary to call
445 check_invoicing_list first. Here's an example:
447 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
456 local $SIG{HUP} = 'IGNORE';
457 local $SIG{INT} = 'IGNORE';
458 local $SIG{QUIT} = 'IGNORE';
459 local $SIG{TERM} = 'IGNORE';
460 local $SIG{TSTP} = 'IGNORE';
461 local $SIG{PIPE} = 'IGNORE';
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 eq 'CARD' &&
485 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
486 # card info has changed, want to retry realtime_card invoice events
487 #false laziness w/collect
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 map { $_->cust_bill_event }
496 grep { $_->cust_bill_event }
497 $self->open_cust_bill
500 my $error = $cust_bill_event->retry;
502 $dbh->rollback if $oldAutoCommit;
503 return "error scheduling invoice events for retry: $error";
510 #false laziness with sub insert
511 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
512 $error = $queue->insert($self->getfield('last'), $self->company);
514 $dbh->rollback if $oldAutoCommit;
515 return "queueing job (transaction rolled back): $error";
518 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
519 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
520 $error = $queue->insert($self->getfield('last'), $self->company);
522 $dbh->rollback if $oldAutoCommit;
523 return "queueing job (transaction rolled back): $error";
528 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
535 Checks all fields to make sure this is a valid customer record. If there is
536 an error, returns the error, otherwise returns false. Called by the insert
544 #warn "BEFORE: \n". $self->_dump;
547 $self->ut_numbern('custnum')
548 || $self->ut_number('agentnum')
549 || $self->ut_number('refnum')
550 || $self->ut_name('last')
551 || $self->ut_name('first')
552 || $self->ut_textn('company')
553 || $self->ut_text('address1')
554 || $self->ut_textn('address2')
555 || $self->ut_text('city')
556 || $self->ut_textn('county')
557 || $self->ut_textn('state')
558 || $self->ut_country('country')
559 || $self->ut_anything('comments')
560 || $self->ut_numbern('referral_custnum')
562 #barf. need message catalogs. i18n. etc.
563 $error .= "Please select a advertising source."
564 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
565 return $error if $error;
567 return "Unknown agent"
568 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
570 return "Unknown refnum"
571 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
573 return "Unknown referring custnum ". $self->referral_custnum
574 unless ! $self->referral_custnum
575 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
577 if ( $self->ss eq '' ) {
582 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
583 or return "Illegal social security number: ". $self->ss;
584 $self->ss("$1-$2-$3");
588 # bad idea to disable, causes billing to fail because of no tax rates later
589 # unless ( $import ) {
590 unless ( qsearchs('cust_main_county', {
591 'country' => $self->country,
594 return "Unknown state/county/country: ".
595 $self->state. "/". $self->county. "/". $self->country
596 unless qsearchs('cust_main_county',{
597 'state' => $self->state,
598 'county' => $self->county,
599 'country' => $self->country,
605 $self->ut_phonen('daytime', $self->country)
606 || $self->ut_phonen('night', $self->country)
607 || $self->ut_phonen('fax', $self->country)
608 || $self->ut_zip('zip', $self->country)
610 return $error if $error;
613 last first company address1 address2 city county state zip
614 country daytime night fax
617 if ( defined $self->dbdef_table->column('ship_last') ) {
618 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
620 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
624 $self->ut_name('ship_last')
625 || $self->ut_name('ship_first')
626 || $self->ut_textn('ship_company')
627 || $self->ut_text('ship_address1')
628 || $self->ut_textn('ship_address2')
629 || $self->ut_text('ship_city')
630 || $self->ut_textn('ship_county')
631 || $self->ut_textn('ship_state')
632 || $self->ut_country('ship_country')
634 return $error if $error;
636 #false laziness with above
637 unless ( qsearchs('cust_main_county', {
638 'country' => $self->ship_country,
641 return "Unknown ship_state/ship_county/ship_country: ".
642 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
643 unless qsearchs('cust_main_county',{
644 'state' => $self->ship_state,
645 'county' => $self->ship_county,
646 'country' => $self->ship_country,
652 $self->ut_phonen('ship_daytime', $self->ship_country)
653 || $self->ut_phonen('ship_night', $self->ship_country)
654 || $self->ut_phonen('ship_fax', $self->ship_country)
655 || $self->ut_zip('ship_zip', $self->ship_country)
657 return $error if $error;
659 } else { # ship_ info eq billing info, so don't store dup info in database
660 $self->setfield("ship_$_", '')
661 foreach qw( last first company address1 address2 city county state zip
662 country daytime night fax );
666 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
667 or return "Illegal payby: ". $self->payby;
670 if ( $self->payby eq 'CARD' ) {
672 my $payinfo = $self->payinfo;
674 $payinfo =~ /^(\d{13,16})$/
675 or return gettext('invalid_card'); # . ": ". $self->payinfo;
677 $self->payinfo($payinfo);
679 or return gettext('invalid_card'); # . ": ". $self->payinfo;
680 return gettext('unknown_card_type')
681 if cardtype($self->payinfo) eq "Unknown";
683 } elsif ( $self->payby eq 'BILL' ) {
685 $error = $self->ut_textn('payinfo');
686 return "Illegal P.O. number: ". $self->payinfo if $error;
688 } elsif ( $self->payby eq 'COMP' ) {
690 $error = $self->ut_textn('payinfo');
691 return "Illegal comp account issuer: ". $self->payinfo if $error;
693 } elsif ( $self->payby eq 'PREPAY' ) {
695 my $payinfo = $self->payinfo;
696 $payinfo =~ s/\W//g; #anything else would just confuse things
697 $self->payinfo($payinfo);
698 $error = $self->ut_alpha('payinfo');
699 return "Illegal prepayment identifier: ". $self->payinfo if $error;
700 return "Unknown prepayment identifier"
701 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
705 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
706 return "Expriation date required"
707 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
710 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
711 or return "Illegal expiration date: ". $self->paydate;
712 my $y = length($2) == 4 ? $2 : "20$2";
713 $self->paydate("$y-$1-01");
714 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
715 return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm );
718 if ( $self->payname eq '' &&
719 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
720 $self->payname( $self->first. " ". $self->getfield('last') );
722 $self->payname =~ /^([\w \,\.\-\']+)$/
723 or return gettext('illegal_name'). " payname: ". $self->payname;
727 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
730 $self->otaker(getotaker);
732 #warn "AFTER: \n". $self->_dump;
739 Returns all packages (see L<FS::cust_pkg>) for this customer.
745 if ( $self->{'_pkgnum'} ) {
746 values %{ $self->{'_pkgnum'}->cache };
748 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
752 =item ncancelled_pkgs
754 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
758 sub ncancelled_pkgs {
760 if ( $self->{'_pkgnum'} ) {
761 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
763 @{ [ # force list context
764 qsearch( 'cust_pkg', {
765 'custnum' => $self->custnum,
768 qsearch( 'cust_pkg', {
769 'custnum' => $self->custnum,
778 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
784 grep { $_->susp } $self->ncancelled_pkgs;
787 =item unflagged_suspended_pkgs
789 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
790 customer (thouse packages without the `manual_flag' set).
794 sub unflagged_suspended_pkgs {
796 return $self->suspended_pkgs
797 unless dbdef->table('cust_pkg')->column('manual_flag');
798 grep { ! $_->manual_flag } $self->suspended_pkgs;
801 =item unsuspended_pkgs
803 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
808 sub unsuspended_pkgs {
810 grep { ! $_->susp } $self->ncancelled_pkgs;
815 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
816 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
817 on success or a list of errors.
823 grep { $_->unsuspend } $self->suspended_pkgs;
828 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
829 Always returns a list: an empty list on success or a list of errors.
835 grep { $_->suspend } $self->unsuspended_pkgs;
840 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
841 Always returns a list: an empty list on success or a list of errors.
847 grep { $_->cancel } $self->ncancelled_pkgs;
852 Returns the agent (see L<FS::agent>) for this customer.
858 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
863 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
864 conjunction with the collect method.
866 Options are passed as name-value pairs.
868 The only currently available option is `time', which bills the customer as if
869 it were that time. It is specified as a UNIX timestamp; see
870 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
871 functions. For example:
875 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
877 If there is an error, returns the error, otherwise returns false.
882 my( $self, %options ) = @_;
883 my $time = $options{'time'} || time;
888 local $SIG{HUP} = 'IGNORE';
889 local $SIG{INT} = 'IGNORE';
890 local $SIG{QUIT} = 'IGNORE';
891 local $SIG{TERM} = 'IGNORE';
892 local $SIG{TSTP} = 'IGNORE';
893 local $SIG{PIPE} = 'IGNORE';
895 my $oldAutoCommit = $FS::UID::AutoCommit;
896 local $FS::UID::AutoCommit = 0;
899 # find the packages which are due for billing, find out how much they are
900 # & generate invoice database.
902 my( $total_setup, $total_recur ) = ( 0, 0 );
903 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
904 my @cust_bill_pkg = ();
906 #my $taxable_charged = 0;##
909 foreach my $cust_pkg (
910 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
913 #NO!! next if $cust_pkg->cancel;
914 next if $cust_pkg->getfield('cancel');
916 #? to avoid use of uninitialized value errors... ?
917 $cust_pkg->setfield('bill', '')
918 unless defined($cust_pkg->bill);
920 my $part_pkg = $cust_pkg->part_pkg;
922 #so we don't modify cust_pkg record unnecessarily
923 my $cust_pkg_mod_flag = 0;
924 my %hash = $cust_pkg->hash;
925 my $old_cust_pkg = new FS::cust_pkg \%hash;
929 unless ( $cust_pkg->setup ) {
930 my $setup_prog = $part_pkg->getfield('setup');
931 $setup_prog =~ /^(.*)$/ or do {
932 $dbh->rollback if $oldAutoCommit;
933 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
939 ##$cpt->permit(); #what is necessary?
940 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
941 #$setup = $cpt->reval($setup_prog);
942 $setup = eval $setup_prog;
943 unless ( defined($setup) ) {
944 $dbh->rollback if $oldAutoCommit;
945 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
946 "(expression $setup_prog): $@";
948 $cust_pkg->setfield('setup',$time);
949 $cust_pkg_mod_flag=1;
955 if ( $part_pkg->getfield('freq') > 0 &&
956 ! $cust_pkg->getfield('susp') &&
957 ( $cust_pkg->getfield('bill') || 0 ) < $time
959 my $recur_prog = $part_pkg->getfield('recur');
960 $recur_prog =~ /^(.*)$/ or do {
961 $dbh->rollback if $oldAutoCommit;
962 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
967 # shared with $recur_prog
968 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
971 ##$cpt->permit(); #what is necessary?
972 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
973 #$recur = $cpt->reval($recur_prog);
974 $recur = eval $recur_prog;
975 unless ( defined($recur) ) {
976 $dbh->rollback if $oldAutoCommit;
977 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
978 "(expression $recur_prog): $@";
980 #change this bit to use Date::Manip? CAREFUL with timezones (see
981 # mailing list archive)
982 my ($sec,$min,$hour,$mday,$mon,$year) =
983 (localtime($sdate) )[0,1,2,3,4,5];
985 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
986 # only for figuring next bill date, nothing else, so, reset $sdate again
988 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
990 $mon += $part_pkg->freq;
991 until ( $mon < 12 ) { $mon -= 12; $year++; }
992 $cust_pkg->setfield('bill',
993 timelocal($sec,$min,$hour,$mday,$mon,$year));
994 $cust_pkg_mod_flag = 1;
997 warn "\$setup is undefined" unless defined($setup);
998 warn "\$recur is undefined" unless defined($recur);
999 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1001 my $taxable_charged = 0;
1002 if ( $cust_pkg_mod_flag ) {
1003 $error=$cust_pkg->replace($old_cust_pkg);
1004 if ( $error ) { #just in case
1005 $dbh->rollback if $oldAutoCommit;
1006 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1008 $setup = sprintf( "%.2f", $setup );
1009 $recur = sprintf( "%.2f", $recur );
1011 $dbh->rollback if $oldAutoCommit;
1012 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1015 $dbh->rollback if $oldAutoCommit;
1016 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1018 if ( $setup > 0 || $recur > 0 ) {
1019 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1020 'pkgnum' => $cust_pkg->pkgnum,
1024 'edate' => $cust_pkg->bill,
1026 push @cust_bill_pkg, $cust_bill_pkg;
1027 $total_setup += $setup;
1028 $total_recur += $recur;
1029 $taxable_charged += $setup
1030 unless $part_pkg->setuptax =~ /^Y$/i;
1031 $taxable_charged += $recur
1032 unless $part_pkg->recurtax =~ /^Y$/i;
1034 unless ( $self->tax =~ /Y/i
1035 || $self->payby eq 'COMP'
1036 || $taxable_charged == 0 ) {
1038 my $cust_main_county =
1039 qsearchs('cust_main_county',{
1040 'state' => $self->state,
1041 'county' => $self->county,
1042 'country' => $self->country,
1043 'taxclass' => $part_pkg->taxclass,
1045 or qsearchs('cust_main_county',{
1046 'state' => $self->state,
1047 'county' => $self->county,
1048 'country' => $self->country,
1052 $dbh->rollback if $oldAutoCommit;
1054 "fatal: can't find tax rate for state/county/country/taxclass ".
1055 join('/', map $self->$_(), qw(state county country taxclass) ).
1059 if ( $cust_main_county->exempt_amount ) {
1060 my ($mon,$year) = (localtime($sdate) )[4,5];
1062 my $freq = $part_pkg->freq || 1;
1063 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1064 foreach my $which_month ( 1 .. $freq ) {
1066 'custnum' => $self->custnum,
1067 'taxnum' => $cust_main_county->taxnum,
1068 'year' => 1900+$year,
1071 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1072 until ( $mon < 13 ) { $mon -= 12; $year++; }
1073 my $cust_tax_exempt =
1074 qsearchs('cust_tax_exempt', \%hash)
1075 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1076 my $remaining_exemption = sprintf("%.2f",
1077 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1078 if ( $remaining_exemption > 0 ) {
1079 my $addl = $remaining_exemption > $taxable_per_month
1080 ? $taxable_per_month
1081 : $remaining_exemption;
1082 $taxable_charged -= $addl;
1083 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1084 $cust_tax_exempt->hash,
1085 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1087 $error = $new_cust_tax_exempt->exemptnum
1088 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1089 : $new_cust_tax_exempt->insert;
1091 $dbh->rollback if $oldAutoCommit;
1092 return "fatal: can't update cust_tax_exempt: $error";
1095 } # if $remaining_exemption > 0
1097 } #foreach $which_month
1099 } #if $cust_main_county->exempt_amount
1101 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1102 $tax += $taxable_charged * $cust_main_county->tax / 100
1104 } #unless $self->tax =~ /Y/i
1105 # || $self->payby eq 'COMP'
1106 # || $taxable_charged == 0
1108 } #if $setup > 0 || $recur > 0
1110 } #if $cust_pkg_mod_flag
1112 } #foreach my $cust_pkg
1114 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1115 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1117 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1118 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1122 # unless ( $self->tax =~ /Y/i
1123 # || $self->payby eq 'COMP'
1124 # || $taxable_charged == 0 ) {
1125 # my $cust_main_county = qsearchs('cust_main_county',{
1126 # 'state' => $self->state,
1127 # 'county' => $self->county,
1128 # 'country' => $self->country,
1129 # } ) or die "fatal: can't find tax rate for state/county/country ".
1130 # $self->state. "/". $self->county. "/". $self->country. "\n";
1131 # my $tax = sprintf( "%.2f",
1132 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1135 $tax = sprintf("%.2f", $tax);
1137 $charged = sprintf( "%.2f", $charged+$tax );
1139 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1146 push @cust_bill_pkg, $cust_bill_pkg;
1150 my $cust_bill = new FS::cust_bill ( {
1151 'custnum' => $self->custnum,
1153 'charged' => $charged,
1155 $error = $cust_bill->insert;
1157 $dbh->rollback if $oldAutoCommit;
1158 return "can't create invoice for customer #". $self->custnum. ": $error";
1161 my $invnum = $cust_bill->invnum;
1163 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1165 $cust_bill_pkg->invnum($invnum);
1166 $error = $cust_bill_pkg->insert;
1168 $dbh->rollback if $oldAutoCommit;
1169 return "can't create invoice line item for customer #". $self->custnum.
1174 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1178 =item collect OPTIONS
1180 (Attempt to) collect money for this customer's outstanding invoices (see
1181 L<FS::cust_bill>). Usually used after the bill method.
1183 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1184 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1186 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1187 and the invoice events web interface.
1189 If there is an error, returns the error, otherwise returns false.
1191 Options are passed as name-value pairs.
1193 Currently available options are:
1195 invoice_time - Use this time when deciding when to print invoices and
1196 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>
1197 for conversion functions.
1199 retry_card - Retry cards even when not scheduled by invoice events.
1201 batch_card - This option is deprecated. See the invoice events web interface
1202 to control whether cards are batched or run against a realtime gateway.
1204 report_badcard - This option is deprecated.
1206 force_print - This option is deprecated; see the invoice events web interface.
1211 my( $self, %options ) = @_;
1212 my $invoice_time = $options{'invoice_time'} || time;
1215 local $SIG{HUP} = 'IGNORE';
1216 local $SIG{INT} = 'IGNORE';
1217 local $SIG{QUIT} = 'IGNORE';
1218 local $SIG{TERM} = 'IGNORE';
1219 local $SIG{TSTP} = 'IGNORE';
1220 local $SIG{PIPE} = 'IGNORE';
1222 my $oldAutoCommit = $FS::UID::AutoCommit;
1223 local $FS::UID::AutoCommit = 0;
1226 my $balance = $self->balance;
1227 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1228 unless ( $balance > 0 ) { #redundant?????
1229 $dbh->rollback if $oldAutoCommit; #hmm
1233 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1234 #false laziness w/replace
1235 foreach my $cust_bill_event (
1237 #$_->part_bill_event->plan eq 'realtime-card'
1238 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1239 && $_->status eq 'done'
1242 map { $_->cust_bill_event }
1243 grep { $_->cust_bill_event }
1244 $self->open_cust_bill
1246 my $error = $cust_bill_event->retry;
1248 $dbh->rollback if $oldAutoCommit;
1249 return "error scheduling invoice events for retry: $error";
1255 foreach my $cust_bill ( $self->cust_bill ) {
1257 #this has to be before next's
1258 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1262 $balance = sprintf( "%.2f", $balance - $amount );
1264 next unless $cust_bill->owed > 0;
1266 # don't try to charge for the same invoice if it's already in a batch
1267 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1269 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1271 next unless $amount > 0;
1274 foreach my $part_bill_event (
1275 sort { $a->seconds <=> $b->seconds
1276 || $a->weight <=> $b->weight
1277 || $a->eventpart <=> $b->eventpart }
1278 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1279 && ! qsearchs( 'cust_bill_event', {
1280 'invnum' => $cust_bill->invnum,
1281 'eventpart' => $_->eventpart,
1285 qsearch('part_bill_event', { 'payby' => $self->payby,
1286 'disabled' => '', } )
1289 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1291 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1293 my $cust_main = $self; #for callback
1294 my $error = eval $part_bill_event->eventcode;
1297 my $statustext = '';
1301 } elsif ( $error ) {
1303 $statustext = $error;
1308 #add cust_bill_event
1309 my $cust_bill_event = new FS::cust_bill_event {
1310 'invnum' => $cust_bill->invnum,
1311 'eventpart' => $part_bill_event->eventpart,
1312 '_date' => $invoice_time,
1313 'status' => $status,
1314 'statustext' => $statustext,
1316 $error = $cust_bill_event->insert;
1318 #$dbh->rollback if $oldAutoCommit;
1319 #return "error: $error";
1321 # gah, even with transactions.
1322 $dbh->commit if $oldAutoCommit; #well.
1323 my $e = 'WARNING: Event run but database not updated - '.
1324 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1325 ', eventpart '. $part_bill_event->eventpart.
1336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1343 Returns the total owed for this customer on all invoices
1344 (see L<FS::cust_bill/owed>).
1350 $self->total_owed_date(2145859200); #12/31/2037
1353 =item total_owed_date TIME
1355 Returns the total owed for this customer on all invoices with date earlier than
1356 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1357 see L<Time::Local> and L<Date::Parse> for conversion functions.
1361 sub total_owed_date {
1365 foreach my $cust_bill (
1366 grep { $_->_date <= $time }
1367 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1369 $total_bill += $cust_bill->owed;
1371 sprintf( "%.2f", $total_bill );
1376 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1377 to outstanding invoice balances in chronological order and returns the value
1378 of any remaining unapplied credits available for refund
1379 (see L<FS::cust_refund>).
1386 return 0 unless $self->total_credited;
1388 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1389 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1391 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1392 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1396 foreach my $cust_bill ( @invoices ) {
1399 if ( !defined($credit) || $credit->credited == 0) {
1400 $credit = pop @credits or last;
1403 if ($cust_bill->owed >= $credit->credited) {
1404 $amount=$credit->credited;
1406 $amount=$cust_bill->owed;
1409 my $cust_credit_bill = new FS::cust_credit_bill ( {
1410 'crednum' => $credit->crednum,
1411 'invnum' => $cust_bill->invnum,
1412 'amount' => $amount,
1414 my $error = $cust_credit_bill->insert;
1415 die $error if $error;
1417 redo if ($cust_bill->owed > 0);
1421 return $self->total_credited;
1424 =item apply_payments
1426 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1427 to outstanding invoice balances in chronological order.
1429 #and returns the value of any remaining unapplied payments.
1433 sub apply_payments {
1438 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1439 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1441 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1442 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1446 foreach my $cust_bill ( @invoices ) {
1449 if ( !defined($payment) || $payment->unapplied == 0 ) {
1450 $payment = pop @payments or last;
1453 if ( $cust_bill->owed >= $payment->unapplied ) {
1454 $amount = $payment->unapplied;
1456 $amount = $cust_bill->owed;
1459 my $cust_bill_pay = new FS::cust_bill_pay ( {
1460 'paynum' => $payment->paynum,
1461 'invnum' => $cust_bill->invnum,
1462 'amount' => $amount,
1464 my $error = $cust_bill_pay->insert;
1465 die $error if $error;
1467 redo if ( $cust_bill->owed > 0);
1471 return $self->total_unapplied_payments;
1474 =item total_credited
1476 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1477 customer. See L<FS::cust_credit/credited>.
1481 sub total_credited {
1483 my $total_credit = 0;
1484 foreach my $cust_credit ( qsearch('cust_credit', {
1485 'custnum' => $self->custnum,
1487 $total_credit += $cust_credit->credited;
1489 sprintf( "%.2f", $total_credit );
1492 =item total_unapplied_payments
1494 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1495 See L<FS::cust_pay/unapplied>.
1499 sub total_unapplied_payments {
1501 my $total_unapplied = 0;
1502 foreach my $cust_pay ( qsearch('cust_pay', {
1503 'custnum' => $self->custnum,
1505 $total_unapplied += $cust_pay->unapplied;
1507 sprintf( "%.2f", $total_unapplied );
1512 Returns the balance for this customer (total_owed minus total_credited
1513 minus total_unapplied_payments).
1520 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1524 =item balance_date TIME
1526 Returns the balance for this customer, only considering invoices with date
1527 earlier than TIME (total_owed_date minus total_credited minus
1528 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1529 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1538 $self->total_owed_date($time)
1539 - $self->total_credited
1540 - $self->total_unapplied_payments
1544 =item invoicing_list [ ARRAYREF ]
1546 If an arguement is given, sets these email addresses as invoice recipients
1547 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1548 (except as warnings), so use check_invoicing_list first.
1550 Returns a list of email addresses (with svcnum entries expanded).
1552 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1553 check it without disturbing anything by passing nothing.
1555 This interface may change in the future.
1559 sub invoicing_list {
1560 my( $self, $arrayref ) = @_;
1562 my @cust_main_invoice;
1563 if ( $self->custnum ) {
1564 @cust_main_invoice =
1565 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1567 @cust_main_invoice = ();
1569 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1570 #warn $cust_main_invoice->destnum;
1571 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1572 #warn $cust_main_invoice->destnum;
1573 my $error = $cust_main_invoice->delete;
1574 warn $error if $error;
1577 if ( $self->custnum ) {
1578 @cust_main_invoice =
1579 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1581 @cust_main_invoice = ();
1583 my %seen = map { $_->address => 1 } @cust_main_invoice;
1584 foreach my $address ( @{$arrayref} ) {
1585 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1586 next if exists $seen{$address} && $seen{$address};
1587 $seen{$address} = 1;
1588 my $cust_main_invoice = new FS::cust_main_invoice ( {
1589 'custnum' => $self->custnum,
1592 my $error = $cust_main_invoice->insert;
1593 warn $error if $error;
1596 if ( $self->custnum ) {
1598 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1604 =item check_invoicing_list ARRAYREF
1606 Checks these arguements as valid input for the invoicing_list method. If there
1607 is an error, returns the error, otherwise returns false.
1611 sub check_invoicing_list {
1612 my( $self, $arrayref ) = @_;
1613 foreach my $address ( @{$arrayref} ) {
1614 my $cust_main_invoice = new FS::cust_main_invoice ( {
1615 'custnum' => $self->custnum,
1618 my $error = $self->custnum
1619 ? $cust_main_invoice->check
1620 : $cust_main_invoice->checkdest
1622 return $error if $error;
1627 =item default_invoicing_list
1629 Sets the invoicing list to all accounts associated with this customer.
1633 sub default_invoicing_list {
1636 foreach my $cust_pkg ( $self->all_pkgs ) {
1637 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1639 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1640 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1642 push @list, map { $_->email } @svc_acct;
1644 $self->invoicing_list(\@list);
1647 =item invoicing_list_addpost
1649 Adds postal invoicing to this customer. If this customer is already configured
1650 to receive postal invoices, does nothing.
1654 sub invoicing_list_addpost {
1656 return if grep { $_ eq 'POST' } $self->invoicing_list;
1657 my @invoicing_list = $self->invoicing_list;
1658 push @invoicing_list, 'POST';
1659 $self->invoicing_list(\@invoicing_list);
1662 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1664 Returns an array of customers referred by this customer (referral_custnum set
1665 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1666 customers referred by customers referred by this customer and so on, inclusive.
1667 The default behavior is DEPTH 1 (no recursion).
1671 sub referral_cust_main {
1673 my $depth = @_ ? shift : 1;
1674 my $exclude = @_ ? shift : {};
1677 map { $exclude->{$_->custnum}++; $_; }
1678 grep { ! $exclude->{ $_->custnum } }
1679 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1683 map { $_->referral_cust_main($depth-1, $exclude) }
1690 =item referral_cust_main_ncancelled
1692 Same as referral_cust_main, except only returns customers with uncancelled
1697 sub referral_cust_main_ncancelled {
1699 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1702 =item referral_cust_pkg [ DEPTH ]
1704 Like referral_cust_main, except returns a flat list of all unsuspended (and
1705 uncancelled) packages for each customer. The number of items in this list may
1706 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1710 sub referral_cust_pkg {
1712 my $depth = @_ ? shift : 1;
1714 map { $_->unsuspended_pkgs }
1715 grep { $_->unsuspended_pkgs }
1716 $self->referral_cust_main($depth);
1719 =item credit AMOUNT, REASON
1721 Applies a credit to this customer. If there is an error, returns the error,
1722 otherwise returns false.
1727 my( $self, $amount, $reason ) = @_;
1728 my $cust_credit = new FS::cust_credit {
1729 'custnum' => $self->custnum,
1730 'amount' => $amount,
1731 'reason' => $reason,
1733 $cust_credit->insert;
1736 =item charge AMOUNT PKG COMMENT
1738 Creates a one-time charge for this customer. If there is an error, returns
1739 the error, otherwise returns false.
1744 my ( $self, $amount, $pkg, $comment ) = @_;
1746 my $part_pkg = new FS::part_pkg ( {
1747 'pkg' => $pkg || 'One-time charge',
1748 'comment' => $comment || '$'. sprintf("%.2f".$amount),
1761 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1767 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1770 =item open_cust_bill
1772 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1777 sub open_cust_bill {
1779 grep { $_->owed > 0 } $self->cust_bill;
1788 =item check_and_rebuild_fuzzyfiles
1792 sub check_and_rebuild_fuzzyfiles {
1793 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1794 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1795 or &rebuild_fuzzyfiles;
1798 =item rebuild_fuzzyfiles
1802 sub rebuild_fuzzyfiles {
1804 use Fcntl qw(:flock);
1806 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1810 open(LASTLOCK,">>$dir/cust_main.last")
1811 or die "can't open $dir/cust_main.last: $!";
1812 flock(LASTLOCK,LOCK_EX)
1813 or die "can't lock $dir/cust_main.last: $!";
1815 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1817 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1818 if defined dbdef->table('cust_main')->column('ship_last');
1820 open (LASTCACHE,">$dir/cust_main.last.tmp")
1821 or die "can't open $dir/cust_main.last.tmp: $!";
1822 print LASTCACHE join("\n", @all_last), "\n";
1823 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1825 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1830 open(COMPANYLOCK,">>$dir/cust_main.company")
1831 or die "can't open $dir/cust_main.company: $!";
1832 flock(COMPANYLOCK,LOCK_EX)
1833 or die "can't lock $dir/cust_main.company: $!";
1835 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1837 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1838 if defined dbdef->table('cust_main')->column('ship_last');
1840 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1841 or die "can't open $dir/cust_main.company.tmp: $!";
1842 print COMPANYCACHE join("\n", @all_company), "\n";
1843 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1845 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1855 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1856 open(LASTCACHE,"<$dir/cust_main.last")
1857 or die "can't open $dir/cust_main.last: $!";
1858 my @array = map { chomp; $_; } <LASTCACHE>;
1868 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1869 open(COMPANYCACHE,"<$dir/cust_main.company")
1870 or die "can't open $dir/cust_main.last: $!";
1871 my @array = map { chomp; $_; } <COMPANYCACHE>;
1876 =item append_fuzzyfiles LASTNAME COMPANY
1880 sub append_fuzzyfiles {
1881 my( $last, $company ) = @_;
1883 &check_and_rebuild_fuzzyfiles;
1885 use Fcntl qw(:flock);
1887 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1891 open(LAST,">>$dir/cust_main.last")
1892 or die "can't open $dir/cust_main.last: $!";
1894 or die "can't lock $dir/cust_main.last: $!";
1896 print LAST "$last\n";
1899 or die "can't unlock $dir/cust_main.last: $!";
1905 open(COMPANY,">>$dir/cust_main.company")
1906 or die "can't open $dir/cust_main.company: $!";
1907 flock(COMPANY,LOCK_EX)
1908 or die "can't lock $dir/cust_main.company: $!";
1910 print COMPANY "$company\n";
1912 flock(COMPANY,LOCK_UN)
1913 or die "can't unlock $dir/cust_main.company: $!";
1927 The delete method should possibly take an FS::cust_main object reference
1928 instead of a scalar customer number.
1930 Bill and collect options should probably be passed as references instead of a
1933 There should probably be a configuration file with a list of allowed credit
1936 No multiple currency support (probably a larger project than just this module).
1940 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1941 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1942 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.