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), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
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)
175 =item referral_custnum - referring customer number
185 Creates a new customer. To add the customer to the database, see L<"insert">.
187 Note that this stores the hash reference, not a distinct copy of the hash it
188 points to. You can ask the object for a copy with the I<hash> method.
192 sub table { 'cust_main'; }
194 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
196 Adds this customer to the database. If there is an error, returns the error,
197 otherwise returns false.
199 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
200 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
201 are inserted atomicly, or the transaction is rolled back. Passing an empty
202 hash reference is equivalent to not supplying this parameter. There should be
203 a better explanation of this, but until then, here's an example:
206 tie %hash, 'Tie::RefHash'; #this part is important
208 $cust_pkg => [ $svc_acct ],
211 $cust_main->insert( \%hash );
213 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
214 be set as the invoicing list (see L<"invoicing_list">). Errors return as
215 expected and rollback the entire transaction; it is not necessary to call
216 check_invoicing_list first. The invoicing_list is set after the records in the
217 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
218 invoicing_list destination to the newly-created svc_acct. Here's an example:
220 $cust_main->insert( {}, [ $email, 'POST' ] );
226 my $cust_pkgs = @_ ? shift : {};
227 my $invoicing_list = @_ ? shift : '';
229 local $SIG{HUP} = 'IGNORE';
230 local $SIG{INT} = 'IGNORE';
231 local $SIG{QUIT} = 'IGNORE';
232 local $SIG{TERM} = 'IGNORE';
233 local $SIG{TSTP} = 'IGNORE';
234 local $SIG{PIPE} = 'IGNORE';
236 my $oldAutoCommit = $FS::UID::AutoCommit;
237 local $FS::UID::AutoCommit = 0;
242 if ( $self->payby eq 'PREPAY' ) {
243 $self->payby('BILL');
244 my $prepay_credit = qsearchs(
246 { 'identifier' => $self->payinfo },
250 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
251 unless $prepay_credit;
252 $amount = $prepay_credit->amount;
253 $seconds = $prepay_credit->seconds;
254 my $error = $prepay_credit->delete;
256 $dbh->rollback if $oldAutoCommit;
257 return "removing prepay_credit (transaction rolled back): $error";
261 my $error = $self->SUPER::insert;
263 $dbh->rollback if $oldAutoCommit;
264 #return "inserting cust_main record (transaction rolled back): $error";
269 if ( $invoicing_list ) {
270 $error = $self->check_invoicing_list( $invoicing_list );
272 $dbh->rollback if $oldAutoCommit;
273 return "checking invoicing_list (transaction rolled back): $error";
275 $self->invoicing_list( $invoicing_list );
279 foreach my $cust_pkg ( keys %$cust_pkgs ) {
280 $cust_pkg->custnum( $self->custnum );
281 $error = $cust_pkg->insert;
283 $dbh->rollback if $oldAutoCommit;
284 return "inserting cust_pkg (transaction rolled back): $error";
286 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
287 $svc_something->pkgnum( $cust_pkg->pkgnum );
288 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
289 $svc_something->seconds( $svc_something->seconds + $seconds );
292 $error = $svc_something->insert;
294 $dbh->rollback if $oldAutoCommit;
295 #return "inserting svc_ (transaction rolled back): $error";
302 $dbh->rollback if $oldAutoCommit;
303 return "No svc_acct record to apply pre-paid time";
307 my $cust_credit = new FS::cust_credit {
308 'custnum' => $self->custnum,
311 $error = $cust_credit->insert;
313 $dbh->rollback if $oldAutoCommit;
314 return "inserting credit (transaction rolled back): $error";
318 #false laziness with sub replace
319 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
320 $error = $queue->insert($self->getfield('last'), $self->company);
322 $dbh->rollback if $oldAutoCommit;
323 return "queueing job (transaction rolled back): $error";
326 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
327 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
328 $error = $queue->insert($self->getfield('last'), $self->company);
330 $dbh->rollback if $oldAutoCommit;
331 return "queueing job (transaction rolled back): $error";
336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
341 =item delete NEW_CUSTNUM
343 This deletes the customer. If there is an error, returns the error, otherwise
346 This will completely remove all traces of the customer record. This is not
347 what you want when a customer cancels service; for that, cancel all of the
348 customer's packages (see L<FS::cust_pkg/cancel>).
350 If the customer has any uncancelled packages, you need to pass a new (valid)
351 customer number for those packages to be transferred to. Cancelled packages
352 will be deleted. Did I mention that this is NOT what you want when a customer
353 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
355 You can't delete a customer with invoices (see L<FS::cust_bill>),
356 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
357 refunds (see L<FS::cust_refund>).
364 local $SIG{HUP} = 'IGNORE';
365 local $SIG{INT} = 'IGNORE';
366 local $SIG{QUIT} = 'IGNORE';
367 local $SIG{TERM} = 'IGNORE';
368 local $SIG{TSTP} = 'IGNORE';
369 local $SIG{PIPE} = 'IGNORE';
371 my $oldAutoCommit = $FS::UID::AutoCommit;
372 local $FS::UID::AutoCommit = 0;
375 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
376 $dbh->rollback if $oldAutoCommit;
377 return "Can't delete a customer with invoices";
379 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
380 $dbh->rollback if $oldAutoCommit;
381 return "Can't delete a customer with credits";
383 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
384 $dbh->rollback if $oldAutoCommit;
385 return "Can't delete a customer with payments";
387 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
388 $dbh->rollback if $oldAutoCommit;
389 return "Can't delete a customer with refunds";
392 my @cust_pkg = $self->ncancelled_pkgs;
394 my $new_custnum = shift;
395 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
396 $dbh->rollback if $oldAutoCommit;
397 return "Invalid new customer number: $new_custnum";
399 foreach my $cust_pkg ( @cust_pkg ) {
400 my %hash = $cust_pkg->hash;
401 $hash{'custnum'} = $new_custnum;
402 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
403 my $error = $new_cust_pkg->replace($cust_pkg);
405 $dbh->rollback if $oldAutoCommit;
410 my @cancelled_cust_pkg = $self->all_pkgs;
411 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
412 my $error = $cust_pkg->delete;
414 $dbh->rollback if $oldAutoCommit;
419 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
420 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
422 my $error = $cust_main_invoice->delete;
424 $dbh->rollback if $oldAutoCommit;
429 my $error = $self->SUPER::delete;
431 $dbh->rollback if $oldAutoCommit;
435 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
440 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
442 Replaces the OLD_RECORD with this one in the database. If there is an error,
443 returns the error, otherwise returns false.
445 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
446 be set as the invoicing list (see L<"invoicing_list">). Errors return as
447 expected and rollback the entire transaction; it is not necessary to call
448 check_invoicing_list first. Here's an example:
450 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
459 local $SIG{HUP} = 'IGNORE';
460 local $SIG{INT} = 'IGNORE';
461 local $SIG{QUIT} = 'IGNORE';
462 local $SIG{TERM} = 'IGNORE';
463 local $SIG{TSTP} = 'IGNORE';
464 local $SIG{PIPE} = 'IGNORE';
466 my $oldAutoCommit = $FS::UID::AutoCommit;
467 local $FS::UID::AutoCommit = 0;
470 my $error = $self->SUPER::replace($old);
473 $dbh->rollback if $oldAutoCommit;
477 if ( @param ) { # INVOICING_LIST_ARYREF
478 my $invoicing_list = shift @param;
479 $error = $self->check_invoicing_list( $invoicing_list );
481 $dbh->rollback if $oldAutoCommit;
484 $self->invoicing_list( $invoicing_list );
487 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
488 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
489 # card/check info has changed, want to retry realtime_card invoice events
490 #false laziness w/collect
491 foreach my $cust_bill_event (
493 #$_->part_bill_event->plan eq 'realtime-card'
494 $_->part_bill_event->eventcode =~
495 /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
496 && $_->status eq 'done'
499 map { $_->cust_bill_event }
500 grep { $_->cust_bill_event }
501 $self->open_cust_bill
504 my $error = $cust_bill_event->retry;
506 $dbh->rollback if $oldAutoCommit;
507 return "error scheduling invoice events for retry: $error";
514 #false laziness with sub insert
515 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
516 $error = $queue->insert($self->getfield('last'), $self->company);
518 $dbh->rollback if $oldAutoCommit;
519 return "queueing job (transaction rolled back): $error";
522 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
523 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
524 $error = $queue->insert($self->getfield('last'), $self->company);
526 $dbh->rollback if $oldAutoCommit;
527 return "queueing job (transaction rolled back): $error";
532 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
539 Checks all fields to make sure this is a valid customer record. If there is
540 an error, returns the error, otherwise returns false. Called by the insert
548 #warn "BEFORE: \n". $self->_dump;
551 $self->ut_numbern('custnum')
552 || $self->ut_number('agentnum')
553 || $self->ut_number('refnum')
554 || $self->ut_name('last')
555 || $self->ut_name('first')
556 || $self->ut_textn('company')
557 || $self->ut_text('address1')
558 || $self->ut_textn('address2')
559 || $self->ut_text('city')
560 || $self->ut_textn('county')
561 || $self->ut_textn('state')
562 || $self->ut_country('country')
563 || $self->ut_anything('comments')
564 || $self->ut_numbern('referral_custnum')
566 #barf. need message catalogs. i18n. etc.
567 $error .= "Please select a advertising source."
568 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
569 return $error if $error;
571 return "Unknown agent"
572 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
574 return "Unknown refnum"
575 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
577 return "Unknown referring custnum ". $self->referral_custnum
578 unless ! $self->referral_custnum
579 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
581 if ( $self->ss eq '' ) {
586 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
587 or return "Illegal social security number: ". $self->ss;
588 $self->ss("$1-$2-$3");
592 # bad idea to disable, causes billing to fail because of no tax rates later
593 # unless ( $import ) {
594 unless ( qsearch('cust_main_county', {
595 'country' => $self->country,
598 return "Unknown state/county/country: ".
599 $self->state. "/". $self->county. "/". $self->country
600 unless qsearch('cust_main_county',{
601 'state' => $self->state,
602 'county' => $self->county,
603 'country' => $self->country,
609 $self->ut_phonen('daytime', $self->country)
610 || $self->ut_phonen('night', $self->country)
611 || $self->ut_phonen('fax', $self->country)
612 || $self->ut_zip('zip', $self->country)
614 return $error if $error;
617 last first company address1 address2 city county state zip
618 country daytime night fax
621 if ( defined $self->dbdef_table->column('ship_last') ) {
622 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
624 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
628 $self->ut_name('ship_last')
629 || $self->ut_name('ship_first')
630 || $self->ut_textn('ship_company')
631 || $self->ut_text('ship_address1')
632 || $self->ut_textn('ship_address2')
633 || $self->ut_text('ship_city')
634 || $self->ut_textn('ship_county')
635 || $self->ut_textn('ship_state')
636 || $self->ut_country('ship_country')
638 return $error if $error;
640 #false laziness with above
641 unless ( qsearchs('cust_main_county', {
642 'country' => $self->ship_country,
645 return "Unknown ship_state/ship_county/ship_country: ".
646 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
647 unless qsearchs('cust_main_county',{
648 'state' => $self->ship_state,
649 'county' => $self->ship_county,
650 'country' => $self->ship_country,
656 $self->ut_phonen('ship_daytime', $self->ship_country)
657 || $self->ut_phonen('ship_night', $self->ship_country)
658 || $self->ut_phonen('ship_fax', $self->ship_country)
659 || $self->ut_zip('ship_zip', $self->ship_country)
661 return $error if $error;
663 } else { # ship_ info eq billing info, so don't store dup info in database
664 $self->setfield("ship_$_", '')
665 foreach qw( last first company address1 address2 city county state zip
666 country daytime night fax );
670 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
671 or return "Illegal payby: ". $self->payby;
674 if ( $self->payby eq 'CARD' ) {
676 my $payinfo = $self->payinfo;
678 $payinfo =~ /^(\d{13,16})$/
679 or return gettext('invalid_card'); # . ": ". $self->payinfo;
681 $self->payinfo($payinfo);
683 or return gettext('invalid_card'); # . ": ". $self->payinfo;
684 return gettext('unknown_card_type')
685 if cardtype($self->payinfo) eq "Unknown";
687 } elsif ( $self->payby eq 'CHEK' ) {
689 my $payinfo = $self->payinfo;
690 $payinfo =~ s/[^\d\@]//g;
691 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
693 $self->payinfo($payinfo);
695 } elsif ( $self->payby eq 'LECB' ) {
697 my $payinfo = $self->payinfo;
699 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
701 $self->payinfo($payinfo);
703 } elsif ( $self->payby eq 'BILL' ) {
705 $error = $self->ut_textn('payinfo');
706 return "Illegal P.O. number: ". $self->payinfo if $error;
708 } elsif ( $self->payby eq 'COMP' ) {
710 $error = $self->ut_textn('payinfo');
711 return "Illegal comp account issuer: ". $self->payinfo if $error;
713 } elsif ( $self->payby eq 'PREPAY' ) {
715 my $payinfo = $self->payinfo;
716 $payinfo =~ s/\W//g; #anything else would just confuse things
717 $self->payinfo($payinfo);
718 $error = $self->ut_alpha('payinfo');
719 return "Illegal prepayment identifier: ". $self->payinfo if $error;
720 return "Unknown prepayment identifier"
721 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
725 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
726 return "Expriation date required"
727 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
730 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
731 or return "Illegal expiration date: ". $self->paydate;
732 my $y = length($2) == 4 ? $2 : "20$2";
733 $self->paydate("$y-$1-01");
734 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
735 return gettext('expired_card')
736 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
739 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
740 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
741 $self->payname( $self->first. " ". $self->getfield('last') );
743 $self->payname =~ /^([\w \,\.\-\']+)$/
744 or return gettext('illegal_name'). " payname: ". $self->payname;
748 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
751 $self->otaker(getotaker);
753 #warn "AFTER: \n". $self->_dump;
760 Returns all packages (see L<FS::cust_pkg>) for this customer.
766 if ( $self->{'_pkgnum'} ) {
767 values %{ $self->{'_pkgnum'}->cache };
769 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
773 =item ncancelled_pkgs
775 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
779 sub ncancelled_pkgs {
781 if ( $self->{'_pkgnum'} ) {
782 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
784 @{ [ # force list context
785 qsearch( 'cust_pkg', {
786 'custnum' => $self->custnum,
789 qsearch( 'cust_pkg', {
790 'custnum' => $self->custnum,
799 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
805 grep { $_->susp } $self->ncancelled_pkgs;
808 =item unflagged_suspended_pkgs
810 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
811 customer (thouse packages without the `manual_flag' set).
815 sub unflagged_suspended_pkgs {
817 return $self->suspended_pkgs
818 unless dbdef->table('cust_pkg')->column('manual_flag');
819 grep { ! $_->manual_flag } $self->suspended_pkgs;
822 =item unsuspended_pkgs
824 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
829 sub unsuspended_pkgs {
831 grep { ! $_->susp } $self->ncancelled_pkgs;
836 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
837 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
838 on success or a list of errors.
844 grep { $_->unsuspend } $self->suspended_pkgs;
849 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
850 Always returns a list: an empty list on success or a list of errors.
856 grep { $_->suspend } $self->unsuspended_pkgs;
861 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
862 Always returns a list: an empty list on success or a list of errors.
868 grep { $_->cancel } $self->ncancelled_pkgs;
873 Returns the agent (see L<FS::agent>) for this customer.
879 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
884 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
885 conjunction with the collect method.
887 Options are passed as name-value pairs.
889 The only currently available option is `time', which bills the customer as if
890 it were that time. It is specified as a UNIX timestamp; see
891 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
892 functions. For example:
896 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
898 If there is an error, returns the error, otherwise returns false.
903 my( $self, %options ) = @_;
904 my $time = $options{'time'} || time;
909 local $SIG{HUP} = 'IGNORE';
910 local $SIG{INT} = 'IGNORE';
911 local $SIG{QUIT} = 'IGNORE';
912 local $SIG{TERM} = 'IGNORE';
913 local $SIG{TSTP} = 'IGNORE';
914 local $SIG{PIPE} = 'IGNORE';
916 my $oldAutoCommit = $FS::UID::AutoCommit;
917 local $FS::UID::AutoCommit = 0;
920 # find the packages which are due for billing, find out how much they are
921 # & generate invoice database.
923 my( $total_setup, $total_recur ) = ( 0, 0 );
924 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
925 my @cust_bill_pkg = ();
927 #my $taxable_charged = 0;##
932 foreach my $cust_pkg (
933 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
936 #NO!! next if $cust_pkg->cancel;
937 next if $cust_pkg->getfield('cancel');
939 #? to avoid use of uninitialized value errors... ?
940 $cust_pkg->setfield('bill', '')
941 unless defined($cust_pkg->bill);
943 my $part_pkg = $cust_pkg->part_pkg;
945 #so we don't modify cust_pkg record unnecessarily
946 my $cust_pkg_mod_flag = 0;
947 my %hash = $cust_pkg->hash;
948 my $old_cust_pkg = new FS::cust_pkg \%hash;
954 unless ( $cust_pkg->setup ) {
955 my $setup_prog = $part_pkg->getfield('setup');
956 $setup_prog =~ /^(.*)$/ or do {
957 $dbh->rollback if $oldAutoCommit;
958 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
964 ##$cpt->permit(); #what is necessary?
965 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
966 #$setup = $cpt->reval($setup_prog);
967 $setup = eval $setup_prog;
968 unless ( defined($setup) ) {
969 $dbh->rollback if $oldAutoCommit;
970 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
971 "(expression $setup_prog): $@";
973 $cust_pkg->setfield('setup',$time);
974 $cust_pkg_mod_flag=1;
980 if ( $part_pkg->getfield('freq') > 0 &&
981 ! $cust_pkg->getfield('susp') &&
982 ( $cust_pkg->getfield('bill') || 0 ) <= $time
984 my $recur_prog = $part_pkg->getfield('recur');
985 $recur_prog =~ /^(.*)$/ or do {
986 $dbh->rollback if $oldAutoCommit;
987 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
992 # shared with $recur_prog
993 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
996 ##$cpt->permit(); #what is necessary?
997 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
998 #$recur = $cpt->reval($recur_prog);
999 $recur = eval $recur_prog;
1000 unless ( defined($recur) ) {
1001 $dbh->rollback if $oldAutoCommit;
1002 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1003 "(expression $recur_prog): $@";
1005 #change this bit to use Date::Manip? CAREFUL with timezones (see
1006 # mailing list archive)
1007 my ($sec,$min,$hour,$mday,$mon,$year) =
1008 (localtime($sdate) )[0,1,2,3,4,5];
1010 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1011 # only for figuring next bill date, nothing else, so, reset $sdate again
1013 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1014 $cust_pkg->last_bill($sdate)
1015 if $cust_pkg->dbdef_table->column('last_bill');
1017 $mon += $part_pkg->freq;
1018 until ( $mon < 12 ) { $mon -= 12; $year++; }
1019 $cust_pkg->setfield('bill',
1020 timelocal($sec,$min,$hour,$mday,$mon,$year));
1021 $cust_pkg_mod_flag = 1;
1024 warn "\$setup is undefined" unless defined($setup);
1025 warn "\$recur is undefined" unless defined($recur);
1026 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1028 my $taxable_charged = 0;
1029 if ( $cust_pkg_mod_flag ) {
1030 $error=$cust_pkg->replace($old_cust_pkg);
1031 if ( $error ) { #just in case
1032 $dbh->rollback if $oldAutoCommit;
1033 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1035 $setup = sprintf( "%.2f", $setup );
1036 $recur = sprintf( "%.2f", $recur );
1038 $dbh->rollback if $oldAutoCommit;
1039 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1042 $dbh->rollback if $oldAutoCommit;
1043 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1045 if ( $setup > 0 || $recur > 0 ) {
1046 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1047 'pkgnum' => $cust_pkg->pkgnum,
1051 'edate' => $cust_pkg->bill,
1052 'details' => \@details,
1054 push @cust_bill_pkg, $cust_bill_pkg;
1055 $total_setup += $setup;
1056 $total_recur += $recur;
1057 $taxable_charged += $setup
1058 unless $part_pkg->setuptax =~ /^Y$/i;
1059 $taxable_charged += $recur
1060 unless $part_pkg->recurtax =~ /^Y$/i;
1062 unless ( $self->tax =~ /Y/i
1063 || $self->payby eq 'COMP'
1064 || $taxable_charged == 0 ) {
1066 my $cust_main_county = qsearchs('cust_main_county',{
1067 'state' => $self->state,
1068 'county' => $self->county,
1069 'country' => $self->country,
1070 'taxclass' => $part_pkg->taxclass,
1072 $cust_main_county ||= qsearchs('cust_main_county',{
1073 'state' => $self->state,
1074 'county' => $self->county,
1075 'country' => $self->country,
1078 unless ( $cust_main_county ) {
1079 $dbh->rollback if $oldAutoCommit;
1081 "fatal: can't find tax rate for state/county/country/taxclass ".
1082 join('/', ( map $self->$_(), qw(state county country) ),
1083 $part_pkg->taxclass ). "\n";
1086 if ( $cust_main_county->exempt_amount ) {
1087 my ($mon,$year) = (localtime($sdate) )[4,5];
1089 my $freq = $part_pkg->freq || 1;
1090 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1091 foreach my $which_month ( 1 .. $freq ) {
1093 'custnum' => $self->custnum,
1094 'taxnum' => $cust_main_county->taxnum,
1095 'year' => 1900+$year,
1098 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1099 until ( $mon < 13 ) { $mon -= 12; $year++; }
1100 my $cust_tax_exempt =
1101 qsearchs('cust_tax_exempt', \%hash)
1102 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1103 my $remaining_exemption = sprintf("%.2f",
1104 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1105 if ( $remaining_exemption > 0 ) {
1106 my $addl = $remaining_exemption > $taxable_per_month
1107 ? $taxable_per_month
1108 : $remaining_exemption;
1109 $taxable_charged -= $addl;
1110 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1111 $cust_tax_exempt->hash,
1112 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1114 $error = $new_cust_tax_exempt->exemptnum
1115 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1116 : $new_cust_tax_exempt->insert;
1118 $dbh->rollback if $oldAutoCommit;
1119 return "fatal: can't update cust_tax_exempt: $error";
1122 } # if $remaining_exemption > 0
1124 } #foreach $which_month
1126 } #if $cust_main_county->exempt_amount
1128 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1130 #$tax += $taxable_charged * $cust_main_county->tax / 100
1131 $tax{ $cust_main_county->taxname || 'Tax' } +=
1132 $taxable_charged * $cust_main_county->tax / 100
1134 } #unless $self->tax =~ /Y/i
1135 # || $self->payby eq 'COMP'
1136 # || $taxable_charged == 0
1138 } #if $setup > 0 || $recur > 0
1140 } #if $cust_pkg_mod_flag
1142 } #foreach my $cust_pkg
1144 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1145 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1147 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1148 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1152 # unless ( $self->tax =~ /Y/i
1153 # || $self->payby eq 'COMP'
1154 # || $taxable_charged == 0 ) {
1155 # my $cust_main_county = qsearchs('cust_main_county',{
1156 # 'state' => $self->state,
1157 # 'county' => $self->county,
1158 # 'country' => $self->country,
1159 # } ) or die "fatal: can't find tax rate for state/county/country ".
1160 # $self->state. "/". $self->county. "/". $self->country. "\n";
1161 # my $tax = sprintf( "%.2f",
1162 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1165 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1166 my $tax = sprintf("%.2f", $tax{$taxname} );
1167 $charged = sprintf( "%.2f", $charged+$tax );
1169 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1175 'itemdesc' => $taxname,
1177 push @cust_bill_pkg, $cust_bill_pkg;
1181 my $cust_bill = new FS::cust_bill ( {
1182 'custnum' => $self->custnum,
1184 'charged' => $charged,
1186 $error = $cust_bill->insert;
1188 $dbh->rollback if $oldAutoCommit;
1189 return "can't create invoice for customer #". $self->custnum. ": $error";
1192 my $invnum = $cust_bill->invnum;
1194 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1196 $cust_bill_pkg->invnum($invnum);
1197 $error = $cust_bill_pkg->insert;
1199 $dbh->rollback if $oldAutoCommit;
1200 return "can't create invoice line item for customer #". $self->custnum.
1205 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1209 =item collect OPTIONS
1211 (Attempt to) collect money for this customer's outstanding invoices (see
1212 L<FS::cust_bill>). Usually used after the bill method.
1214 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1215 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1217 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1218 and the invoice events web interface.
1220 If there is an error, returns the error, otherwise returns false.
1222 Options are passed as name-value pairs.
1224 Currently available options are:
1226 invoice_time - Use this time when deciding when to print invoices and
1227 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>
1228 for conversion functions.
1230 retry_card - Retry cards even when not scheduled by invoice events.
1232 batch_card - This option is deprecated. See the invoice events web interface
1233 to control whether cards are batched or run against a realtime gateway.
1235 report_badcard - This option is deprecated.
1237 force_print - This option is deprecated; see the invoice events web interface.
1242 my( $self, %options ) = @_;
1243 my $invoice_time = $options{'invoice_time'} || time;
1246 local $SIG{HUP} = 'IGNORE';
1247 local $SIG{INT} = 'IGNORE';
1248 local $SIG{QUIT} = 'IGNORE';
1249 local $SIG{TERM} = 'IGNORE';
1250 local $SIG{TSTP} = 'IGNORE';
1251 local $SIG{PIPE} = 'IGNORE';
1253 my $oldAutoCommit = $FS::UID::AutoCommit;
1254 local $FS::UID::AutoCommit = 0;
1257 my $balance = $self->balance;
1258 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1259 unless ( $balance > 0 ) { #redundant?????
1260 $dbh->rollback if $oldAutoCommit; #hmm
1264 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1265 #false laziness w/replace
1266 foreach my $cust_bill_event (
1268 #$_->part_bill_event->plan eq 'realtime-card'
1269 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1270 && $_->status eq 'done'
1273 map { $_->cust_bill_event }
1274 grep { $_->cust_bill_event }
1275 $self->open_cust_bill
1277 my $error = $cust_bill_event->retry;
1279 $dbh->rollback if $oldAutoCommit;
1280 return "error scheduling invoice events for retry: $error";
1286 foreach my $cust_bill ( $self->cust_bill ) {
1288 #this has to be before next's
1289 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1293 $balance = sprintf( "%.2f", $balance - $amount );
1295 next unless $cust_bill->owed > 0;
1297 # don't try to charge for the same invoice if it's already in a batch
1298 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1300 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1302 next unless $amount > 0;
1305 foreach my $part_bill_event (
1306 sort { $a->seconds <=> $b->seconds
1307 || $a->weight <=> $b->weight
1308 || $a->eventpart <=> $b->eventpart }
1309 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1310 && ! qsearchs( 'cust_bill_event', {
1311 'invnum' => $cust_bill->invnum,
1312 'eventpart' => $_->eventpart,
1316 qsearch('part_bill_event', { 'payby' => $self->payby,
1317 'disabled' => '', } )
1320 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1322 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1324 my $cust_main = $self; #for callback
1325 my $error = eval $part_bill_event->eventcode;
1328 my $statustext = '';
1332 } elsif ( $error ) {
1334 $statustext = $error;
1339 #add cust_bill_event
1340 my $cust_bill_event = new FS::cust_bill_event {
1341 'invnum' => $cust_bill->invnum,
1342 'eventpart' => $part_bill_event->eventpart,
1343 #'_date' => $invoice_time,
1345 'status' => $status,
1346 'statustext' => $statustext,
1348 $error = $cust_bill_event->insert;
1350 #$dbh->rollback if $oldAutoCommit;
1351 #return "error: $error";
1353 # gah, even with transactions.
1354 $dbh->commit if $oldAutoCommit; #well.
1355 my $e = 'WARNING: Event run but database not updated - '.
1356 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1357 ', eventpart '. $part_bill_event->eventpart.
1368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1375 Returns the total owed for this customer on all invoices
1376 (see L<FS::cust_bill/owed>).
1382 $self->total_owed_date(2145859200); #12/31/2037
1385 =item total_owed_date TIME
1387 Returns the total owed for this customer on all invoices with date earlier than
1388 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1389 see L<Time::Local> and L<Date::Parse> for conversion functions.
1393 sub total_owed_date {
1397 foreach my $cust_bill (
1398 grep { $_->_date <= $time }
1399 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1401 $total_bill += $cust_bill->owed;
1403 sprintf( "%.2f", $total_bill );
1408 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1409 to outstanding invoice balances in chronological order and returns the value
1410 of any remaining unapplied credits available for refund
1411 (see L<FS::cust_refund>).
1418 return 0 unless $self->total_credited;
1420 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1421 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1423 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1424 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1428 foreach my $cust_bill ( @invoices ) {
1431 if ( !defined($credit) || $credit->credited == 0) {
1432 $credit = pop @credits or last;
1435 if ($cust_bill->owed >= $credit->credited) {
1436 $amount=$credit->credited;
1438 $amount=$cust_bill->owed;
1441 my $cust_credit_bill = new FS::cust_credit_bill ( {
1442 'crednum' => $credit->crednum,
1443 'invnum' => $cust_bill->invnum,
1444 'amount' => $amount,
1446 my $error = $cust_credit_bill->insert;
1447 die $error if $error;
1449 redo if ($cust_bill->owed > 0);
1453 return $self->total_credited;
1456 =item apply_payments
1458 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1459 to outstanding invoice balances in chronological order.
1461 #and returns the value of any remaining unapplied payments.
1465 sub apply_payments {
1470 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1471 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1473 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1474 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1478 foreach my $cust_bill ( @invoices ) {
1481 if ( !defined($payment) || $payment->unapplied == 0 ) {
1482 $payment = pop @payments or last;
1485 if ( $cust_bill->owed >= $payment->unapplied ) {
1486 $amount = $payment->unapplied;
1488 $amount = $cust_bill->owed;
1491 my $cust_bill_pay = new FS::cust_bill_pay ( {
1492 'paynum' => $payment->paynum,
1493 'invnum' => $cust_bill->invnum,
1494 'amount' => $amount,
1496 my $error = $cust_bill_pay->insert;
1497 die $error if $error;
1499 redo if ( $cust_bill->owed > 0);
1503 return $self->total_unapplied_payments;
1506 =item total_credited
1508 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1509 customer. See L<FS::cust_credit/credited>.
1513 sub total_credited {
1515 my $total_credit = 0;
1516 foreach my $cust_credit ( qsearch('cust_credit', {
1517 'custnum' => $self->custnum,
1519 $total_credit += $cust_credit->credited;
1521 sprintf( "%.2f", $total_credit );
1524 =item total_unapplied_payments
1526 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1527 See L<FS::cust_pay/unapplied>.
1531 sub total_unapplied_payments {
1533 my $total_unapplied = 0;
1534 foreach my $cust_pay ( qsearch('cust_pay', {
1535 'custnum' => $self->custnum,
1537 $total_unapplied += $cust_pay->unapplied;
1539 sprintf( "%.2f", $total_unapplied );
1544 Returns the balance for this customer (total_owed minus total_credited
1545 minus total_unapplied_payments).
1552 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1556 =item balance_date TIME
1558 Returns the balance for this customer, only considering invoices with date
1559 earlier than TIME (total_owed_date minus total_credited minus
1560 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1561 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1570 $self->total_owed_date($time)
1571 - $self->total_credited
1572 - $self->total_unapplied_payments
1576 =item invoicing_list [ ARRAYREF ]
1578 If an arguement is given, sets these email addresses as invoice recipients
1579 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1580 (except as warnings), so use check_invoicing_list first.
1582 Returns a list of email addresses (with svcnum entries expanded).
1584 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1585 check it without disturbing anything by passing nothing.
1587 This interface may change in the future.
1591 sub invoicing_list {
1592 my( $self, $arrayref ) = @_;
1594 my @cust_main_invoice;
1595 if ( $self->custnum ) {
1596 @cust_main_invoice =
1597 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1599 @cust_main_invoice = ();
1601 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1602 #warn $cust_main_invoice->destnum;
1603 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1604 #warn $cust_main_invoice->destnum;
1605 my $error = $cust_main_invoice->delete;
1606 warn $error if $error;
1609 if ( $self->custnum ) {
1610 @cust_main_invoice =
1611 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1613 @cust_main_invoice = ();
1615 my %seen = map { $_->address => 1 } @cust_main_invoice;
1616 foreach my $address ( @{$arrayref} ) {
1617 next if exists $seen{$address} && $seen{$address};
1618 $seen{$address} = 1;
1619 my $cust_main_invoice = new FS::cust_main_invoice ( {
1620 'custnum' => $self->custnum,
1623 my $error = $cust_main_invoice->insert;
1624 warn $error if $error;
1627 if ( $self->custnum ) {
1629 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1635 =item check_invoicing_list ARRAYREF
1637 Checks these arguements as valid input for the invoicing_list method. If there
1638 is an error, returns the error, otherwise returns false.
1642 sub check_invoicing_list {
1643 my( $self, $arrayref ) = @_;
1644 foreach my $address ( @{$arrayref} ) {
1645 my $cust_main_invoice = new FS::cust_main_invoice ( {
1646 'custnum' => $self->custnum,
1649 my $error = $self->custnum
1650 ? $cust_main_invoice->check
1651 : $cust_main_invoice->checkdest
1653 return $error if $error;
1658 =item set_default_invoicing_list
1660 Sets the invoicing list to all accounts associated with this customer,
1661 overwriting any previous invoicing list.
1665 sub set_default_invoicing_list {
1667 $self->invoicing_list($self->all_emails);
1672 Returns the email addresses of all accounts provisioned for this customer.
1679 foreach my $cust_pkg ( $self->all_pkgs ) {
1680 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1682 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1683 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1685 $list{$_}=1 foreach map { $_->email } @svc_acct;
1690 =item invoicing_list_addpost
1692 Adds postal invoicing to this customer. If this customer is already configured
1693 to receive postal invoices, does nothing.
1697 sub invoicing_list_addpost {
1699 return if grep { $_ eq 'POST' } $self->invoicing_list;
1700 my @invoicing_list = $self->invoicing_list;
1701 push @invoicing_list, 'POST';
1702 $self->invoicing_list(\@invoicing_list);
1705 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1707 Returns an array of customers referred by this customer (referral_custnum set
1708 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1709 customers referred by customers referred by this customer and so on, inclusive.
1710 The default behavior is DEPTH 1 (no recursion).
1714 sub referral_cust_main {
1716 my $depth = @_ ? shift : 1;
1717 my $exclude = @_ ? shift : {};
1720 map { $exclude->{$_->custnum}++; $_; }
1721 grep { ! $exclude->{ $_->custnum } }
1722 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1726 map { $_->referral_cust_main($depth-1, $exclude) }
1733 =item referral_cust_main_ncancelled
1735 Same as referral_cust_main, except only returns customers with uncancelled
1740 sub referral_cust_main_ncancelled {
1742 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1745 =item referral_cust_pkg [ DEPTH ]
1747 Like referral_cust_main, except returns a flat list of all unsuspended (and
1748 uncancelled) packages for each customer. The number of items in this list may
1749 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1753 sub referral_cust_pkg {
1755 my $depth = @_ ? shift : 1;
1757 map { $_->unsuspended_pkgs }
1758 grep { $_->unsuspended_pkgs }
1759 $self->referral_cust_main($depth);
1762 =item credit AMOUNT, REASON
1764 Applies a credit to this customer. If there is an error, returns the error,
1765 otherwise returns false.
1770 my( $self, $amount, $reason ) = @_;
1771 my $cust_credit = new FS::cust_credit {
1772 'custnum' => $self->custnum,
1773 'amount' => $amount,
1774 'reason' => $reason,
1776 $cust_credit->insert;
1779 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1781 Creates a one-time charge for this customer. If there is an error, returns
1782 the error, otherwise returns false.
1787 my ( $self, $amount ) = ( shift, shift );
1788 my $pkg = @_ ? shift : 'One-time charge';
1789 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1790 my $taxclass = @_ ? shift : '';
1792 local $SIG{HUP} = 'IGNORE';
1793 local $SIG{INT} = 'IGNORE';
1794 local $SIG{QUIT} = 'IGNORE';
1795 local $SIG{TERM} = 'IGNORE';
1796 local $SIG{TSTP} = 'IGNORE';
1797 local $SIG{PIPE} = 'IGNORE';
1799 my $oldAutoCommit = $FS::UID::AutoCommit;
1800 local $FS::UID::AutoCommit = 0;
1803 my $part_pkg = new FS::part_pkg ( {
1805 'comment' => $comment,
1810 'taxclass' => $taxclass,
1813 my $error = $part_pkg->insert;
1815 $dbh->rollback if $oldAutoCommit;
1819 my $pkgpart = $part_pkg->pkgpart;
1820 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1821 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1822 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1823 $error = $type_pkgs->insert;
1825 $dbh->rollback if $oldAutoCommit;
1830 my $cust_pkg = new FS::cust_pkg ( {
1831 'custnum' => $self->custnum,
1832 'pkgpart' => $pkgpart,
1835 $error = $cust_pkg->insert;
1837 $dbh->rollback if $oldAutoCommit;
1841 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1848 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1854 sort { $a->_date <=> $b->_date }
1855 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1858 =item open_cust_bill
1860 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1865 sub open_cust_bill {
1867 grep { $_->owed > 0 } $self->cust_bill;
1876 =item check_and_rebuild_fuzzyfiles
1880 sub check_and_rebuild_fuzzyfiles {
1881 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1882 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1883 or &rebuild_fuzzyfiles;
1886 =item rebuild_fuzzyfiles
1890 sub rebuild_fuzzyfiles {
1892 use Fcntl qw(:flock);
1894 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1898 open(LASTLOCK,">>$dir/cust_main.last")
1899 or die "can't open $dir/cust_main.last: $!";
1900 flock(LASTLOCK,LOCK_EX)
1901 or die "can't lock $dir/cust_main.last: $!";
1903 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1905 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1906 if defined dbdef->table('cust_main')->column('ship_last');
1908 open (LASTCACHE,">$dir/cust_main.last.tmp")
1909 or die "can't open $dir/cust_main.last.tmp: $!";
1910 print LASTCACHE join("\n", @all_last), "\n";
1911 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1913 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1918 open(COMPANYLOCK,">>$dir/cust_main.company")
1919 or die "can't open $dir/cust_main.company: $!";
1920 flock(COMPANYLOCK,LOCK_EX)
1921 or die "can't lock $dir/cust_main.company: $!";
1923 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1925 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1926 if defined dbdef->table('cust_main')->column('ship_last');
1928 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1929 or die "can't open $dir/cust_main.company.tmp: $!";
1930 print COMPANYCACHE join("\n", @all_company), "\n";
1931 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1933 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1943 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1944 open(LASTCACHE,"<$dir/cust_main.last")
1945 or die "can't open $dir/cust_main.last: $!";
1946 my @array = map { chomp; $_; } <LASTCACHE>;
1956 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1957 open(COMPANYCACHE,"<$dir/cust_main.company")
1958 or die "can't open $dir/cust_main.last: $!";
1959 my @array = map { chomp; $_; } <COMPANYCACHE>;
1964 =item append_fuzzyfiles LASTNAME COMPANY
1968 sub append_fuzzyfiles {
1969 my( $last, $company ) = @_;
1971 &check_and_rebuild_fuzzyfiles;
1973 use Fcntl qw(:flock);
1975 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1979 open(LAST,">>$dir/cust_main.last")
1980 or die "can't open $dir/cust_main.last: $!";
1982 or die "can't lock $dir/cust_main.last: $!";
1984 print LAST "$last\n";
1987 or die "can't unlock $dir/cust_main.last: $!";
1993 open(COMPANY,">>$dir/cust_main.company")
1994 or die "can't open $dir/cust_main.company: $!";
1995 flock(COMPANY,LOCK_EX)
1996 or die "can't lock $dir/cust_main.company: $!";
1998 print COMPANY "$company\n";
2000 flock(COMPANY,LOCK_UN)
2001 or die "can't unlock $dir/cust_main.company: $!";
2015 #warn join('-',keys %$param);
2016 my $fh = $param->{filehandle};
2017 my $agentnum = $param->{agentnum};
2018 my $refnum = $param->{refnum};
2019 my $pkgpart = $param->{pkgpart};
2020 my @fields = @{$param->{fields}};
2022 eval "use Date::Parse;";
2024 eval "use Text::CSV_XS;";
2027 my $csv = new Text::CSV_XS;
2034 local $SIG{HUP} = 'IGNORE';
2035 local $SIG{INT} = 'IGNORE';
2036 local $SIG{QUIT} = 'IGNORE';
2037 local $SIG{TERM} = 'IGNORE';
2038 local $SIG{TSTP} = 'IGNORE';
2039 local $SIG{PIPE} = 'IGNORE';
2041 my $oldAutoCommit = $FS::UID::AutoCommit;
2042 local $FS::UID::AutoCommit = 0;
2045 #while ( $columns = $csv->getline($fh) ) {
2047 while ( defined($line=<$fh>) ) {
2049 $csv->parse($line) or do {
2050 $dbh->rollback if $oldAutoCommit;
2051 return "can't parse: ". $csv->error_input();
2054 my @columns = $csv->fields();
2055 #warn join('-',@columns);
2058 agentnum => $agentnum,
2060 country => 'US', #default
2061 payby => 'BILL', #default
2062 paydate => '12/2037', #default
2064 my $billtime = time;
2065 my %cust_pkg = ( pkgpart => $pkgpart );
2066 foreach my $field ( @fields ) {
2067 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2068 #$cust_pkg{$1} = str2time( shift @$columns );
2069 if ( $1 eq 'setup' ) {
2070 $billtime = str2time(shift @columns);
2072 $cust_pkg{$1} = str2time( shift @columns );
2075 #$cust_main{$field} = shift @$columns;
2076 $cust_main{$field} = shift @columns;
2080 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2081 my $cust_main = new FS::cust_main ( \%cust_main );
2083 tie my %hash, 'Tie::RefHash'; #this part is important
2084 $hash{$cust_pkg} = [] if $pkgpart;
2085 my $error = $cust_main->insert( \%hash );
2088 $dbh->rollback if $oldAutoCommit;
2089 return "can't insert customer for $line: $error";
2092 #false laziness w/bill.cgi
2093 $error = $cust_main->bill( 'time' => $billtime );
2095 $dbh->rollback if $oldAutoCommit;
2096 return "can't bill customer for $line: $error";
2099 $cust_main->apply_payments;
2100 $cust_main->apply_credits;
2102 $error = $cust_main->collect();
2104 $dbh->rollback if $oldAutoCommit;
2105 return "can't collect customer for $line: $error";
2111 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2113 return "Empty file!" unless $imported;
2125 #warn join('-',keys %$param);
2126 my $fh = $param->{filehandle};
2127 my @fields = @{$param->{fields}};
2129 eval "use Date::Parse;";
2131 eval "use Text::CSV_XS;";
2134 my $csv = new Text::CSV_XS;
2141 local $SIG{HUP} = 'IGNORE';
2142 local $SIG{INT} = 'IGNORE';
2143 local $SIG{QUIT} = 'IGNORE';
2144 local $SIG{TERM} = 'IGNORE';
2145 local $SIG{TSTP} = 'IGNORE';
2146 local $SIG{PIPE} = 'IGNORE';
2148 my $oldAutoCommit = $FS::UID::AutoCommit;
2149 local $FS::UID::AutoCommit = 0;
2152 #while ( $columns = $csv->getline($fh) ) {
2154 while ( defined($line=<$fh>) ) {
2156 $csv->parse($line) or do {
2157 $dbh->rollback if $oldAutoCommit;
2158 return "can't parse: ". $csv->error_input();
2161 my @columns = $csv->fields();
2162 #warn join('-',@columns);
2165 foreach my $field ( @fields ) {
2166 $row{$field} = shift @columns;
2169 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2170 unless ( $cust_main ) {
2171 $dbh->rollback if $oldAutoCommit;
2172 return "unknown custnum $row{'custnum'}";
2175 if ( $row{'amount'} > 0 ) {
2176 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2178 $dbh->rollback if $oldAutoCommit;
2182 } elsif ( $row{'amount'} < 0 ) {
2183 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2186 $dbh->rollback if $oldAutoCommit;
2196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2198 return "Empty file!" unless $imported;
2210 The delete method should possibly take an FS::cust_main object reference
2211 instead of a scalar customer number.
2213 Bill and collect options should probably be passed as references instead of a
2216 There should probably be a configuration file with a list of allowed credit
2219 No multiple currency support (probably a larger project than just this module).
2223 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2224 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2225 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.