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), `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)$/ &&
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 eq '$cust_bill->realtime_card();'
495 && $_->status eq 'done'
498 map { $_->cust_bill_event }
499 grep { $_->cust_bill_event }
500 $self->open_cust_bill
503 my $error = $cust_bill_event->retry;
505 $dbh->rollback if $oldAutoCommit;
506 return "error scheduling invoice events for retry: $error";
513 #false laziness with sub insert
514 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
515 $error = $queue->insert($self->getfield('last'), $self->company);
517 $dbh->rollback if $oldAutoCommit;
518 return "queueing job (transaction rolled back): $error";
521 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
522 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
523 $error = $queue->insert($self->getfield('last'), $self->company);
525 $dbh->rollback if $oldAutoCommit;
526 return "queueing job (transaction rolled back): $error";
531 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
538 Checks all fields to make sure this is a valid customer record. If there is
539 an error, returns the error, otherwise returns false. Called by the insert
547 #warn "BEFORE: \n". $self->_dump;
550 $self->ut_numbern('custnum')
551 || $self->ut_number('agentnum')
552 || $self->ut_number('refnum')
553 || $self->ut_name('last')
554 || $self->ut_name('first')
555 || $self->ut_textn('company')
556 || $self->ut_text('address1')
557 || $self->ut_textn('address2')
558 || $self->ut_text('city')
559 || $self->ut_textn('county')
560 || $self->ut_textn('state')
561 || $self->ut_country('country')
562 || $self->ut_anything('comments')
563 || $self->ut_numbern('referral_custnum')
565 #barf. need message catalogs. i18n. etc.
566 $error .= "Please select a advertising source."
567 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
568 return $error if $error;
570 return "Unknown agent"
571 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
573 return "Unknown refnum"
574 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
576 return "Unknown referring custnum ". $self->referral_custnum
577 unless ! $self->referral_custnum
578 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
580 if ( $self->ss eq '' ) {
585 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
586 or return "Illegal social security number: ". $self->ss;
587 $self->ss("$1-$2-$3");
591 # bad idea to disable, causes billing to fail because of no tax rates later
592 # unless ( $import ) {
593 unless ( qsearchs('cust_main_county', {
594 'country' => $self->country,
597 return "Unknown state/county/country: ".
598 $self->state. "/". $self->county. "/". $self->country
599 unless qsearchs('cust_main_county',{
600 'state' => $self->state,
601 'county' => $self->county,
602 'country' => $self->country,
608 $self->ut_phonen('daytime', $self->country)
609 || $self->ut_phonen('night', $self->country)
610 || $self->ut_phonen('fax', $self->country)
611 || $self->ut_zip('zip', $self->country)
613 return $error if $error;
616 last first company address1 address2 city county state zip
617 country daytime night fax
620 if ( defined $self->dbdef_table->column('ship_last') ) {
621 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
623 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
627 $self->ut_name('ship_last')
628 || $self->ut_name('ship_first')
629 || $self->ut_textn('ship_company')
630 || $self->ut_text('ship_address1')
631 || $self->ut_textn('ship_address2')
632 || $self->ut_text('ship_city')
633 || $self->ut_textn('ship_county')
634 || $self->ut_textn('ship_state')
635 || $self->ut_country('ship_country')
637 return $error if $error;
639 #false laziness with above
640 unless ( qsearchs('cust_main_county', {
641 'country' => $self->ship_country,
644 return "Unknown ship_state/ship_county/ship_country: ".
645 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
646 unless qsearchs('cust_main_county',{
647 'state' => $self->ship_state,
648 'county' => $self->ship_county,
649 'country' => $self->ship_country,
655 $self->ut_phonen('ship_daytime', $self->ship_country)
656 || $self->ut_phonen('ship_night', $self->ship_country)
657 || $self->ut_phonen('ship_fax', $self->ship_country)
658 || $self->ut_zip('ship_zip', $self->ship_country)
660 return $error if $error;
662 } else { # ship_ info eq billing info, so don't store dup info in database
663 $self->setfield("ship_$_", '')
664 foreach qw( last first company address1 address2 city county state zip
665 country daytime night fax );
669 $self->payby =~ /^(CARD|CHEK|BILL|COMP|PREPAY)$/
670 or return "Illegal payby: ". $self->payby;
673 if ( $self->payby eq 'CARD' ) {
675 my $payinfo = $self->payinfo;
677 $payinfo =~ /^(\d{13,16})$/
678 or return gettext('invalid_card'); # . ": ". $self->payinfo;
680 $self->payinfo($payinfo);
682 or return gettext('invalid_card'); # . ": ". $self->payinfo;
683 return gettext('unknown_card_type')
684 if cardtype($self->payinfo) eq "Unknown";
686 } elsif ( $self->payby eq 'CHEK' ) {
688 my $payinfo = $self->payinfo;
689 $payinfo =~ s/[\D\@]//g;
690 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
692 $self->payinfo($payinfo);
694 } elsif ( $self->payby eq 'BILL' ) {
696 $error = $self->ut_textn('payinfo');
697 return "Illegal P.O. number: ". $self->payinfo if $error;
699 } elsif ( $self->payby eq 'COMP' ) {
701 $error = $self->ut_textn('payinfo');
702 return "Illegal comp account issuer: ". $self->payinfo if $error;
704 } elsif ( $self->payby eq 'PREPAY' ) {
706 my $payinfo = $self->payinfo;
707 $payinfo =~ s/\W//g; #anything else would just confuse things
708 $self->payinfo($payinfo);
709 $error = $self->ut_alpha('payinfo');
710 return "Illegal prepayment identifier: ". $self->payinfo if $error;
711 return "Unknown prepayment identifier"
712 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
716 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
717 return "Expriation date required"
718 unless $self->payby =~ /^(BILL|PREPAY|CHEK)$/;
721 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
722 or return "Illegal expiration date: ". $self->paydate;
723 my $y = length($2) == 4 ? $2 : "20$2";
724 $self->paydate("$y-$1-01");
725 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
726 return gettext('expired_card')
727 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
730 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
731 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
732 $self->payname( $self->first. " ". $self->getfield('last') );
734 $self->payname =~ /^([\w \,\.\-\']+)$/
735 or return gettext('illegal_name'). " payname: ". $self->payname;
739 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
742 $self->otaker(getotaker);
744 #warn "AFTER: \n". $self->_dump;
751 Returns all packages (see L<FS::cust_pkg>) for this customer.
757 if ( $self->{'_pkgnum'} ) {
758 values %{ $self->{'_pkgnum'}->cache };
760 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
764 =item ncancelled_pkgs
766 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
770 sub ncancelled_pkgs {
772 if ( $self->{'_pkgnum'} ) {
773 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
775 @{ [ # force list context
776 qsearch( 'cust_pkg', {
777 'custnum' => $self->custnum,
780 qsearch( 'cust_pkg', {
781 'custnum' => $self->custnum,
790 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
796 grep { $_->susp } $self->ncancelled_pkgs;
799 =item unflagged_suspended_pkgs
801 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
802 customer (thouse packages without the `manual_flag' set).
806 sub unflagged_suspended_pkgs {
808 return $self->suspended_pkgs
809 unless dbdef->table('cust_pkg')->column('manual_flag');
810 grep { ! $_->manual_flag } $self->suspended_pkgs;
813 =item unsuspended_pkgs
815 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
820 sub unsuspended_pkgs {
822 grep { ! $_->susp } $self->ncancelled_pkgs;
827 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
828 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
829 on success or a list of errors.
835 grep { $_->unsuspend } $self->suspended_pkgs;
840 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
841 Always returns a list: an empty list on success or a list of errors.
847 grep { $_->suspend } $self->unsuspended_pkgs;
852 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
853 Always returns a list: an empty list on success or a list of errors.
859 grep { $_->cancel } $self->ncancelled_pkgs;
864 Returns the agent (see L<FS::agent>) for this customer.
870 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
875 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
876 conjunction with the collect method.
878 Options are passed as name-value pairs.
880 The only currently available option is `time', which bills the customer as if
881 it were that time. It is specified as a UNIX timestamp; see
882 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
883 functions. For example:
887 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
889 If there is an error, returns the error, otherwise returns false.
894 my( $self, %options ) = @_;
895 my $time = $options{'time'} || time;
900 local $SIG{HUP} = 'IGNORE';
901 local $SIG{INT} = 'IGNORE';
902 local $SIG{QUIT} = 'IGNORE';
903 local $SIG{TERM} = 'IGNORE';
904 local $SIG{TSTP} = 'IGNORE';
905 local $SIG{PIPE} = 'IGNORE';
907 my $oldAutoCommit = $FS::UID::AutoCommit;
908 local $FS::UID::AutoCommit = 0;
911 # find the packages which are due for billing, find out how much they are
912 # & generate invoice database.
914 my( $total_setup, $total_recur ) = ( 0, 0 );
915 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
916 my @cust_bill_pkg = ();
918 #my $taxable_charged = 0;##
923 foreach my $cust_pkg (
924 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
927 #NO!! next if $cust_pkg->cancel;
928 next if $cust_pkg->getfield('cancel');
930 #? to avoid use of uninitialized value errors... ?
931 $cust_pkg->setfield('bill', '')
932 unless defined($cust_pkg->bill);
934 my $part_pkg = $cust_pkg->part_pkg;
936 #so we don't modify cust_pkg record unnecessarily
937 my $cust_pkg_mod_flag = 0;
938 my %hash = $cust_pkg->hash;
939 my $old_cust_pkg = new FS::cust_pkg \%hash;
943 unless ( $cust_pkg->setup ) {
944 my $setup_prog = $part_pkg->getfield('setup');
945 $setup_prog =~ /^(.*)$/ or do {
946 $dbh->rollback if $oldAutoCommit;
947 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
953 ##$cpt->permit(); #what is necessary?
954 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
955 #$setup = $cpt->reval($setup_prog);
956 $setup = eval $setup_prog;
957 unless ( defined($setup) ) {
958 $dbh->rollback if $oldAutoCommit;
959 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
960 "(expression $setup_prog): $@";
962 $cust_pkg->setfield('setup',$time);
963 $cust_pkg_mod_flag=1;
969 if ( $part_pkg->getfield('freq') > 0 &&
970 ! $cust_pkg->getfield('susp') &&
971 ( $cust_pkg->getfield('bill') || 0 ) < $time
973 my $recur_prog = $part_pkg->getfield('recur');
974 $recur_prog =~ /^(.*)$/ or do {
975 $dbh->rollback if $oldAutoCommit;
976 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
981 # shared with $recur_prog
982 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
985 ##$cpt->permit(); #what is necessary?
986 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
987 #$recur = $cpt->reval($recur_prog);
988 $recur = eval $recur_prog;
989 unless ( defined($recur) ) {
990 $dbh->rollback if $oldAutoCommit;
991 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
992 "(expression $recur_prog): $@";
994 #change this bit to use Date::Manip? CAREFUL with timezones (see
995 # mailing list archive)
996 my ($sec,$min,$hour,$mday,$mon,$year) =
997 (localtime($sdate) )[0,1,2,3,4,5];
999 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1000 # only for figuring next bill date, nothing else, so, reset $sdate again
1002 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1004 $mon += $part_pkg->freq;
1005 until ( $mon < 12 ) { $mon -= 12; $year++; }
1006 $cust_pkg->setfield('bill',
1007 timelocal($sec,$min,$hour,$mday,$mon,$year));
1008 $cust_pkg_mod_flag = 1;
1011 warn "\$setup is undefined" unless defined($setup);
1012 warn "\$recur is undefined" unless defined($recur);
1013 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1015 my $taxable_charged = 0;
1016 if ( $cust_pkg_mod_flag ) {
1017 $error=$cust_pkg->replace($old_cust_pkg);
1018 if ( $error ) { #just in case
1019 $dbh->rollback if $oldAutoCommit;
1020 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1022 $setup = sprintf( "%.2f", $setup );
1023 $recur = sprintf( "%.2f", $recur );
1025 $dbh->rollback if $oldAutoCommit;
1026 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1029 $dbh->rollback if $oldAutoCommit;
1030 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1032 if ( $setup > 0 || $recur > 0 ) {
1033 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1034 'pkgnum' => $cust_pkg->pkgnum,
1038 'edate' => $cust_pkg->bill,
1040 push @cust_bill_pkg, $cust_bill_pkg;
1041 $total_setup += $setup;
1042 $total_recur += $recur;
1043 $taxable_charged += $setup
1044 unless $part_pkg->setuptax =~ /^Y$/i;
1045 $taxable_charged += $recur
1046 unless $part_pkg->recurtax =~ /^Y$/i;
1048 unless ( $self->tax =~ /Y/i
1049 || $self->payby eq 'COMP'
1050 || $taxable_charged == 0 ) {
1052 my $cust_main_county =
1053 qsearchs('cust_main_county',{
1054 'state' => $self->state,
1055 'county' => $self->county,
1056 'country' => $self->country,
1057 'taxclass' => $part_pkg->taxclass,
1059 or qsearchs('cust_main_county',{
1060 'state' => $self->state,
1061 'county' => $self->county,
1062 'country' => $self->country,
1066 $dbh->rollback if $oldAutoCommit;
1068 "fatal: can't find tax rate for state/county/country/taxclass ".
1069 join('/', ( map $self->$_(), qw(state county country) ),
1070 $part_pkg->taxclass ). "\n";
1073 if ( $cust_main_county->exempt_amount ) {
1074 my ($mon,$year) = (localtime($sdate) )[4,5];
1076 my $freq = $part_pkg->freq || 1;
1077 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1078 foreach my $which_month ( 1 .. $freq ) {
1080 'custnum' => $self->custnum,
1081 'taxnum' => $cust_main_county->taxnum,
1082 'year' => 1900+$year,
1085 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1086 until ( $mon < 13 ) { $mon -= 12; $year++; }
1087 my $cust_tax_exempt =
1088 qsearchs('cust_tax_exempt', \%hash)
1089 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1090 my $remaining_exemption = sprintf("%.2f",
1091 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1092 if ( $remaining_exemption > 0 ) {
1093 my $addl = $remaining_exemption > $taxable_per_month
1094 ? $taxable_per_month
1095 : $remaining_exemption;
1096 $taxable_charged -= $addl;
1097 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1098 $cust_tax_exempt->hash,
1099 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1101 $error = $new_cust_tax_exempt->exemptnum
1102 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1103 : $new_cust_tax_exempt->insert;
1105 $dbh->rollback if $oldAutoCommit;
1106 return "fatal: can't update cust_tax_exempt: $error";
1109 } # if $remaining_exemption > 0
1111 } #foreach $which_month
1113 } #if $cust_main_county->exempt_amount
1115 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1117 #$tax += $taxable_charged * $cust_main_county->tax / 100
1118 $tax{ $cust_main_county->taxname || 'Tax' } +=
1119 $taxable_charged * $cust_main_county->tax / 100
1121 } #unless $self->tax =~ /Y/i
1122 # || $self->payby eq 'COMP'
1123 # || $taxable_charged == 0
1125 } #if $setup > 0 || $recur > 0
1127 } #if $cust_pkg_mod_flag
1129 } #foreach my $cust_pkg
1131 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1132 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1134 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1135 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1139 # unless ( $self->tax =~ /Y/i
1140 # || $self->payby eq 'COMP'
1141 # || $taxable_charged == 0 ) {
1142 # my $cust_main_county = qsearchs('cust_main_county',{
1143 # 'state' => $self->state,
1144 # 'county' => $self->county,
1145 # 'country' => $self->country,
1146 # } ) or die "fatal: can't find tax rate for state/county/country ".
1147 # $self->state. "/". $self->county. "/". $self->country. "\n";
1148 # my $tax = sprintf( "%.2f",
1149 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1152 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1153 my $tax = sprintf("%.2f", $tax{$taxname} );
1154 $charged = sprintf( "%.2f", $charged+$tax );
1156 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1162 'itemdesc' => $taxname,
1164 push @cust_bill_pkg, $cust_bill_pkg;
1168 my $cust_bill = new FS::cust_bill ( {
1169 'custnum' => $self->custnum,
1171 'charged' => $charged,
1173 $error = $cust_bill->insert;
1175 $dbh->rollback if $oldAutoCommit;
1176 return "can't create invoice for customer #". $self->custnum. ": $error";
1179 my $invnum = $cust_bill->invnum;
1181 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1183 $cust_bill_pkg->invnum($invnum);
1184 $error = $cust_bill_pkg->insert;
1186 $dbh->rollback if $oldAutoCommit;
1187 return "can't create invoice line item for customer #". $self->custnum.
1192 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1196 =item collect OPTIONS
1198 (Attempt to) collect money for this customer's outstanding invoices (see
1199 L<FS::cust_bill>). Usually used after the bill method.
1201 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1202 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1204 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1205 and the invoice events web interface.
1207 If there is an error, returns the error, otherwise returns false.
1209 Options are passed as name-value pairs.
1211 Currently available options are:
1213 invoice_time - Use this time when deciding when to print invoices and
1214 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>
1215 for conversion functions.
1217 retry_card - Retry cards even when not scheduled by invoice events.
1219 batch_card - This option is deprecated. See the invoice events web interface
1220 to control whether cards are batched or run against a realtime gateway.
1222 report_badcard - This option is deprecated.
1224 force_print - This option is deprecated; see the invoice events web interface.
1229 my( $self, %options ) = @_;
1230 my $invoice_time = $options{'invoice_time'} || time;
1233 local $SIG{HUP} = 'IGNORE';
1234 local $SIG{INT} = 'IGNORE';
1235 local $SIG{QUIT} = 'IGNORE';
1236 local $SIG{TERM} = 'IGNORE';
1237 local $SIG{TSTP} = 'IGNORE';
1238 local $SIG{PIPE} = 'IGNORE';
1240 my $oldAutoCommit = $FS::UID::AutoCommit;
1241 local $FS::UID::AutoCommit = 0;
1244 my $balance = $self->balance;
1245 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1246 unless ( $balance > 0 ) { #redundant?????
1247 $dbh->rollback if $oldAutoCommit; #hmm
1251 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1252 #false laziness w/replace
1253 foreach my $cust_bill_event (
1255 #$_->part_bill_event->plan eq 'realtime-card'
1256 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1257 && $_->status eq 'done'
1260 map { $_->cust_bill_event }
1261 grep { $_->cust_bill_event }
1262 $self->open_cust_bill
1264 my $error = $cust_bill_event->retry;
1266 $dbh->rollback if $oldAutoCommit;
1267 return "error scheduling invoice events for retry: $error";
1273 foreach my $cust_bill ( $self->cust_bill ) {
1275 #this has to be before next's
1276 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1280 $balance = sprintf( "%.2f", $balance - $amount );
1282 next unless $cust_bill->owed > 0;
1284 # don't try to charge for the same invoice if it's already in a batch
1285 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1287 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1289 next unless $amount > 0;
1292 foreach my $part_bill_event (
1293 sort { $a->seconds <=> $b->seconds
1294 || $a->weight <=> $b->weight
1295 || $a->eventpart <=> $b->eventpart }
1296 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1297 && ! qsearchs( 'cust_bill_event', {
1298 'invnum' => $cust_bill->invnum,
1299 'eventpart' => $_->eventpart,
1303 qsearch('part_bill_event', { 'payby' => $self->payby,
1304 'disabled' => '', } )
1307 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1309 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1311 my $cust_main = $self; #for callback
1312 my $error = eval $part_bill_event->eventcode;
1315 my $statustext = '';
1319 } elsif ( $error ) {
1321 $statustext = $error;
1326 #add cust_bill_event
1327 my $cust_bill_event = new FS::cust_bill_event {
1328 'invnum' => $cust_bill->invnum,
1329 'eventpart' => $part_bill_event->eventpart,
1330 '_date' => $invoice_time,
1331 'status' => $status,
1332 'statustext' => $statustext,
1334 $error = $cust_bill_event->insert;
1336 #$dbh->rollback if $oldAutoCommit;
1337 #return "error: $error";
1339 # gah, even with transactions.
1340 $dbh->commit if $oldAutoCommit; #well.
1341 my $e = 'WARNING: Event run but database not updated - '.
1342 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1343 ', eventpart '. $part_bill_event->eventpart.
1354 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1361 Returns the total owed for this customer on all invoices
1362 (see L<FS::cust_bill/owed>).
1368 $self->total_owed_date(2145859200); #12/31/2037
1371 =item total_owed_date TIME
1373 Returns the total owed for this customer on all invoices with date earlier than
1374 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1375 see L<Time::Local> and L<Date::Parse> for conversion functions.
1379 sub total_owed_date {
1383 foreach my $cust_bill (
1384 grep { $_->_date <= $time }
1385 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1387 $total_bill += $cust_bill->owed;
1389 sprintf( "%.2f", $total_bill );
1394 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1395 to outstanding invoice balances in chronological order and returns the value
1396 of any remaining unapplied credits available for refund
1397 (see L<FS::cust_refund>).
1404 return 0 unless $self->total_credited;
1406 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1407 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1409 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1410 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1414 foreach my $cust_bill ( @invoices ) {
1417 if ( !defined($credit) || $credit->credited == 0) {
1418 $credit = pop @credits or last;
1421 if ($cust_bill->owed >= $credit->credited) {
1422 $amount=$credit->credited;
1424 $amount=$cust_bill->owed;
1427 my $cust_credit_bill = new FS::cust_credit_bill ( {
1428 'crednum' => $credit->crednum,
1429 'invnum' => $cust_bill->invnum,
1430 'amount' => $amount,
1432 my $error = $cust_credit_bill->insert;
1433 die $error if $error;
1435 redo if ($cust_bill->owed > 0);
1439 return $self->total_credited;
1442 =item apply_payments
1444 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1445 to outstanding invoice balances in chronological order.
1447 #and returns the value of any remaining unapplied payments.
1451 sub apply_payments {
1456 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1457 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1459 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1460 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1464 foreach my $cust_bill ( @invoices ) {
1467 if ( !defined($payment) || $payment->unapplied == 0 ) {
1468 $payment = pop @payments or last;
1471 if ( $cust_bill->owed >= $payment->unapplied ) {
1472 $amount = $payment->unapplied;
1474 $amount = $cust_bill->owed;
1477 my $cust_bill_pay = new FS::cust_bill_pay ( {
1478 'paynum' => $payment->paynum,
1479 'invnum' => $cust_bill->invnum,
1480 'amount' => $amount,
1482 my $error = $cust_bill_pay->insert;
1483 die $error if $error;
1485 redo if ( $cust_bill->owed > 0);
1489 return $self->total_unapplied_payments;
1492 =item total_credited
1494 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1495 customer. See L<FS::cust_credit/credited>.
1499 sub total_credited {
1501 my $total_credit = 0;
1502 foreach my $cust_credit ( qsearch('cust_credit', {
1503 'custnum' => $self->custnum,
1505 $total_credit += $cust_credit->credited;
1507 sprintf( "%.2f", $total_credit );
1510 =item total_unapplied_payments
1512 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1513 See L<FS::cust_pay/unapplied>.
1517 sub total_unapplied_payments {
1519 my $total_unapplied = 0;
1520 foreach my $cust_pay ( qsearch('cust_pay', {
1521 'custnum' => $self->custnum,
1523 $total_unapplied += $cust_pay->unapplied;
1525 sprintf( "%.2f", $total_unapplied );
1530 Returns the balance for this customer (total_owed minus total_credited
1531 minus total_unapplied_payments).
1538 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1542 =item balance_date TIME
1544 Returns the balance for this customer, only considering invoices with date
1545 earlier than TIME (total_owed_date minus total_credited minus
1546 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1547 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1556 $self->total_owed_date($time)
1557 - $self->total_credited
1558 - $self->total_unapplied_payments
1562 =item invoicing_list [ ARRAYREF ]
1564 If an arguement is given, sets these email addresses as invoice recipients
1565 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1566 (except as warnings), so use check_invoicing_list first.
1568 Returns a list of email addresses (with svcnum entries expanded).
1570 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1571 check it without disturbing anything by passing nothing.
1573 This interface may change in the future.
1577 sub invoicing_list {
1578 my( $self, $arrayref ) = @_;
1580 my @cust_main_invoice;
1581 if ( $self->custnum ) {
1582 @cust_main_invoice =
1583 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1585 @cust_main_invoice = ();
1587 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1588 #warn $cust_main_invoice->destnum;
1589 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1590 #warn $cust_main_invoice->destnum;
1591 my $error = $cust_main_invoice->delete;
1592 warn $error if $error;
1595 if ( $self->custnum ) {
1596 @cust_main_invoice =
1597 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1599 @cust_main_invoice = ();
1601 my %seen = map { $_->address => 1 } @cust_main_invoice;
1602 foreach my $address ( @{$arrayref} ) {
1603 next if exists $seen{$address} && $seen{$address};
1604 $seen{$address} = 1;
1605 my $cust_main_invoice = new FS::cust_main_invoice ( {
1606 'custnum' => $self->custnum,
1609 my $error = $cust_main_invoice->insert;
1610 warn $error if $error;
1613 if ( $self->custnum ) {
1615 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1621 =item check_invoicing_list ARRAYREF
1623 Checks these arguements as valid input for the invoicing_list method. If there
1624 is an error, returns the error, otherwise returns false.
1628 sub check_invoicing_list {
1629 my( $self, $arrayref ) = @_;
1630 foreach my $address ( @{$arrayref} ) {
1631 my $cust_main_invoice = new FS::cust_main_invoice ( {
1632 'custnum' => $self->custnum,
1635 my $error = $self->custnum
1636 ? $cust_main_invoice->check
1637 : $cust_main_invoice->checkdest
1639 return $error if $error;
1644 =item set_default_invoicing_list
1646 Sets the invoicing list to all accounts associated with this customer,
1647 overwriting any previous invoicing list.
1651 sub set_default_invoicing_list {
1653 $self->invoicing_list($self->all_emails);
1658 Returns the email addresses of all accounts provisioned for this customer.
1665 foreach my $cust_pkg ( $self->all_pkgs ) {
1666 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1668 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1669 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1671 $list{$_}=1 foreach map { $_->email } @svc_acct;
1676 =item invoicing_list_addpost
1678 Adds postal invoicing to this customer. If this customer is already configured
1679 to receive postal invoices, does nothing.
1683 sub invoicing_list_addpost {
1685 return if grep { $_ eq 'POST' } $self->invoicing_list;
1686 my @invoicing_list = $self->invoicing_list;
1687 push @invoicing_list, 'POST';
1688 $self->invoicing_list(\@invoicing_list);
1691 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1693 Returns an array of customers referred by this customer (referral_custnum set
1694 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1695 customers referred by customers referred by this customer and so on, inclusive.
1696 The default behavior is DEPTH 1 (no recursion).
1700 sub referral_cust_main {
1702 my $depth = @_ ? shift : 1;
1703 my $exclude = @_ ? shift : {};
1706 map { $exclude->{$_->custnum}++; $_; }
1707 grep { ! $exclude->{ $_->custnum } }
1708 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1712 map { $_->referral_cust_main($depth-1, $exclude) }
1719 =item referral_cust_main_ncancelled
1721 Same as referral_cust_main, except only returns customers with uncancelled
1726 sub referral_cust_main_ncancelled {
1728 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1731 =item referral_cust_pkg [ DEPTH ]
1733 Like referral_cust_main, except returns a flat list of all unsuspended (and
1734 uncancelled) packages for each customer. The number of items in this list may
1735 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1739 sub referral_cust_pkg {
1741 my $depth = @_ ? shift : 1;
1743 map { $_->unsuspended_pkgs }
1744 grep { $_->unsuspended_pkgs }
1745 $self->referral_cust_main($depth);
1748 =item credit AMOUNT, REASON
1750 Applies a credit to this customer. If there is an error, returns the error,
1751 otherwise returns false.
1756 my( $self, $amount, $reason ) = @_;
1757 my $cust_credit = new FS::cust_credit {
1758 'custnum' => $self->custnum,
1759 'amount' => $amount,
1760 'reason' => $reason,
1762 $cust_credit->insert;
1765 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1767 Creates a one-time charge for this customer. If there is an error, returns
1768 the error, otherwise returns false.
1773 my ( $self, $amount ) = ( shift, shift );
1774 my $pkg = @_ ? shift : 'One-time charge';
1775 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1776 my $taxclass = @_ ? shift : '';
1778 local $SIG{HUP} = 'IGNORE';
1779 local $SIG{INT} = 'IGNORE';
1780 local $SIG{QUIT} = 'IGNORE';
1781 local $SIG{TERM} = 'IGNORE';
1782 local $SIG{TSTP} = 'IGNORE';
1783 local $SIG{PIPE} = 'IGNORE';
1785 my $oldAutoCommit = $FS::UID::AutoCommit;
1786 local $FS::UID::AutoCommit = 0;
1789 my $part_pkg = new FS::part_pkg ( {
1791 'comment' => $comment,
1796 'taxclass' => $taxclass,
1799 my $error = $part_pkg->insert;
1801 $dbh->rollback if $oldAutoCommit;
1805 my $pkgpart = $part_pkg->pkgpart;
1806 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1807 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1808 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1809 $error = $type_pkgs->insert;
1811 $dbh->rollback if $oldAutoCommit;
1816 my $cust_pkg = new FS::cust_pkg ( {
1817 'custnum' => $self->custnum,
1818 'pkgpart' => $pkgpart,
1821 $error = $cust_pkg->insert;
1823 $dbh->rollback if $oldAutoCommit;
1827 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1834 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1840 sort { $a->_date <=> $b->_date }
1841 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1844 =item open_cust_bill
1846 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1851 sub open_cust_bill {
1853 grep { $_->owed > 0 } $self->cust_bill;
1862 =item check_and_rebuild_fuzzyfiles
1866 sub check_and_rebuild_fuzzyfiles {
1867 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1868 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1869 or &rebuild_fuzzyfiles;
1872 =item rebuild_fuzzyfiles
1876 sub rebuild_fuzzyfiles {
1878 use Fcntl qw(:flock);
1880 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1884 open(LASTLOCK,">>$dir/cust_main.last")
1885 or die "can't open $dir/cust_main.last: $!";
1886 flock(LASTLOCK,LOCK_EX)
1887 or die "can't lock $dir/cust_main.last: $!";
1889 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1891 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1892 if defined dbdef->table('cust_main')->column('ship_last');
1894 open (LASTCACHE,">$dir/cust_main.last.tmp")
1895 or die "can't open $dir/cust_main.last.tmp: $!";
1896 print LASTCACHE join("\n", @all_last), "\n";
1897 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1899 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1904 open(COMPANYLOCK,">>$dir/cust_main.company")
1905 or die "can't open $dir/cust_main.company: $!";
1906 flock(COMPANYLOCK,LOCK_EX)
1907 or die "can't lock $dir/cust_main.company: $!";
1909 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1911 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1912 if defined dbdef->table('cust_main')->column('ship_last');
1914 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1915 or die "can't open $dir/cust_main.company.tmp: $!";
1916 print COMPANYCACHE join("\n", @all_company), "\n";
1917 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1919 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1929 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1930 open(LASTCACHE,"<$dir/cust_main.last")
1931 or die "can't open $dir/cust_main.last: $!";
1932 my @array = map { chomp; $_; } <LASTCACHE>;
1942 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1943 open(COMPANYCACHE,"<$dir/cust_main.company")
1944 or die "can't open $dir/cust_main.last: $!";
1945 my @array = map { chomp; $_; } <COMPANYCACHE>;
1950 =item append_fuzzyfiles LASTNAME COMPANY
1954 sub append_fuzzyfiles {
1955 my( $last, $company ) = @_;
1957 &check_and_rebuild_fuzzyfiles;
1959 use Fcntl qw(:flock);
1961 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1965 open(LAST,">>$dir/cust_main.last")
1966 or die "can't open $dir/cust_main.last: $!";
1968 or die "can't lock $dir/cust_main.last: $!";
1970 print LAST "$last\n";
1973 or die "can't unlock $dir/cust_main.last: $!";
1979 open(COMPANY,">>$dir/cust_main.company")
1980 or die "can't open $dir/cust_main.company: $!";
1981 flock(COMPANY,LOCK_EX)
1982 or die "can't lock $dir/cust_main.company: $!";
1984 print COMPANY "$company\n";
1986 flock(COMPANY,LOCK_UN)
1987 or die "can't unlock $dir/cust_main.company: $!";
2001 #warn join('-',keys %$param);
2002 my $fh = $param->{filehandle};
2003 my $agentnum = $param->{agentnum};
2004 my $refnum = $param->{refnum};
2005 my $pkgpart = $param->{pkgpart};
2006 my @fields = @{$param->{fields}};
2008 eval "use Date::Parse;";
2010 eval "use Text::CSV_XS;";
2013 my $csv = new Text::CSV_XS;
2020 local $SIG{HUP} = 'IGNORE';
2021 local $SIG{INT} = 'IGNORE';
2022 local $SIG{QUIT} = 'IGNORE';
2023 local $SIG{TERM} = 'IGNORE';
2024 local $SIG{TSTP} = 'IGNORE';
2025 local $SIG{PIPE} = 'IGNORE';
2027 my $oldAutoCommit = $FS::UID::AutoCommit;
2028 local $FS::UID::AutoCommit = 0;
2031 #while ( $columns = $csv->getline($fh) ) {
2033 while ( defined($line=<$fh>) ) {
2035 $csv->parse($line) or do {
2036 $dbh->rollback if $oldAutoCommit;
2037 return "can't parse: ". $csv->error_input();
2040 my @columns = $csv->fields();
2041 #warn join('-',@columns);
2044 agentnum => $agentnum,
2046 country => 'US', #default
2047 payby => 'BILL', #default
2048 paydate => '12/2037', #default
2050 my $billtime = time;
2051 my %cust_pkg = ( pkgpart => $pkgpart );
2052 foreach my $field ( @fields ) {
2053 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2054 #$cust_pkg{$1} = str2time( shift @$columns );
2055 if ( $1 eq 'setup' ) {
2056 $billtime = str2time(shift @columns);
2058 $cust_pkg{$1} = str2time( shift @columns );
2061 #$cust_main{$field} = shift @$columns;
2062 $cust_main{$field} = shift @columns;
2066 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2067 my $cust_main = new FS::cust_main ( \%cust_main );
2069 tie my %hash, 'Tie::RefHash'; #this part is important
2070 $hash{$cust_pkg} = [] if $pkgpart;
2071 my $error = $cust_main->insert( \%hash );
2074 $dbh->rollback if $oldAutoCommit;
2075 return "can't insert customer for $line: $error";
2078 #false laziness w/bill.cgi
2079 $error = $cust_main->bill( 'time' => $billtime );
2081 $dbh->rollback if $oldAutoCommit;
2082 return "can't bill customer for $line: $error";
2085 $cust_main->apply_payments;
2086 $cust_main->apply_credits;
2088 $error = $cust_main->collect();
2090 $dbh->rollback if $oldAutoCommit;
2091 return "can't collect customer for $line: $error";
2097 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2099 return "Empty file!" unless $imported;
2111 #warn join('-',keys %$param);
2112 my $fh = $param->{filehandle};
2113 my @fields = @{$param->{fields}};
2115 eval "use Date::Parse;";
2117 eval "use Text::CSV_XS;";
2120 my $csv = new Text::CSV_XS;
2127 local $SIG{HUP} = 'IGNORE';
2128 local $SIG{INT} = 'IGNORE';
2129 local $SIG{QUIT} = 'IGNORE';
2130 local $SIG{TERM} = 'IGNORE';
2131 local $SIG{TSTP} = 'IGNORE';
2132 local $SIG{PIPE} = 'IGNORE';
2134 my $oldAutoCommit = $FS::UID::AutoCommit;
2135 local $FS::UID::AutoCommit = 0;
2138 #while ( $columns = $csv->getline($fh) ) {
2140 while ( defined($line=<$fh>) ) {
2142 $csv->parse($line) or do {
2143 $dbh->rollback if $oldAutoCommit;
2144 return "can't parse: ". $csv->error_input();
2147 my @columns = $csv->fields();
2148 #warn join('-',@columns);
2151 foreach my $field ( @fields ) {
2152 $row{$field} = shift @columns;
2155 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2156 unless ( $cust_main ) {
2157 $dbh->rollback if $oldAutoCommit;
2158 return "unknown custnum $row{'custnum'}";
2161 if ( $row{'amount'} > 0 ) {
2162 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2164 $dbh->rollback if $oldAutoCommit;
2168 } elsif ( $row{'amount'} < 0 ) {
2169 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2172 $dbh->rollback if $oldAutoCommit;
2182 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2184 return "Empty file!" unless $imported;
2196 The delete method should possibly take an FS::cust_main object reference
2197 instead of a scalar customer number.
2199 Bill and collect options should probably be passed as references instead of a
2202 There should probably be a configuration file with a list of allowed credit
2205 No multiple currency support (probably a larger project than just this module).
2209 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2210 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2211 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.