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;
31 use FS::Msgcat qw(gettext);
33 @ISA = qw( FS::Record );
40 #ask FS::UID to run this stuff for us later
41 $FS::UID::callback{'FS::cust_main'} = sub {
43 #yes, need it for stuff below (prolly should be cached)
48 my ( $hashref, $cache ) = @_;
49 if ( exists $hashref->{'pkgnum'} ) {
50 # #@{ $self->{'_pkgnum'} } = ();
51 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
52 $self->{'_pkgnum'} = $subcache;
53 #push @{ $self->{'_pkgnum'} },
54 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
60 FS::cust_main - Object methods for cust_main records
66 $record = new FS::cust_main \%hash;
67 $record = new FS::cust_main { 'column' => 'value' };
69 $error = $record->insert;
71 $error = $new_record->replace($old_record);
73 $error = $record->delete;
75 $error = $record->check;
77 @cust_pkg = $record->all_pkgs;
79 @cust_pkg = $record->ncancelled_pkgs;
81 @cust_pkg = $record->suspended_pkgs;
83 $error = $record->bill;
84 $error = $record->bill %options;
85 $error = $record->bill 'time' => $time;
87 $error = $record->collect;
88 $error = $record->collect %options;
89 $error = $record->collect 'invoice_time' => $time,
90 'batch_card' => 'yes',
91 'report_badcard' => 'yes',
96 An FS::cust_main object represents a customer. FS::cust_main inherits from
97 FS::Record. The following fields are currently supported:
101 =item custnum - primary key (assigned automatically for new customers)
103 =item agentnum - agent (see L<FS::agent>)
105 =item refnum - Advertising source (see L<FS::part_referral>)
111 =item ss - social security number (optional)
113 =item company - (optional)
117 =item address2 - (optional)
121 =item county - (optional, see L<FS::cust_main_county>)
123 =item state - (see L<FS::cust_main_county>)
127 =item country - (see L<FS::cust_main_county>)
129 =item daytime - phone (optional)
131 =item night - phone (optional)
133 =item fax - phone (optional)
135 =item ship_first - name
137 =item ship_last - name
139 =item ship_company - (optional)
143 =item ship_address2 - (optional)
147 =item ship_county - (optional, see L<FS::cust_main_county>)
149 =item ship_state - (see L<FS::cust_main_county>)
153 =item ship_country - (see L<FS::cust_main_county>)
155 =item ship_daytime - phone (optional)
157 =item ship_night - phone (optional)
159 =item ship_fax - phone (optional)
161 =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)
163 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
165 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
167 =item payname - name on card or billing name
169 =item tax - tax exempt, empty or `Y'
171 =item otaker - order taker (assigned automatically, see L<FS::UID>)
173 =item comments - comments (optional)
183 Creates a new customer. To add the customer to the database, see L<"insert">.
185 Note that this stores the hash reference, not a distinct copy of the hash it
186 points to. You can ask the object for a copy with the I<hash> method.
190 sub table { 'cust_main'; }
192 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
194 Adds this customer to the database. If there is an error, returns the error,
195 otherwise returns false.
197 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
198 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
199 are inserted atomicly, or the transaction is rolled back. Passing an empty
200 hash reference is equivalent to not supplying this parameter. There should be
201 a better explanation of this, but until then, here's an example:
204 tie %hash, 'Tie::RefHash'; #this part is important
206 $cust_pkg => [ $svc_acct ],
209 $cust_main->insert( \%hash );
211 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
212 be set as the invoicing list (see L<"invoicing_list">). Errors return as
213 expected and rollback the entire transaction; it is not necessary to call
214 check_invoicing_list first. The invoicing_list is set after the records in the
215 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
216 invoicing_list destination to the newly-created svc_acct. Here's an example:
218 $cust_main->insert( {}, [ $email, 'POST' ] );
224 my $cust_pkgs = @_ ? shift : {};
225 my $invoicing_list = @_ ? shift : '';
227 local $SIG{HUP} = 'IGNORE';
228 local $SIG{INT} = 'IGNORE';
229 local $SIG{QUIT} = 'IGNORE';
230 local $SIG{TERM} = 'IGNORE';
231 local $SIG{TSTP} = 'IGNORE';
232 local $SIG{PIPE} = 'IGNORE';
234 my $oldAutoCommit = $FS::UID::AutoCommit;
235 local $FS::UID::AutoCommit = 0;
240 if ( $self->payby eq 'PREPAY' ) {
241 $self->payby('BILL');
242 my $prepay_credit = qsearchs(
244 { 'identifier' => $self->payinfo },
248 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
249 unless $prepay_credit;
250 $amount = $prepay_credit->amount;
251 $seconds = $prepay_credit->seconds;
252 my $error = $prepay_credit->delete;
254 $dbh->rollback if $oldAutoCommit;
255 return "removing prepay_credit (transaction rolled back): $error";
259 my $error = $self->SUPER::insert;
261 $dbh->rollback if $oldAutoCommit;
262 #return "inserting cust_main record (transaction rolled back): $error";
267 if ( $invoicing_list ) {
268 $error = $self->check_invoicing_list( $invoicing_list );
270 $dbh->rollback if $oldAutoCommit;
271 return "checking invoicing_list (transaction rolled back): $error";
273 $self->invoicing_list( $invoicing_list );
277 foreach my $cust_pkg ( keys %$cust_pkgs ) {
278 $cust_pkg->custnum( $self->custnum );
279 $error = $cust_pkg->insert;
281 $dbh->rollback if $oldAutoCommit;
282 return "inserting cust_pkg (transaction rolled back): $error";
284 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
285 $svc_something->pkgnum( $cust_pkg->pkgnum );
286 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
287 $svc_something->seconds( $svc_something->seconds + $seconds );
290 $error = $svc_something->insert;
292 $dbh->rollback if $oldAutoCommit;
293 #return "inserting svc_ (transaction rolled back): $error";
300 $dbh->rollback if $oldAutoCommit;
301 return "No svc_acct record to apply pre-paid time";
305 my $cust_credit = new FS::cust_credit {
306 'custnum' => $self->custnum,
309 $error = $cust_credit->insert;
311 $dbh->rollback if $oldAutoCommit;
312 return "inserting credit (transaction rolled back): $error";
316 #false laziness with sub replace
317 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
318 $error = $queue->insert($self->getfield('last'), $self->company);
320 $dbh->rollback if $oldAutoCommit;
321 return "queueing job (transaction rolled back): $error";
324 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
325 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
326 $error = $queue->insert($self->getfield('last'), $self->company);
328 $dbh->rollback if $oldAutoCommit;
329 return "queueing job (transaction rolled back): $error";
334 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
339 =item delete NEW_CUSTNUM
341 This deletes the customer. If there is an error, returns the error, otherwise
344 This will completely remove all traces of the customer record. This is not
345 what you want when a customer cancels service; for that, cancel all of the
346 customer's packages (see L<FS::cust_pkg/cancel>).
348 If the customer has any uncancelled packages, you need to pass a new (valid)
349 customer number for those packages to be transferred to. Cancelled packages
350 will be deleted. Did I mention that this is NOT what you want when a customer
351 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
353 You can't delete a customer with invoices (see L<FS::cust_bill>),
354 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
355 refunds (see L<FS::cust_refund>).
362 local $SIG{HUP} = 'IGNORE';
363 local $SIG{INT} = 'IGNORE';
364 local $SIG{QUIT} = 'IGNORE';
365 local $SIG{TERM} = 'IGNORE';
366 local $SIG{TSTP} = 'IGNORE';
367 local $SIG{PIPE} = 'IGNORE';
369 my $oldAutoCommit = $FS::UID::AutoCommit;
370 local $FS::UID::AutoCommit = 0;
373 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
374 $dbh->rollback if $oldAutoCommit;
375 return "Can't delete a customer with invoices";
377 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
378 $dbh->rollback if $oldAutoCommit;
379 return "Can't delete a customer with credits";
381 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Can't delete a customer with payments";
385 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
386 $dbh->rollback if $oldAutoCommit;
387 return "Can't delete a customer with refunds";
390 my @cust_pkg = $self->ncancelled_pkgs;
392 my $new_custnum = shift;
393 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
394 $dbh->rollback if $oldAutoCommit;
395 return "Invalid new customer number: $new_custnum";
397 foreach my $cust_pkg ( @cust_pkg ) {
398 my %hash = $cust_pkg->hash;
399 $hash{'custnum'} = $new_custnum;
400 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
401 my $error = $new_cust_pkg->replace($cust_pkg);
403 $dbh->rollback if $oldAutoCommit;
408 my @cancelled_cust_pkg = $self->all_pkgs;
409 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
410 my $error = $cust_pkg->delete;
412 $dbh->rollback if $oldAutoCommit;
417 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
418 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
420 my $error = $cust_main_invoice->delete;
422 $dbh->rollback if $oldAutoCommit;
427 my $error = $self->SUPER::delete;
429 $dbh->rollback if $oldAutoCommit;
433 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
438 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
440 Replaces the OLD_RECORD with this one in the database. If there is an error,
441 returns the error, otherwise returns false.
443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
444 be set as the invoicing list (see L<"invoicing_list">). Errors return as
445 expected and rollback the entire transaction; it is not necessary to call
446 check_invoicing_list first. Here's an example:
448 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
457 local $SIG{HUP} = 'IGNORE';
458 local $SIG{INT} = 'IGNORE';
459 local $SIG{QUIT} = 'IGNORE';
460 local $SIG{TERM} = 'IGNORE';
461 local $SIG{TSTP} = 'IGNORE';
462 local $SIG{PIPE} = 'IGNORE';
464 my $oldAutoCommit = $FS::UID::AutoCommit;
465 local $FS::UID::AutoCommit = 0;
468 my $error = $self->SUPER::replace($old);
471 $dbh->rollback if $oldAutoCommit;
475 if ( @param ) { # INVOICING_LIST_ARYREF
476 my $invoicing_list = shift @param;
477 $error = $self->check_invoicing_list( $invoicing_list );
479 $dbh->rollback if $oldAutoCommit;
482 $self->invoicing_list( $invoicing_list );
485 if ( $self->payby eq 'CARD' &&
486 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
487 # card info has changed, want to retry realtime_card invoice events
488 #false laziness w/collect
489 foreach my $cust_bill_event (
491 #$_->part_bill_event->plan eq 'realtime-card'
492 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
493 && $_->status eq 'done'
496 map { $_->cust_bill_event }
497 grep { $_->cust_bill_event }
498 $self->open_cust_bill
501 my $error = $cust_bill_event->retry;
503 $dbh->rollback if $oldAutoCommit;
504 return "error scheduling invoice events for retry: $error";
511 #false laziness with sub insert
512 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
513 $error = $queue->insert($self->getfield('last'), $self->company);
515 $dbh->rollback if $oldAutoCommit;
516 return "queueing job (transaction rolled back): $error";
519 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
520 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
521 $error = $queue->insert($self->getfield('last'), $self->company);
523 $dbh->rollback if $oldAutoCommit;
524 return "queueing job (transaction rolled back): $error";
529 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
536 Checks all fields to make sure this is a valid customer record. If there is
537 an error, returns the error, otherwise returns false. Called by the insert
545 #warn "BEFORE: \n". $self->_dump;
548 $self->ut_numbern('custnum')
549 || $self->ut_number('agentnum')
550 || $self->ut_number('refnum')
551 || $self->ut_name('last')
552 || $self->ut_name('first')
553 || $self->ut_textn('company')
554 || $self->ut_text('address1')
555 || $self->ut_textn('address2')
556 || $self->ut_text('city')
557 || $self->ut_textn('county')
558 || $self->ut_textn('state')
559 || $self->ut_country('country')
560 || $self->ut_anything('comments')
561 || $self->ut_numbern('referral_custnum')
563 #barf. need message catalogs. i18n. etc.
564 $error .= "Please select a advertising source."
565 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
566 return $error if $error;
568 return "Unknown agent"
569 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
571 return "Unknown refnum"
572 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
574 return "Unknown referring custnum ". $self->referral_custnum
575 unless ! $self->referral_custnum
576 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
578 if ( $self->ss eq '' ) {
583 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
584 or return "Illegal social security number: ". $self->ss;
585 $self->ss("$1-$2-$3");
589 # bad idea to disable, causes billing to fail because of no tax rates later
590 # unless ( $import ) {
591 unless ( qsearchs('cust_main_county', {
592 'country' => $self->country,
595 return "Unknown state/county/country: ".
596 $self->state. "/". $self->county. "/". $self->country
597 unless qsearchs('cust_main_county',{
598 'state' => $self->state,
599 'county' => $self->county,
600 'country' => $self->country,
606 $self->ut_phonen('daytime', $self->country)
607 || $self->ut_phonen('night', $self->country)
608 || $self->ut_phonen('fax', $self->country)
609 || $self->ut_zip('zip', $self->country)
611 return $error if $error;
614 last first company address1 address2 city county state zip
615 country daytime night fax
618 if ( defined $self->dbdef_table->column('ship_last') ) {
619 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
621 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
625 $self->ut_name('ship_last')
626 || $self->ut_name('ship_first')
627 || $self->ut_textn('ship_company')
628 || $self->ut_text('ship_address1')
629 || $self->ut_textn('ship_address2')
630 || $self->ut_text('ship_city')
631 || $self->ut_textn('ship_county')
632 || $self->ut_textn('ship_state')
633 || $self->ut_country('ship_country')
635 return $error if $error;
637 #false laziness with above
638 unless ( qsearchs('cust_main_county', {
639 'country' => $self->ship_country,
642 return "Unknown ship_state/ship_county/ship_country: ".
643 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
644 unless qsearchs('cust_main_county',{
645 'state' => $self->ship_state,
646 'county' => $self->ship_county,
647 'country' => $self->ship_country,
653 $self->ut_phonen('ship_daytime', $self->ship_country)
654 || $self->ut_phonen('ship_night', $self->ship_country)
655 || $self->ut_phonen('ship_fax', $self->ship_country)
656 || $self->ut_zip('ship_zip', $self->ship_country)
658 return $error if $error;
660 } else { # ship_ info eq billing info, so don't store dup info in database
661 $self->setfield("ship_$_", '')
662 foreach qw( last first company address1 address2 city county state zip
663 country daytime night fax );
667 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
668 or return "Illegal payby: ". $self->payby;
671 if ( $self->payby eq 'CARD' ) {
673 my $payinfo = $self->payinfo;
675 $payinfo =~ /^(\d{13,16})$/
676 or return gettext('invalid_card'); # . ": ". $self->payinfo;
678 $self->payinfo($payinfo);
680 or return gettext('invalid_card'); # . ": ". $self->payinfo;
681 return gettext('unknown_card_type')
682 if cardtype($self->payinfo) eq "Unknown";
684 } elsif ( $self->payby eq 'BILL' ) {
686 $error = $self->ut_textn('payinfo');
687 return "Illegal P.O. number: ". $self->payinfo if $error;
689 } elsif ( $self->payby eq 'COMP' ) {
691 $error = $self->ut_textn('payinfo');
692 return "Illegal comp account issuer: ". $self->payinfo if $error;
694 } elsif ( $self->payby eq 'PREPAY' ) {
696 my $payinfo = $self->payinfo;
697 $payinfo =~ s/\W//g; #anything else would just confuse things
698 $self->payinfo($payinfo);
699 $error = $self->ut_alpha('payinfo');
700 return "Illegal prepayment identifier: ". $self->payinfo if $error;
701 return "Unknown prepayment identifier"
702 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
706 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
707 return "Expriation date required"
708 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
711 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
712 or return "Illegal expiration date: ". $self->paydate;
713 my $y = length($2) == 4 ? $2 : "20$2";
714 $self->paydate("$y-$1-01");
715 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
716 return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm );
719 if ( $self->payname eq '' &&
720 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
721 $self->payname( $self->first. " ". $self->getfield('last') );
723 $self->payname =~ /^([\w \,\.\-\']+)$/
724 or return gettext('illegal_name'). " payname: ". $self->payname;
728 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
731 $self->otaker(getotaker);
733 #warn "AFTER: \n". $self->_dump;
740 Returns all packages (see L<FS::cust_pkg>) for this customer.
746 if ( $self->{'_pkgnum'} ) {
747 values %{ $self->{'_pkgnum'}->cache };
749 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
753 =item ncancelled_pkgs
755 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
759 sub ncancelled_pkgs {
761 if ( $self->{'_pkgnum'} ) {
762 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
764 @{ [ # force list context
765 qsearch( 'cust_pkg', {
766 'custnum' => $self->custnum,
769 qsearch( 'cust_pkg', {
770 'custnum' => $self->custnum,
779 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
785 grep { $_->susp } $self->ncancelled_pkgs;
788 =item unflagged_suspended_pkgs
790 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
791 customer (thouse packages without the `manual_flag' set).
795 sub unflagged_suspended_pkgs {
797 return $self->suspended_pkgs
798 unless dbdef->table('cust_pkg')->column('manual_flag');
799 grep { ! $_->manual_flag } $self->suspended_pkgs;
802 =item unsuspended_pkgs
804 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
809 sub unsuspended_pkgs {
811 grep { ! $_->susp } $self->ncancelled_pkgs;
816 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
817 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
818 on success or a list of errors.
824 grep { $_->unsuspend } $self->suspended_pkgs;
829 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
830 Always returns a list: an empty list on success or a list of errors.
836 grep { $_->suspend } $self->unsuspended_pkgs;
841 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
842 Always returns a list: an empty list on success or a list of errors.
848 grep { $_->cancel } $self->ncancelled_pkgs;
853 Returns the agent (see L<FS::agent>) for this customer.
859 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
864 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
865 conjunction with the collect method.
867 Options are passed as name-value pairs.
869 The only currently available option is `time', which bills the customer as if
870 it were that time. It is specified as a UNIX timestamp; see
871 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
872 functions. For example:
876 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
878 If there is an error, returns the error, otherwise returns false.
883 my( $self, %options ) = @_;
884 my $time = $options{'time'} || time;
889 local $SIG{HUP} = 'IGNORE';
890 local $SIG{INT} = 'IGNORE';
891 local $SIG{QUIT} = 'IGNORE';
892 local $SIG{TERM} = 'IGNORE';
893 local $SIG{TSTP} = 'IGNORE';
894 local $SIG{PIPE} = 'IGNORE';
896 my $oldAutoCommit = $FS::UID::AutoCommit;
897 local $FS::UID::AutoCommit = 0;
900 # find the packages which are due for billing, find out how much they are
901 # & generate invoice database.
903 my( $total_setup, $total_recur ) = ( 0, 0 );
904 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
905 my @cust_bill_pkg = ();
907 #my $taxable_charged = 0;##
910 foreach my $cust_pkg (
911 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
914 #NO!! next if $cust_pkg->cancel;
915 next if $cust_pkg->getfield('cancel');
917 #? to avoid use of uninitialized value errors... ?
918 $cust_pkg->setfield('bill', '')
919 unless defined($cust_pkg->bill);
921 my $part_pkg = $cust_pkg->part_pkg;
923 #so we don't modify cust_pkg record unnecessarily
924 my $cust_pkg_mod_flag = 0;
925 my %hash = $cust_pkg->hash;
926 my $old_cust_pkg = new FS::cust_pkg \%hash;
930 unless ( $cust_pkg->setup ) {
931 my $setup_prog = $part_pkg->getfield('setup');
932 $setup_prog =~ /^(.*)$/ or do {
933 $dbh->rollback if $oldAutoCommit;
934 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
940 ##$cpt->permit(); #what is necessary?
941 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
942 #$setup = $cpt->reval($setup_prog);
943 $setup = eval $setup_prog;
944 unless ( defined($setup) ) {
945 $dbh->rollback if $oldAutoCommit;
946 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
947 "(expression $setup_prog): $@";
949 $cust_pkg->setfield('setup',$time);
950 $cust_pkg_mod_flag=1;
956 if ( $part_pkg->getfield('freq') > 0 &&
957 ! $cust_pkg->getfield('susp') &&
958 ( $cust_pkg->getfield('bill') || 0 ) < $time
960 my $recur_prog = $part_pkg->getfield('recur');
961 $recur_prog =~ /^(.*)$/ or do {
962 $dbh->rollback if $oldAutoCommit;
963 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
968 # shared with $recur_prog
969 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
972 ##$cpt->permit(); #what is necessary?
973 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
974 #$recur = $cpt->reval($recur_prog);
975 $recur = eval $recur_prog;
976 unless ( defined($recur) ) {
977 $dbh->rollback if $oldAutoCommit;
978 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
979 "(expression $recur_prog): $@";
981 #change this bit to use Date::Manip? CAREFUL with timezones (see
982 # mailing list archive)
983 my ($sec,$min,$hour,$mday,$mon,$year) =
984 (localtime($sdate) )[0,1,2,3,4,5];
986 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
987 # only for figuring next bill date, nothing else, so, reset $sdate again
989 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
991 $mon += $part_pkg->freq;
992 until ( $mon < 12 ) { $mon -= 12; $year++; }
993 $cust_pkg->setfield('bill',
994 timelocal($sec,$min,$hour,$mday,$mon,$year));
995 $cust_pkg_mod_flag = 1;
998 warn "\$setup is undefined" unless defined($setup);
999 warn "\$recur is undefined" unless defined($recur);
1000 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1002 my $taxable_charged = 0;
1003 if ( $cust_pkg_mod_flag ) {
1004 $error=$cust_pkg->replace($old_cust_pkg);
1005 if ( $error ) { #just in case
1006 $dbh->rollback if $oldAutoCommit;
1007 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1009 $setup = sprintf( "%.2f", $setup );
1010 $recur = sprintf( "%.2f", $recur );
1012 $dbh->rollback if $oldAutoCommit;
1013 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1016 $dbh->rollback if $oldAutoCommit;
1017 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1019 if ( $setup > 0 || $recur > 0 ) {
1020 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1021 'pkgnum' => $cust_pkg->pkgnum,
1025 'edate' => $cust_pkg->bill,
1027 push @cust_bill_pkg, $cust_bill_pkg;
1028 $total_setup += $setup;
1029 $total_recur += $recur;
1030 $taxable_charged += $setup
1031 unless $part_pkg->setuptax =~ /^Y$/i;
1032 $taxable_charged += $recur
1033 unless $part_pkg->recurtax =~ /^Y$/i;
1035 unless ( $self->tax =~ /Y/i
1036 || $self->payby eq 'COMP'
1037 || $taxable_charged == 0 ) {
1039 my $cust_main_county =
1040 qsearchs('cust_main_county',{
1041 'state' => $self->state,
1042 'county' => $self->county,
1043 'country' => $self->country,
1044 'taxclass' => $part_pkg->taxclass,
1046 or qsearchs('cust_main_county',{
1047 'state' => $self->state,
1048 'county' => $self->county,
1049 'country' => $self->country,
1053 $dbh->rollback if $oldAutoCommit;
1055 "fatal: can't find tax rate for state/county/country/taxclass ".
1056 join('/', map $self->$_(), qw(state county country taxclass) ).
1060 if ( $cust_main_county->exempt_amount ) {
1061 my ($mon,$year) = (localtime($sdate) )[4,5];
1063 my $freq = $part_pkg->freq || 1;
1064 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1065 foreach my $which_month ( 1 .. $freq ) {
1067 'custnum' => $self->custnum,
1068 'taxnum' => $cust_main_county->taxnum,
1069 'year' => 1900+$year,
1072 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1073 until ( $mon < 13 ) { $mon -= 12; $year++; }
1074 my $cust_tax_exempt =
1075 qsearchs('cust_tax_exempt', \%hash)
1076 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1077 my $remaining_exemption = sprintf("%.2f",
1078 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1079 if ( $remaining_exemption > 0 ) {
1080 my $addl = $remaining_exemption > $taxable_per_month
1081 ? $taxable_per_month
1082 : $remaining_exemption;
1083 $taxable_charged -= $addl;
1084 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1085 $cust_tax_exempt->hash,
1086 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1088 $error = $new_cust_tax_exempt->exemptnum
1089 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1090 : $new_cust_tax_exempt->insert;
1092 $dbh->rollback if $oldAutoCommit;
1093 return "fatal: can't update cust_tax_exempt: $error";
1096 } # if $remaining_exemption > 0
1098 } #foreach $which_month
1100 } #if $cust_main_county->exempt_amount
1102 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1103 $tax += $taxable_charged * $cust_main_county->tax / 100
1105 } #unless $self->tax =~ /Y/i
1106 # || $self->payby eq 'COMP'
1107 # || $taxable_charged == 0
1109 } #if $setup > 0 || $recur > 0
1111 } #if $cust_pkg_mod_flag
1113 } #foreach my $cust_pkg
1115 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1116 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1118 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1119 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1123 # unless ( $self->tax =~ /Y/i
1124 # || $self->payby eq 'COMP'
1125 # || $taxable_charged == 0 ) {
1126 # my $cust_main_county = qsearchs('cust_main_county',{
1127 # 'state' => $self->state,
1128 # 'county' => $self->county,
1129 # 'country' => $self->country,
1130 # } ) or die "fatal: can't find tax rate for state/county/country ".
1131 # $self->state. "/". $self->county. "/". $self->country. "\n";
1132 # my $tax = sprintf( "%.2f",
1133 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1136 $tax = sprintf("%.2f", $tax);
1138 $charged = sprintf( "%.2f", $charged+$tax );
1140 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1147 push @cust_bill_pkg, $cust_bill_pkg;
1151 my $cust_bill = new FS::cust_bill ( {
1152 'custnum' => $self->custnum,
1154 'charged' => $charged,
1156 $error = $cust_bill->insert;
1158 $dbh->rollback if $oldAutoCommit;
1159 return "can't create invoice for customer #". $self->custnum. ": $error";
1162 my $invnum = $cust_bill->invnum;
1164 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1166 $cust_bill_pkg->invnum($invnum);
1167 $error = $cust_bill_pkg->insert;
1169 $dbh->rollback if $oldAutoCommit;
1170 return "can't create invoice line item for customer #". $self->custnum.
1175 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1179 =item collect OPTIONS
1181 (Attempt to) collect money for this customer's outstanding invoices (see
1182 L<FS::cust_bill>). Usually used after the bill method.
1184 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1185 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1187 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1188 and the invoice events web interface.
1190 If there is an error, returns the error, otherwise returns false.
1192 Options are passed as name-value pairs.
1194 Currently available options are:
1196 invoice_time - Use this time when deciding when to print invoices and
1197 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>
1198 for conversion functions.
1200 retry_card - Retry cards even when not scheduled by invoice events.
1202 batch_card - This option is deprecated. See the invoice events web interface
1203 to control whether cards are batched or run against a realtime gateway.
1205 report_badcard - This option is deprecated.
1207 force_print - This option is deprecated; see the invoice events web interface.
1212 my( $self, %options ) = @_;
1213 my $invoice_time = $options{'invoice_time'} || time;
1216 local $SIG{HUP} = 'IGNORE';
1217 local $SIG{INT} = 'IGNORE';
1218 local $SIG{QUIT} = 'IGNORE';
1219 local $SIG{TERM} = 'IGNORE';
1220 local $SIG{TSTP} = 'IGNORE';
1221 local $SIG{PIPE} = 'IGNORE';
1223 my $oldAutoCommit = $FS::UID::AutoCommit;
1224 local $FS::UID::AutoCommit = 0;
1227 my $balance = $self->balance;
1228 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1229 unless ( $balance > 0 ) { #redundant?????
1230 $dbh->rollback if $oldAutoCommit; #hmm
1234 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1235 #false laziness w/replace
1236 foreach my $cust_bill_event (
1238 #$_->part_bill_event->plan eq 'realtime-card'
1239 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1240 && $_->status eq 'done'
1243 map { $_->cust_bill_event }
1244 grep { $_->cust_bill_event }
1245 $self->open_cust_bill
1247 my $error = $cust_bill_event->retry;
1249 $dbh->rollback if $oldAutoCommit;
1250 return "error scheduling invoice events for retry: $error";
1256 foreach my $cust_bill ( $self->cust_bill ) {
1258 #this has to be before next's
1259 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1263 $balance = sprintf( "%.2f", $balance - $amount );
1265 next unless $cust_bill->owed > 0;
1267 # don't try to charge for the same invoice if it's already in a batch
1268 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1270 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1272 next unless $amount > 0;
1275 foreach my $part_bill_event (
1276 sort { $a->seconds <=> $b->seconds
1277 || $a->weight <=> $b->weight
1278 || $a->eventpart <=> $b->eventpart }
1279 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1280 && ! qsearchs( 'cust_bill_event', {
1281 'invnum' => $cust_bill->invnum,
1282 'eventpart' => $_->eventpart,
1286 qsearch('part_bill_event', { 'payby' => $self->payby,
1287 'disabled' => '', } )
1290 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1292 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1294 my $cust_main = $self; #for callback
1295 my $error = eval $part_bill_event->eventcode;
1298 my $statustext = '';
1302 } elsif ( $error ) {
1304 $statustext = $error;
1309 #add cust_bill_event
1310 my $cust_bill_event = new FS::cust_bill_event {
1311 'invnum' => $cust_bill->invnum,
1312 'eventpart' => $part_bill_event->eventpart,
1313 '_date' => $invoice_time,
1314 'status' => $status,
1315 'statustext' => $statustext,
1317 $error = $cust_bill_event->insert;
1319 #$dbh->rollback if $oldAutoCommit;
1320 #return "error: $error";
1322 # gah, even with transactions.
1323 $dbh->commit if $oldAutoCommit; #well.
1324 my $e = 'WARNING: Event run but database not updated - '.
1325 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1326 ', eventpart '. $part_bill_event->eventpart.
1337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1344 Returns the total owed for this customer on all invoices
1345 (see L<FS::cust_bill/owed>).
1351 $self->total_owed_date(2145859200); #12/31/2037
1354 =item total_owed_date TIME
1356 Returns the total owed for this customer on all invoices with date earlier than
1357 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1358 see L<Time::Local> and L<Date::Parse> for conversion functions.
1362 sub total_owed_date {
1366 foreach my $cust_bill (
1367 grep { $_->_date <= $time }
1368 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1370 $total_bill += $cust_bill->owed;
1372 sprintf( "%.2f", $total_bill );
1377 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1378 to outstanding invoice balances in chronological order and returns the value
1379 of any remaining unapplied credits available for refund
1380 (see L<FS::cust_refund>).
1387 return 0 unless $self->total_credited;
1389 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1390 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1392 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1393 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1397 foreach my $cust_bill ( @invoices ) {
1400 if ( !defined($credit) || $credit->credited == 0) {
1401 $credit = pop @credits or last;
1404 if ($cust_bill->owed >= $credit->credited) {
1405 $amount=$credit->credited;
1407 $amount=$cust_bill->owed;
1410 my $cust_credit_bill = new FS::cust_credit_bill ( {
1411 'crednum' => $credit->crednum,
1412 'invnum' => $cust_bill->invnum,
1413 'amount' => $amount,
1415 my $error = $cust_credit_bill->insert;
1416 die $error if $error;
1418 redo if ($cust_bill->owed > 0);
1422 return $self->total_credited;
1425 =item apply_payments
1427 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1428 to outstanding invoice balances in chronological order.
1430 #and returns the value of any remaining unapplied payments.
1434 sub apply_payments {
1439 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1440 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1442 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1443 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1447 foreach my $cust_bill ( @invoices ) {
1450 if ( !defined($payment) || $payment->unapplied == 0 ) {
1451 $payment = pop @payments or last;
1454 if ( $cust_bill->owed >= $payment->unapplied ) {
1455 $amount = $payment->unapplied;
1457 $amount = $cust_bill->owed;
1460 my $cust_bill_pay = new FS::cust_bill_pay ( {
1461 'paynum' => $payment->paynum,
1462 'invnum' => $cust_bill->invnum,
1463 'amount' => $amount,
1465 my $error = $cust_bill_pay->insert;
1466 die $error if $error;
1468 redo if ( $cust_bill->owed > 0);
1472 return $self->total_unapplied_payments;
1475 =item total_credited
1477 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1478 customer. See L<FS::cust_credit/credited>.
1482 sub total_credited {
1484 my $total_credit = 0;
1485 foreach my $cust_credit ( qsearch('cust_credit', {
1486 'custnum' => $self->custnum,
1488 $total_credit += $cust_credit->credited;
1490 sprintf( "%.2f", $total_credit );
1493 =item total_unapplied_payments
1495 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1496 See L<FS::cust_pay/unapplied>.
1500 sub total_unapplied_payments {
1502 my $total_unapplied = 0;
1503 foreach my $cust_pay ( qsearch('cust_pay', {
1504 'custnum' => $self->custnum,
1506 $total_unapplied += $cust_pay->unapplied;
1508 sprintf( "%.2f", $total_unapplied );
1513 Returns the balance for this customer (total_owed minus total_credited
1514 minus total_unapplied_payments).
1521 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1525 =item balance_date TIME
1527 Returns the balance for this customer, only considering invoices with date
1528 earlier than TIME (total_owed_date minus total_credited minus
1529 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1530 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1539 $self->total_owed_date($time)
1540 - $self->total_credited
1541 - $self->total_unapplied_payments
1545 =item invoicing_list [ ARRAYREF ]
1547 If an arguement is given, sets these email addresses as invoice recipients
1548 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1549 (except as warnings), so use check_invoicing_list first.
1551 Returns a list of email addresses (with svcnum entries expanded).
1553 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1554 check it without disturbing anything by passing nothing.
1556 This interface may change in the future.
1560 sub invoicing_list {
1561 my( $self, $arrayref ) = @_;
1563 my @cust_main_invoice;
1564 if ( $self->custnum ) {
1565 @cust_main_invoice =
1566 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1568 @cust_main_invoice = ();
1570 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1571 #warn $cust_main_invoice->destnum;
1572 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1573 #warn $cust_main_invoice->destnum;
1574 my $error = $cust_main_invoice->delete;
1575 warn $error if $error;
1578 if ( $self->custnum ) {
1579 @cust_main_invoice =
1580 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1582 @cust_main_invoice = ();
1584 my %seen = map { $_->address => 1 } @cust_main_invoice;
1585 foreach my $address ( @{$arrayref} ) {
1586 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1587 next if exists $seen{$address} && $seen{$address};
1588 $seen{$address} = 1;
1589 my $cust_main_invoice = new FS::cust_main_invoice ( {
1590 'custnum' => $self->custnum,
1593 my $error = $cust_main_invoice->insert;
1594 warn $error if $error;
1597 if ( $self->custnum ) {
1599 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1605 =item check_invoicing_list ARRAYREF
1607 Checks these arguements as valid input for the invoicing_list method. If there
1608 is an error, returns the error, otherwise returns false.
1612 sub check_invoicing_list {
1613 my( $self, $arrayref ) = @_;
1614 foreach my $address ( @{$arrayref} ) {
1615 my $cust_main_invoice = new FS::cust_main_invoice ( {
1616 'custnum' => $self->custnum,
1619 my $error = $self->custnum
1620 ? $cust_main_invoice->check
1621 : $cust_main_invoice->checkdest
1623 return $error if $error;
1628 =item default_invoicing_list
1630 Sets the invoicing list to all accounts associated with this customer.
1634 sub default_invoicing_list {
1637 foreach my $cust_pkg ( $self->all_pkgs ) {
1638 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1640 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1641 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1643 push @list, map { $_->email } @svc_acct;
1645 $self->invoicing_list(\@list);
1648 =item invoicing_list_addpost
1650 Adds postal invoicing to this customer. If this customer is already configured
1651 to receive postal invoices, does nothing.
1655 sub invoicing_list_addpost {
1657 return if grep { $_ eq 'POST' } $self->invoicing_list;
1658 my @invoicing_list = $self->invoicing_list;
1659 push @invoicing_list, 'POST';
1660 $self->invoicing_list(\@invoicing_list);
1663 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1665 Returns an array of customers referred by this customer (referral_custnum set
1666 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1667 customers referred by customers referred by this customer and so on, inclusive.
1668 The default behavior is DEPTH 1 (no recursion).
1672 sub referral_cust_main {
1674 my $depth = @_ ? shift : 1;
1675 my $exclude = @_ ? shift : {};
1678 map { $exclude->{$_->custnum}++; $_; }
1679 grep { ! $exclude->{ $_->custnum } }
1680 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1684 map { $_->referral_cust_main($depth-1, $exclude) }
1691 =item referral_cust_main_ncancelled
1693 Same as referral_cust_main, except only returns customers with uncancelled
1698 sub referral_cust_main_ncancelled {
1700 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1703 =item referral_cust_pkg [ DEPTH ]
1705 Like referral_cust_main, except returns a flat list of all unsuspended (and
1706 uncancelled) packages for each customer. The number of items in this list may
1707 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1711 sub referral_cust_pkg {
1713 my $depth = @_ ? shift : 1;
1715 map { $_->unsuspended_pkgs }
1716 grep { $_->unsuspended_pkgs }
1717 $self->referral_cust_main($depth);
1720 =item credit AMOUNT, REASON
1722 Applies a credit to this customer. If there is an error, returns the error,
1723 otherwise returns false.
1728 my( $self, $amount, $reason ) = @_;
1729 my $cust_credit = new FS::cust_credit {
1730 'custnum' => $self->custnum,
1731 'amount' => $amount,
1732 'reason' => $reason,
1734 $cust_credit->insert;
1737 =item charge AMOUNT PKG COMMENT
1739 Creates a one-time charge for this customer. If there is an error, returns
1740 the error, otherwise returns false.
1745 my ( $self, $amount, $pkg, $comment ) = @_;
1747 local $SIG{HUP} = 'IGNORE';
1748 local $SIG{INT} = 'IGNORE';
1749 local $SIG{QUIT} = 'IGNORE';
1750 local $SIG{TERM} = 'IGNORE';
1751 local $SIG{TSTP} = 'IGNORE';
1752 local $SIG{PIPE} = 'IGNORE';
1754 my $oldAutoCommit = $FS::UID::AutoCommit;
1755 local $FS::UID::AutoCommit = 0;
1758 my $part_pkg = new FS::part_pkg ( {
1759 'pkg' => $pkg || 'One-time charge',
1760 'comment' => $comment || '$'. sprintf("%.2f",$amount),
1767 my $error = $part_pkg->insert;
1769 $dbh->rollback if $oldAutoCommit;
1773 my $pkgpart = $part_pkg->pkgpart;
1774 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1775 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1776 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1777 $error = $type_pkgs->insert;
1779 $dbh->rollback if $oldAutoCommit;
1784 my $cust_pkg = new FS::cust_pkg ( {
1785 'custnum' => $self->custnum,
1786 'pkgpart' => $pkgpart,
1789 $error = $cust_pkg->insert;
1791 $dbh->rollback if $oldAutoCommit;
1795 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1802 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1808 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1811 =item open_cust_bill
1813 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1818 sub open_cust_bill {
1820 grep { $_->owed > 0 } $self->cust_bill;
1829 =item check_and_rebuild_fuzzyfiles
1833 sub check_and_rebuild_fuzzyfiles {
1834 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1835 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1836 or &rebuild_fuzzyfiles;
1839 =item rebuild_fuzzyfiles
1843 sub rebuild_fuzzyfiles {
1845 use Fcntl qw(:flock);
1847 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1851 open(LASTLOCK,">>$dir/cust_main.last")
1852 or die "can't open $dir/cust_main.last: $!";
1853 flock(LASTLOCK,LOCK_EX)
1854 or die "can't lock $dir/cust_main.last: $!";
1856 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1858 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1859 if defined dbdef->table('cust_main')->column('ship_last');
1861 open (LASTCACHE,">$dir/cust_main.last.tmp")
1862 or die "can't open $dir/cust_main.last.tmp: $!";
1863 print LASTCACHE join("\n", @all_last), "\n";
1864 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1866 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1871 open(COMPANYLOCK,">>$dir/cust_main.company")
1872 or die "can't open $dir/cust_main.company: $!";
1873 flock(COMPANYLOCK,LOCK_EX)
1874 or die "can't lock $dir/cust_main.company: $!";
1876 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1878 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1879 if defined dbdef->table('cust_main')->column('ship_last');
1881 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1882 or die "can't open $dir/cust_main.company.tmp: $!";
1883 print COMPANYCACHE join("\n", @all_company), "\n";
1884 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1886 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1896 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1897 open(LASTCACHE,"<$dir/cust_main.last")
1898 or die "can't open $dir/cust_main.last: $!";
1899 my @array = map { chomp; $_; } <LASTCACHE>;
1909 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1910 open(COMPANYCACHE,"<$dir/cust_main.company")
1911 or die "can't open $dir/cust_main.last: $!";
1912 my @array = map { chomp; $_; } <COMPANYCACHE>;
1917 =item append_fuzzyfiles LASTNAME COMPANY
1921 sub append_fuzzyfiles {
1922 my( $last, $company ) = @_;
1924 &check_and_rebuild_fuzzyfiles;
1926 use Fcntl qw(:flock);
1928 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1932 open(LAST,">>$dir/cust_main.last")
1933 or die "can't open $dir/cust_main.last: $!";
1935 or die "can't lock $dir/cust_main.last: $!";
1937 print LAST "$last\n";
1940 or die "can't unlock $dir/cust_main.last: $!";
1946 open(COMPANY,">>$dir/cust_main.company")
1947 or die "can't open $dir/cust_main.company: $!";
1948 flock(COMPANY,LOCK_EX)
1949 or die "can't lock $dir/cust_main.company: $!";
1951 print COMPANY "$company\n";
1953 flock(COMPANY,LOCK_UN)
1954 or die "can't unlock $dir/cust_main.company: $!";
1968 The delete method should possibly take an FS::cust_main object reference
1969 instead of a scalar customer number.
1971 Bill and collect options should probably be passed as references instead of a
1974 There should probably be a configuration file with a list of allowed credit
1977 No multiple currency support (probably a larger project than just this module).
1981 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1982 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1983 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.