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)
183 Creates a new customer. To add the customer to the database, see L<"insert">.
185 Note that this stores the hash reference, not a distinct copy of the hash it
186 points to. You can ask the object for a copy with the I<hash> method.
190 sub table { 'cust_main'; }
192 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
194 Adds this customer to the database. If there is an error, returns the error,
195 otherwise returns false.
197 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
198 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
199 are inserted atomicly, or the transaction is rolled back. Passing an empty
200 hash reference is equivalent to not supplying this parameter. There should be
201 a better explanation of this, but until then, here's an example:
204 tie %hash, 'Tie::RefHash'; #this part is important
206 $cust_pkg => [ $svc_acct ],
209 $cust_main->insert( \%hash );
211 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
212 be set as the invoicing list (see L<"invoicing_list">). Errors return as
213 expected and rollback the entire transaction; it is not necessary to call
214 check_invoicing_list first. The invoicing_list is set after the records in the
215 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
216 invoicing_list destination to the newly-created svc_acct. Here's an example:
218 $cust_main->insert( {}, [ $email, 'POST' ] );
224 my $cust_pkgs = @_ ? shift : {};
225 my $invoicing_list = @_ ? shift : '';
227 local $SIG{HUP} = 'IGNORE';
228 local $SIG{INT} = 'IGNORE';
229 local $SIG{QUIT} = 'IGNORE';
230 local $SIG{TERM} = 'IGNORE';
231 local $SIG{TSTP} = 'IGNORE';
232 local $SIG{PIPE} = 'IGNORE';
234 my $oldAutoCommit = $FS::UID::AutoCommit;
235 local $FS::UID::AutoCommit = 0;
240 if ( $self->payby eq 'PREPAY' ) {
241 $self->payby('BILL');
242 my $prepay_credit = qsearchs(
244 { 'identifier' => $self->payinfo },
248 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
249 unless $prepay_credit;
250 $amount = $prepay_credit->amount;
251 $seconds = $prepay_credit->seconds;
252 my $error = $prepay_credit->delete;
254 $dbh->rollback if $oldAutoCommit;
255 return "removing prepay_credit (transaction rolled back): $error";
259 my $error = $self->SUPER::insert;
261 $dbh->rollback if $oldAutoCommit;
262 #return "inserting cust_main record (transaction rolled back): $error";
267 if ( $invoicing_list ) {
268 $error = $self->check_invoicing_list( $invoicing_list );
270 $dbh->rollback if $oldAutoCommit;
271 return "checking invoicing_list (transaction rolled back): $error";
273 $self->invoicing_list( $invoicing_list );
277 foreach my $cust_pkg ( keys %$cust_pkgs ) {
278 $cust_pkg->custnum( $self->custnum );
279 $error = $cust_pkg->insert;
281 $dbh->rollback if $oldAutoCommit;
282 return "inserting cust_pkg (transaction rolled back): $error";
284 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
285 $svc_something->pkgnum( $cust_pkg->pkgnum );
286 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
287 $svc_something->seconds( $svc_something->seconds + $seconds );
290 $error = $svc_something->insert;
292 $dbh->rollback if $oldAutoCommit;
293 #return "inserting svc_ (transaction rolled back): $error";
300 $dbh->rollback if $oldAutoCommit;
301 return "No svc_acct record to apply pre-paid time";
305 my $cust_credit = new FS::cust_credit {
306 'custnum' => $self->custnum,
309 $error = $cust_credit->insert;
311 $dbh->rollback if $oldAutoCommit;
312 return "inserting credit (transaction rolled back): $error";
316 #false laziness with sub replace
317 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
318 $error = $queue->insert($self->getfield('last'), $self->company);
320 $dbh->rollback if $oldAutoCommit;
321 return "queueing job (transaction rolled back): $error";
324 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
325 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
326 $error = $queue->insert($self->getfield('last'), $self->company);
328 $dbh->rollback if $oldAutoCommit;
329 return "queueing job (transaction rolled back): $error";
334 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
339 =item delete NEW_CUSTNUM
341 This deletes the customer. If there is an error, returns the error, otherwise
344 This will completely remove all traces of the customer record. This is not
345 what you want when a customer cancels service; for that, cancel all of the
346 customer's packages (see L<FS::cust_pkg/cancel>).
348 If the customer has any uncancelled packages, you need to pass a new (valid)
349 customer number for those packages to be transferred to. Cancelled packages
350 will be deleted. Did I mention that this is NOT what you want when a customer
351 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
353 You can't delete a customer with invoices (see L<FS::cust_bill>),
354 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
355 refunds (see L<FS::cust_refund>).
362 local $SIG{HUP} = 'IGNORE';
363 local $SIG{INT} = 'IGNORE';
364 local $SIG{QUIT} = 'IGNORE';
365 local $SIG{TERM} = 'IGNORE';
366 local $SIG{TSTP} = 'IGNORE';
367 local $SIG{PIPE} = 'IGNORE';
369 my $oldAutoCommit = $FS::UID::AutoCommit;
370 local $FS::UID::AutoCommit = 0;
373 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
374 $dbh->rollback if $oldAutoCommit;
375 return "Can't delete a customer with invoices";
377 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
378 $dbh->rollback if $oldAutoCommit;
379 return "Can't delete a customer with credits";
381 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Can't delete a customer with payments";
385 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
386 $dbh->rollback if $oldAutoCommit;
387 return "Can't delete a customer with refunds";
390 my @cust_pkg = $self->ncancelled_pkgs;
392 my $new_custnum = shift;
393 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
394 $dbh->rollback if $oldAutoCommit;
395 return "Invalid new customer number: $new_custnum";
397 foreach my $cust_pkg ( @cust_pkg ) {
398 my %hash = $cust_pkg->hash;
399 $hash{'custnum'} = $new_custnum;
400 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
401 my $error = $new_cust_pkg->replace($cust_pkg);
403 $dbh->rollback if $oldAutoCommit;
408 my @cancelled_cust_pkg = $self->all_pkgs;
409 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
410 my $error = $cust_pkg->delete;
412 $dbh->rollback if $oldAutoCommit;
417 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
418 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
420 my $error = $cust_main_invoice->delete;
422 $dbh->rollback if $oldAutoCommit;
427 my $error = $self->SUPER::delete;
429 $dbh->rollback if $oldAutoCommit;
433 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
438 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
440 Replaces the OLD_RECORD with this one in the database. If there is an error,
441 returns the error, otherwise returns false.
443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
444 be set as the invoicing list (see L<"invoicing_list">). Errors return as
445 expected and rollback the entire transaction; it is not necessary to call
446 check_invoicing_list first. Here's an example:
448 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
457 local $SIG{HUP} = 'IGNORE';
458 local $SIG{INT} = 'IGNORE';
459 local $SIG{QUIT} = 'IGNORE';
460 local $SIG{TERM} = 'IGNORE';
461 local $SIG{TSTP} = 'IGNORE';
462 local $SIG{PIPE} = 'IGNORE';
464 my $oldAutoCommit = $FS::UID::AutoCommit;
465 local $FS::UID::AutoCommit = 0;
468 my $error = $self->SUPER::replace($old);
471 $dbh->rollback if $oldAutoCommit;
475 if ( @param ) { # INVOICING_LIST_ARYREF
476 my $invoicing_list = shift @param;
477 $error = $self->check_invoicing_list( $invoicing_list );
479 $dbh->rollback if $oldAutoCommit;
482 $self->invoicing_list( $invoicing_list );
485 if ( $self->payby =~ /^(CARD|CHEK)$/ &&
486 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
487 # card/check info has changed, want to retry realtime_card invoice events
488 #false laziness w/collect
489 foreach my $cust_bill_event (
491 #$_->part_bill_event->plan eq 'realtime-card'
492 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
493 && $_->status eq 'done'
496 map { $_->cust_bill_event }
497 grep { $_->cust_bill_event }
498 $self->open_cust_bill
501 my $error = $cust_bill_event->retry;
503 $dbh->rollback if $oldAutoCommit;
504 return "error scheduling invoice events for retry: $error";
511 #false laziness with sub insert
512 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
513 $error = $queue->insert($self->getfield('last'), $self->company);
515 $dbh->rollback if $oldAutoCommit;
516 return "queueing job (transaction rolled back): $error";
519 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
520 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
521 $error = $queue->insert($self->getfield('last'), $self->company);
523 $dbh->rollback if $oldAutoCommit;
524 return "queueing job (transaction rolled back): $error";
529 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
536 Checks all fields to make sure this is a valid customer record. If there is
537 an error, returns the error, otherwise returns false. Called by the insert
545 #warn "BEFORE: \n". $self->_dump;
548 $self->ut_numbern('custnum')
549 || $self->ut_number('agentnum')
550 || $self->ut_number('refnum')
551 || $self->ut_name('last')
552 || $self->ut_name('first')
553 || $self->ut_textn('company')
554 || $self->ut_text('address1')
555 || $self->ut_textn('address2')
556 || $self->ut_text('city')
557 || $self->ut_textn('county')
558 || $self->ut_textn('state')
559 || $self->ut_country('country')
560 || $self->ut_anything('comments')
561 || $self->ut_numbern('referral_custnum')
563 #barf. need message catalogs. i18n. etc.
564 $error .= "Please select a advertising source."
565 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
566 return $error if $error;
568 return "Unknown agent"
569 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
571 return "Unknown refnum"
572 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
574 return "Unknown referring custnum ". $self->referral_custnum
575 unless ! $self->referral_custnum
576 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
578 if ( $self->ss eq '' ) {
583 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
584 or return "Illegal social security number: ". $self->ss;
585 $self->ss("$1-$2-$3");
589 # bad idea to disable, causes billing to fail because of no tax rates later
590 # unless ( $import ) {
591 unless ( qsearchs('cust_main_county', {
592 'country' => $self->country,
595 return "Unknown state/county/country: ".
596 $self->state. "/". $self->county. "/". $self->country
597 unless qsearchs('cust_main_county',{
598 'state' => $self->state,
599 'county' => $self->county,
600 'country' => $self->country,
606 $self->ut_phonen('daytime', $self->country)
607 || $self->ut_phonen('night', $self->country)
608 || $self->ut_phonen('fax', $self->country)
609 || $self->ut_zip('zip', $self->country)
611 return $error if $error;
614 last first company address1 address2 city county state zip
615 country daytime night fax
618 if ( defined $self->dbdef_table->column('ship_last') ) {
619 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
621 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
625 $self->ut_name('ship_last')
626 || $self->ut_name('ship_first')
627 || $self->ut_textn('ship_company')
628 || $self->ut_text('ship_address1')
629 || $self->ut_textn('ship_address2')
630 || $self->ut_text('ship_city')
631 || $self->ut_textn('ship_county')
632 || $self->ut_textn('ship_state')
633 || $self->ut_country('ship_country')
635 return $error if $error;
637 #false laziness with above
638 unless ( qsearchs('cust_main_county', {
639 'country' => $self->ship_country,
642 return "Unknown ship_state/ship_county/ship_country: ".
643 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
644 unless qsearchs('cust_main_county',{
645 'state' => $self->ship_state,
646 'county' => $self->ship_county,
647 'country' => $self->ship_country,
653 $self->ut_phonen('ship_daytime', $self->ship_country)
654 || $self->ut_phonen('ship_night', $self->ship_country)
655 || $self->ut_phonen('ship_fax', $self->ship_country)
656 || $self->ut_zip('ship_zip', $self->ship_country)
658 return $error if $error;
660 } else { # ship_ info eq billing info, so don't store dup info in database
661 $self->setfield("ship_$_", '')
662 foreach qw( last first company address1 address2 city county state zip
663 country daytime night fax );
667 $self->payby =~ /^(CARD|CHEK|BILL|COMP|PREPAY)$/
668 or return "Illegal payby: ". $self->payby;
671 if ( $self->payby eq 'CARD' ) {
673 my $payinfo = $self->payinfo;
675 $payinfo =~ /^(\d{13,16})$/
676 or return gettext('invalid_card'); # . ": ". $self->payinfo;
678 $self->payinfo($payinfo);
680 or return gettext('invalid_card'); # . ": ". $self->payinfo;
681 return gettext('unknown_card_type')
682 if cardtype($self->payinfo) eq "Unknown";
684 } elsif ( $self->payby eq 'CHEK' ) {
686 my $payinfo = $self->payinfo;
687 $payinfo =~ s/[\D\@]//g;
688 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
690 $self->payinfo($payinfo);
692 } elsif ( $self->payby eq 'BILL' ) {
694 $error = $self->ut_textn('payinfo');
695 return "Illegal P.O. number: ". $self->payinfo if $error;
697 } elsif ( $self->payby eq 'COMP' ) {
699 $error = $self->ut_textn('payinfo');
700 return "Illegal comp account issuer: ". $self->payinfo if $error;
702 } elsif ( $self->payby eq 'PREPAY' ) {
704 my $payinfo = $self->payinfo;
705 $payinfo =~ s/\W//g; #anything else would just confuse things
706 $self->payinfo($payinfo);
707 $error = $self->ut_alpha('payinfo');
708 return "Illegal prepayment identifier: ". $self->payinfo if $error;
709 return "Unknown prepayment identifier"
710 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
714 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
715 return "Expriation date required"
716 unless $self->payby =~ /^(BILL|PREPAY|CHEK)$/;
719 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
720 or return "Illegal expiration date: ". $self->paydate;
721 my $y = length($2) == 4 ? $2 : "20$2";
722 $self->paydate("$y-$1-01");
723 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
724 return gettext('expired_card')
725 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
728 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
729 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
730 $self->payname( $self->first. " ". $self->getfield('last') );
732 $self->payname =~ /^([\w \,\.\-\']+)$/
733 or return gettext('illegal_name'). " payname: ". $self->payname;
737 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
740 $self->otaker(getotaker);
742 #warn "AFTER: \n". $self->_dump;
749 Returns all packages (see L<FS::cust_pkg>) for this customer.
755 if ( $self->{'_pkgnum'} ) {
756 values %{ $self->{'_pkgnum'}->cache };
758 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
762 =item ncancelled_pkgs
764 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
768 sub ncancelled_pkgs {
770 if ( $self->{'_pkgnum'} ) {
771 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
773 @{ [ # force list context
774 qsearch( 'cust_pkg', {
775 'custnum' => $self->custnum,
778 qsearch( 'cust_pkg', {
779 'custnum' => $self->custnum,
788 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
794 grep { $_->susp } $self->ncancelled_pkgs;
797 =item unflagged_suspended_pkgs
799 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
800 customer (thouse packages without the `manual_flag' set).
804 sub unflagged_suspended_pkgs {
806 return $self->suspended_pkgs
807 unless dbdef->table('cust_pkg')->column('manual_flag');
808 grep { ! $_->manual_flag } $self->suspended_pkgs;
811 =item unsuspended_pkgs
813 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
818 sub unsuspended_pkgs {
820 grep { ! $_->susp } $self->ncancelled_pkgs;
825 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
826 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
827 on success or a list of errors.
833 grep { $_->unsuspend } $self->suspended_pkgs;
838 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
839 Always returns a list: an empty list on success or a list of errors.
845 grep { $_->suspend } $self->unsuspended_pkgs;
850 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
851 Always returns a list: an empty list on success or a list of errors.
857 grep { $_->cancel } $self->ncancelled_pkgs;
862 Returns the agent (see L<FS::agent>) for this customer.
868 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
873 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
874 conjunction with the collect method.
876 Options are passed as name-value pairs.
878 The only currently available option is `time', which bills the customer as if
879 it were that time. It is specified as a UNIX timestamp; see
880 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
881 functions. For example:
885 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
887 If there is an error, returns the error, otherwise returns false.
892 my( $self, %options ) = @_;
893 my $time = $options{'time'} || time;
898 local $SIG{HUP} = 'IGNORE';
899 local $SIG{INT} = 'IGNORE';
900 local $SIG{QUIT} = 'IGNORE';
901 local $SIG{TERM} = 'IGNORE';
902 local $SIG{TSTP} = 'IGNORE';
903 local $SIG{PIPE} = 'IGNORE';
905 my $oldAutoCommit = $FS::UID::AutoCommit;
906 local $FS::UID::AutoCommit = 0;
909 # find the packages which are due for billing, find out how much they are
910 # & generate invoice database.
912 my( $total_setup, $total_recur ) = ( 0, 0 );
913 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
914 my @cust_bill_pkg = ();
916 #my $taxable_charged = 0;##
921 foreach my $cust_pkg (
922 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
925 #NO!! next if $cust_pkg->cancel;
926 next if $cust_pkg->getfield('cancel');
928 #? to avoid use of uninitialized value errors... ?
929 $cust_pkg->setfield('bill', '')
930 unless defined($cust_pkg->bill);
932 my $part_pkg = $cust_pkg->part_pkg;
934 #so we don't modify cust_pkg record unnecessarily
935 my $cust_pkg_mod_flag = 0;
936 my %hash = $cust_pkg->hash;
937 my $old_cust_pkg = new FS::cust_pkg \%hash;
941 unless ( $cust_pkg->setup ) {
942 my $setup_prog = $part_pkg->getfield('setup');
943 $setup_prog =~ /^(.*)$/ or do {
944 $dbh->rollback if $oldAutoCommit;
945 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
951 ##$cpt->permit(); #what is necessary?
952 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
953 #$setup = $cpt->reval($setup_prog);
954 $setup = eval $setup_prog;
955 unless ( defined($setup) ) {
956 $dbh->rollback if $oldAutoCommit;
957 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
958 "(expression $setup_prog): $@";
960 $cust_pkg->setfield('setup',$time);
961 $cust_pkg_mod_flag=1;
967 if ( $part_pkg->getfield('freq') > 0 &&
968 ! $cust_pkg->getfield('susp') &&
969 ( $cust_pkg->getfield('bill') || 0 ) < $time
971 my $recur_prog = $part_pkg->getfield('recur');
972 $recur_prog =~ /^(.*)$/ or do {
973 $dbh->rollback if $oldAutoCommit;
974 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
979 # shared with $recur_prog
980 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
983 ##$cpt->permit(); #what is necessary?
984 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
985 #$recur = $cpt->reval($recur_prog);
986 $recur = eval $recur_prog;
987 unless ( defined($recur) ) {
988 $dbh->rollback if $oldAutoCommit;
989 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
990 "(expression $recur_prog): $@";
992 #change this bit to use Date::Manip? CAREFUL with timezones (see
993 # mailing list archive)
994 my ($sec,$min,$hour,$mday,$mon,$year) =
995 (localtime($sdate) )[0,1,2,3,4,5];
997 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
998 # only for figuring next bill date, nothing else, so, reset $sdate again
1000 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1002 $mon += $part_pkg->freq;
1003 until ( $mon < 12 ) { $mon -= 12; $year++; }
1004 $cust_pkg->setfield('bill',
1005 timelocal($sec,$min,$hour,$mday,$mon,$year));
1006 $cust_pkg_mod_flag = 1;
1009 warn "\$setup is undefined" unless defined($setup);
1010 warn "\$recur is undefined" unless defined($recur);
1011 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1013 my $taxable_charged = 0;
1014 if ( $cust_pkg_mod_flag ) {
1015 $error=$cust_pkg->replace($old_cust_pkg);
1016 if ( $error ) { #just in case
1017 $dbh->rollback if $oldAutoCommit;
1018 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1020 $setup = sprintf( "%.2f", $setup );
1021 $recur = sprintf( "%.2f", $recur );
1023 $dbh->rollback if $oldAutoCommit;
1024 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1027 $dbh->rollback if $oldAutoCommit;
1028 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1030 if ( $setup > 0 || $recur > 0 ) {
1031 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1032 'pkgnum' => $cust_pkg->pkgnum,
1036 'edate' => $cust_pkg->bill,
1038 push @cust_bill_pkg, $cust_bill_pkg;
1039 $total_setup += $setup;
1040 $total_recur += $recur;
1041 $taxable_charged += $setup
1042 unless $part_pkg->setuptax =~ /^Y$/i;
1043 $taxable_charged += $recur
1044 unless $part_pkg->recurtax =~ /^Y$/i;
1046 unless ( $self->tax =~ /Y/i
1047 || $self->payby eq 'COMP'
1048 || $taxable_charged == 0 ) {
1050 my $cust_main_county =
1051 qsearchs('cust_main_county',{
1052 'state' => $self->state,
1053 'county' => $self->county,
1054 'country' => $self->country,
1055 'taxclass' => $part_pkg->taxclass,
1057 or qsearchs('cust_main_county',{
1058 'state' => $self->state,
1059 'county' => $self->county,
1060 'country' => $self->country,
1064 $dbh->rollback if $oldAutoCommit;
1066 "fatal: can't find tax rate for state/county/country/taxclass ".
1067 join('/', ( map $self->$_(), qw(state county country) ),
1068 $part_pkg->taxclass ). "\n";
1071 if ( $cust_main_county->exempt_amount ) {
1072 my ($mon,$year) = (localtime($sdate) )[4,5];
1074 my $freq = $part_pkg->freq || 1;
1075 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1076 foreach my $which_month ( 1 .. $freq ) {
1078 'custnum' => $self->custnum,
1079 'taxnum' => $cust_main_county->taxnum,
1080 'year' => 1900+$year,
1083 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1084 until ( $mon < 13 ) { $mon -= 12; $year++; }
1085 my $cust_tax_exempt =
1086 qsearchs('cust_tax_exempt', \%hash)
1087 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1088 my $remaining_exemption = sprintf("%.2f",
1089 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1090 if ( $remaining_exemption > 0 ) {
1091 my $addl = $remaining_exemption > $taxable_per_month
1092 ? $taxable_per_month
1093 : $remaining_exemption;
1094 $taxable_charged -= $addl;
1095 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1096 $cust_tax_exempt->hash,
1097 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1099 $error = $new_cust_tax_exempt->exemptnum
1100 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1101 : $new_cust_tax_exempt->insert;
1103 $dbh->rollback if $oldAutoCommit;
1104 return "fatal: can't update cust_tax_exempt: $error";
1107 } # if $remaining_exemption > 0
1109 } #foreach $which_month
1111 } #if $cust_main_county->exempt_amount
1113 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1115 #$tax += $taxable_charged * $cust_main_county->tax / 100
1116 $tax{ $cust_main_county->taxname || 'Tax' } +=
1117 $taxable_charged * $cust_main_county->tax / 100
1119 } #unless $self->tax =~ /Y/i
1120 # || $self->payby eq 'COMP'
1121 # || $taxable_charged == 0
1123 } #if $setup > 0 || $recur > 0
1125 } #if $cust_pkg_mod_flag
1127 } #foreach my $cust_pkg
1129 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1130 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1132 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1133 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1137 # unless ( $self->tax =~ /Y/i
1138 # || $self->payby eq 'COMP'
1139 # || $taxable_charged == 0 ) {
1140 # my $cust_main_county = qsearchs('cust_main_county',{
1141 # 'state' => $self->state,
1142 # 'county' => $self->county,
1143 # 'country' => $self->country,
1144 # } ) or die "fatal: can't find tax rate for state/county/country ".
1145 # $self->state. "/". $self->county. "/". $self->country. "\n";
1146 # my $tax = sprintf( "%.2f",
1147 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1150 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1151 my $tax = sprintf("%.2f", $tax{$taxname} );
1152 $charged = sprintf( "%.2f", $charged+$tax );
1154 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1160 'itemdesc' => $taxname,
1162 push @cust_bill_pkg, $cust_bill_pkg;
1166 my $cust_bill = new FS::cust_bill ( {
1167 'custnum' => $self->custnum,
1169 'charged' => $charged,
1171 $error = $cust_bill->insert;
1173 $dbh->rollback if $oldAutoCommit;
1174 return "can't create invoice for customer #". $self->custnum. ": $error";
1177 my $invnum = $cust_bill->invnum;
1179 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1181 $cust_bill_pkg->invnum($invnum);
1182 $error = $cust_bill_pkg->insert;
1184 $dbh->rollback if $oldAutoCommit;
1185 return "can't create invoice line item for customer #". $self->custnum.
1190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1194 =item collect OPTIONS
1196 (Attempt to) collect money for this customer's outstanding invoices (see
1197 L<FS::cust_bill>). Usually used after the bill method.
1199 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1200 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1202 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1203 and the invoice events web interface.
1205 If there is an error, returns the error, otherwise returns false.
1207 Options are passed as name-value pairs.
1209 Currently available options are:
1211 invoice_time - Use this time when deciding when to print invoices and
1212 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>
1213 for conversion functions.
1215 retry_card - Retry cards even when not scheduled by invoice events.
1217 batch_card - This option is deprecated. See the invoice events web interface
1218 to control whether cards are batched or run against a realtime gateway.
1220 report_badcard - This option is deprecated.
1222 force_print - This option is deprecated; see the invoice events web interface.
1227 my( $self, %options ) = @_;
1228 my $invoice_time = $options{'invoice_time'} || time;
1231 local $SIG{HUP} = 'IGNORE';
1232 local $SIG{INT} = 'IGNORE';
1233 local $SIG{QUIT} = 'IGNORE';
1234 local $SIG{TERM} = 'IGNORE';
1235 local $SIG{TSTP} = 'IGNORE';
1236 local $SIG{PIPE} = 'IGNORE';
1238 my $oldAutoCommit = $FS::UID::AutoCommit;
1239 local $FS::UID::AutoCommit = 0;
1242 my $balance = $self->balance;
1243 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1244 unless ( $balance > 0 ) { #redundant?????
1245 $dbh->rollback if $oldAutoCommit; #hmm
1249 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1250 #false laziness w/replace
1251 foreach my $cust_bill_event (
1253 #$_->part_bill_event->plan eq 'realtime-card'
1254 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1255 && $_->status eq 'done'
1258 map { $_->cust_bill_event }
1259 grep { $_->cust_bill_event }
1260 $self->open_cust_bill
1262 my $error = $cust_bill_event->retry;
1264 $dbh->rollback if $oldAutoCommit;
1265 return "error scheduling invoice events for retry: $error";
1271 foreach my $cust_bill ( $self->cust_bill ) {
1273 #this has to be before next's
1274 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1278 $balance = sprintf( "%.2f", $balance - $amount );
1280 next unless $cust_bill->owed > 0;
1282 # don't try to charge for the same invoice if it's already in a batch
1283 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1285 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1287 next unless $amount > 0;
1290 foreach my $part_bill_event (
1291 sort { $a->seconds <=> $b->seconds
1292 || $a->weight <=> $b->weight
1293 || $a->eventpart <=> $b->eventpart }
1294 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1295 && ! qsearchs( 'cust_bill_event', {
1296 'invnum' => $cust_bill->invnum,
1297 'eventpart' => $_->eventpart,
1301 qsearch('part_bill_event', { 'payby' => $self->payby,
1302 'disabled' => '', } )
1305 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1307 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1309 my $cust_main = $self; #for callback
1310 my $error = eval $part_bill_event->eventcode;
1313 my $statustext = '';
1317 } elsif ( $error ) {
1319 $statustext = $error;
1324 #add cust_bill_event
1325 my $cust_bill_event = new FS::cust_bill_event {
1326 'invnum' => $cust_bill->invnum,
1327 'eventpart' => $part_bill_event->eventpart,
1328 '_date' => $invoice_time,
1329 'status' => $status,
1330 'statustext' => $statustext,
1332 $error = $cust_bill_event->insert;
1334 #$dbh->rollback if $oldAutoCommit;
1335 #return "error: $error";
1337 # gah, even with transactions.
1338 $dbh->commit if $oldAutoCommit; #well.
1339 my $e = 'WARNING: Event run but database not updated - '.
1340 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1341 ', eventpart '. $part_bill_event->eventpart.
1352 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1359 Returns the total owed for this customer on all invoices
1360 (see L<FS::cust_bill/owed>).
1366 $self->total_owed_date(2145859200); #12/31/2037
1369 =item total_owed_date TIME
1371 Returns the total owed for this customer on all invoices with date earlier than
1372 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1373 see L<Time::Local> and L<Date::Parse> for conversion functions.
1377 sub total_owed_date {
1381 foreach my $cust_bill (
1382 grep { $_->_date <= $time }
1383 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1385 $total_bill += $cust_bill->owed;
1387 sprintf( "%.2f", $total_bill );
1392 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1393 to outstanding invoice balances in chronological order and returns the value
1394 of any remaining unapplied credits available for refund
1395 (see L<FS::cust_refund>).
1402 return 0 unless $self->total_credited;
1404 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1405 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1407 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1408 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1412 foreach my $cust_bill ( @invoices ) {
1415 if ( !defined($credit) || $credit->credited == 0) {
1416 $credit = pop @credits or last;
1419 if ($cust_bill->owed >= $credit->credited) {
1420 $amount=$credit->credited;
1422 $amount=$cust_bill->owed;
1425 my $cust_credit_bill = new FS::cust_credit_bill ( {
1426 'crednum' => $credit->crednum,
1427 'invnum' => $cust_bill->invnum,
1428 'amount' => $amount,
1430 my $error = $cust_credit_bill->insert;
1431 die $error if $error;
1433 redo if ($cust_bill->owed > 0);
1437 return $self->total_credited;
1440 =item apply_payments
1442 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1443 to outstanding invoice balances in chronological order.
1445 #and returns the value of any remaining unapplied payments.
1449 sub apply_payments {
1454 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1455 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1457 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1458 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1462 foreach my $cust_bill ( @invoices ) {
1465 if ( !defined($payment) || $payment->unapplied == 0 ) {
1466 $payment = pop @payments or last;
1469 if ( $cust_bill->owed >= $payment->unapplied ) {
1470 $amount = $payment->unapplied;
1472 $amount = $cust_bill->owed;
1475 my $cust_bill_pay = new FS::cust_bill_pay ( {
1476 'paynum' => $payment->paynum,
1477 'invnum' => $cust_bill->invnum,
1478 'amount' => $amount,
1480 my $error = $cust_bill_pay->insert;
1481 die $error if $error;
1483 redo if ( $cust_bill->owed > 0);
1487 return $self->total_unapplied_payments;
1490 =item total_credited
1492 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1493 customer. See L<FS::cust_credit/credited>.
1497 sub total_credited {
1499 my $total_credit = 0;
1500 foreach my $cust_credit ( qsearch('cust_credit', {
1501 'custnum' => $self->custnum,
1503 $total_credit += $cust_credit->credited;
1505 sprintf( "%.2f", $total_credit );
1508 =item total_unapplied_payments
1510 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1511 See L<FS::cust_pay/unapplied>.
1515 sub total_unapplied_payments {
1517 my $total_unapplied = 0;
1518 foreach my $cust_pay ( qsearch('cust_pay', {
1519 'custnum' => $self->custnum,
1521 $total_unapplied += $cust_pay->unapplied;
1523 sprintf( "%.2f", $total_unapplied );
1528 Returns the balance for this customer (total_owed minus total_credited
1529 minus total_unapplied_payments).
1536 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1540 =item balance_date TIME
1542 Returns the balance for this customer, only considering invoices with date
1543 earlier than TIME (total_owed_date minus total_credited minus
1544 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1545 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1554 $self->total_owed_date($time)
1555 - $self->total_credited
1556 - $self->total_unapplied_payments
1560 =item invoicing_list [ ARRAYREF ]
1562 If an arguement is given, sets these email addresses as invoice recipients
1563 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1564 (except as warnings), so use check_invoicing_list first.
1566 Returns a list of email addresses (with svcnum entries expanded).
1568 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1569 check it without disturbing anything by passing nothing.
1571 This interface may change in the future.
1575 sub invoicing_list {
1576 my( $self, $arrayref ) = @_;
1578 my @cust_main_invoice;
1579 if ( $self->custnum ) {
1580 @cust_main_invoice =
1581 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1583 @cust_main_invoice = ();
1585 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1586 #warn $cust_main_invoice->destnum;
1587 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1588 #warn $cust_main_invoice->destnum;
1589 my $error = $cust_main_invoice->delete;
1590 warn $error if $error;
1593 if ( $self->custnum ) {
1594 @cust_main_invoice =
1595 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1597 @cust_main_invoice = ();
1599 my %seen = map { $_->address => 1 } @cust_main_invoice;
1600 foreach my $address ( @{$arrayref} ) {
1601 next if exists $seen{$address} && $seen{$address};
1602 $seen{$address} = 1;
1603 my $cust_main_invoice = new FS::cust_main_invoice ( {
1604 'custnum' => $self->custnum,
1607 my $error = $cust_main_invoice->insert;
1608 warn $error if $error;
1611 if ( $self->custnum ) {
1613 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1619 =item check_invoicing_list ARRAYREF
1621 Checks these arguements as valid input for the invoicing_list method. If there
1622 is an error, returns the error, otherwise returns false.
1626 sub check_invoicing_list {
1627 my( $self, $arrayref ) = @_;
1628 foreach my $address ( @{$arrayref} ) {
1629 my $cust_main_invoice = new FS::cust_main_invoice ( {
1630 'custnum' => $self->custnum,
1633 my $error = $self->custnum
1634 ? $cust_main_invoice->check
1635 : $cust_main_invoice->checkdest
1637 return $error if $error;
1642 =item set_default_invoicing_list
1644 Sets the invoicing list to all accounts associated with this customer,
1645 overwriting any previous invoicing list.
1649 sub set_default_invoicing_list {
1651 $self->invoicing_list($self->all_emails);
1656 Returns the email addresses of all accounts provisioned for this customer.
1663 foreach my $cust_pkg ( $self->all_pkgs ) {
1664 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1666 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1667 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1669 $list{$_}=1 foreach map { $_->email } @svc_acct;
1674 =item invoicing_list_addpost
1676 Adds postal invoicing to this customer. If this customer is already configured
1677 to receive postal invoices, does nothing.
1681 sub invoicing_list_addpost {
1683 return if grep { $_ eq 'POST' } $self->invoicing_list;
1684 my @invoicing_list = $self->invoicing_list;
1685 push @invoicing_list, 'POST';
1686 $self->invoicing_list(\@invoicing_list);
1689 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1691 Returns an array of customers referred by this customer (referral_custnum set
1692 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1693 customers referred by customers referred by this customer and so on, inclusive.
1694 The default behavior is DEPTH 1 (no recursion).
1698 sub referral_cust_main {
1700 my $depth = @_ ? shift : 1;
1701 my $exclude = @_ ? shift : {};
1704 map { $exclude->{$_->custnum}++; $_; }
1705 grep { ! $exclude->{ $_->custnum } }
1706 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1710 map { $_->referral_cust_main($depth-1, $exclude) }
1717 =item referral_cust_main_ncancelled
1719 Same as referral_cust_main, except only returns customers with uncancelled
1724 sub referral_cust_main_ncancelled {
1726 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1729 =item referral_cust_pkg [ DEPTH ]
1731 Like referral_cust_main, except returns a flat list of all unsuspended (and
1732 uncancelled) packages for each customer. The number of items in this list may
1733 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1737 sub referral_cust_pkg {
1739 my $depth = @_ ? shift : 1;
1741 map { $_->unsuspended_pkgs }
1742 grep { $_->unsuspended_pkgs }
1743 $self->referral_cust_main($depth);
1746 =item credit AMOUNT, REASON
1748 Applies a credit to this customer. If there is an error, returns the error,
1749 otherwise returns false.
1754 my( $self, $amount, $reason ) = @_;
1755 my $cust_credit = new FS::cust_credit {
1756 'custnum' => $self->custnum,
1757 'amount' => $amount,
1758 'reason' => $reason,
1760 $cust_credit->insert;
1763 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1765 Creates a one-time charge for this customer. If there is an error, returns
1766 the error, otherwise returns false.
1771 my ( $self, $amount ) = ( shift, shift );
1772 my $pkg = @_ ? shift : 'One-time charge';
1773 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1774 my $taxclass = @_ ? shift : '';
1776 local $SIG{HUP} = 'IGNORE';
1777 local $SIG{INT} = 'IGNORE';
1778 local $SIG{QUIT} = 'IGNORE';
1779 local $SIG{TERM} = 'IGNORE';
1780 local $SIG{TSTP} = 'IGNORE';
1781 local $SIG{PIPE} = 'IGNORE';
1783 my $oldAutoCommit = $FS::UID::AutoCommit;
1784 local $FS::UID::AutoCommit = 0;
1787 my $part_pkg = new FS::part_pkg ( {
1789 'comment' => $comment,
1794 'taxclass' => $taxclass,
1797 my $error = $part_pkg->insert;
1799 $dbh->rollback if $oldAutoCommit;
1803 my $pkgpart = $part_pkg->pkgpart;
1804 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1805 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1806 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1807 $error = $type_pkgs->insert;
1809 $dbh->rollback if $oldAutoCommit;
1814 my $cust_pkg = new FS::cust_pkg ( {
1815 'custnum' => $self->custnum,
1816 'pkgpart' => $pkgpart,
1819 $error = $cust_pkg->insert;
1821 $dbh->rollback if $oldAutoCommit;
1825 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1832 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1838 sort { $a->_date <=> $b->_date }
1839 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1842 =item open_cust_bill
1844 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1849 sub open_cust_bill {
1851 grep { $_->owed > 0 } $self->cust_bill;
1860 =item check_and_rebuild_fuzzyfiles
1864 sub check_and_rebuild_fuzzyfiles {
1865 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1866 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1867 or &rebuild_fuzzyfiles;
1870 =item rebuild_fuzzyfiles
1874 sub rebuild_fuzzyfiles {
1876 use Fcntl qw(:flock);
1878 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1882 open(LASTLOCK,">>$dir/cust_main.last")
1883 or die "can't open $dir/cust_main.last: $!";
1884 flock(LASTLOCK,LOCK_EX)
1885 or die "can't lock $dir/cust_main.last: $!";
1887 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1889 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1890 if defined dbdef->table('cust_main')->column('ship_last');
1892 open (LASTCACHE,">$dir/cust_main.last.tmp")
1893 or die "can't open $dir/cust_main.last.tmp: $!";
1894 print LASTCACHE join("\n", @all_last), "\n";
1895 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1897 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1902 open(COMPANYLOCK,">>$dir/cust_main.company")
1903 or die "can't open $dir/cust_main.company: $!";
1904 flock(COMPANYLOCK,LOCK_EX)
1905 or die "can't lock $dir/cust_main.company: $!";
1907 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1909 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1910 if defined dbdef->table('cust_main')->column('ship_last');
1912 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1913 or die "can't open $dir/cust_main.company.tmp: $!";
1914 print COMPANYCACHE join("\n", @all_company), "\n";
1915 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1917 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1927 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1928 open(LASTCACHE,"<$dir/cust_main.last")
1929 or die "can't open $dir/cust_main.last: $!";
1930 my @array = map { chomp; $_; } <LASTCACHE>;
1940 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1941 open(COMPANYCACHE,"<$dir/cust_main.company")
1942 or die "can't open $dir/cust_main.last: $!";
1943 my @array = map { chomp; $_; } <COMPANYCACHE>;
1948 =item append_fuzzyfiles LASTNAME COMPANY
1952 sub append_fuzzyfiles {
1953 my( $last, $company ) = @_;
1955 &check_and_rebuild_fuzzyfiles;
1957 use Fcntl qw(:flock);
1959 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1963 open(LAST,">>$dir/cust_main.last")
1964 or die "can't open $dir/cust_main.last: $!";
1966 or die "can't lock $dir/cust_main.last: $!";
1968 print LAST "$last\n";
1971 or die "can't unlock $dir/cust_main.last: $!";
1977 open(COMPANY,">>$dir/cust_main.company")
1978 or die "can't open $dir/cust_main.company: $!";
1979 flock(COMPANY,LOCK_EX)
1980 or die "can't lock $dir/cust_main.company: $!";
1982 print COMPANY "$company\n";
1984 flock(COMPANY,LOCK_UN)
1985 or die "can't unlock $dir/cust_main.company: $!";
1999 #warn join('-',keys %$param);
2000 my $fh = $param->{filehandle};
2001 my $agentnum = $param->{agentnum};
2002 my $refnum = $param->{refnum};
2003 my $pkgpart = $param->{pkgpart};
2004 my @fields = @{$param->{fields}};
2006 eval "use Date::Parse;";
2008 eval "use Text::CSV_XS;";
2011 my $csv = new Text::CSV_XS;
2018 local $SIG{HUP} = 'IGNORE';
2019 local $SIG{INT} = 'IGNORE';
2020 local $SIG{QUIT} = 'IGNORE';
2021 local $SIG{TERM} = 'IGNORE';
2022 local $SIG{TSTP} = 'IGNORE';
2023 local $SIG{PIPE} = 'IGNORE';
2025 my $oldAutoCommit = $FS::UID::AutoCommit;
2026 local $FS::UID::AutoCommit = 0;
2029 #while ( $columns = $csv->getline($fh) ) {
2031 while ( defined($line=<$fh>) ) {
2033 $csv->parse($line) or do {
2034 $dbh->rollback if $oldAutoCommit;
2035 return "can't parse: ". $csv->error_input();
2038 my @columns = $csv->fields();
2039 #warn join('-',@columns);
2042 agentnum => $agentnum,
2044 country => 'US', #default
2045 payby => 'BILL', #default
2046 paydate => '12/2037', #default
2048 my $billtime = time;
2049 my %cust_pkg = ( pkgpart => $pkgpart );
2050 foreach my $field ( @fields ) {
2051 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2052 #$cust_pkg{$1} = str2time( shift @$columns );
2053 if ( $1 eq 'setup' ) {
2054 $billtime = str2time(shift @columns);
2056 $cust_pkg{$1} = str2time( shift @columns );
2059 #$cust_main{$field} = shift @$columns;
2060 $cust_main{$field} = shift @columns;
2064 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2065 my $cust_main = new FS::cust_main ( \%cust_main );
2067 tie my %hash, 'Tie::RefHash'; #this part is important
2068 $hash{$cust_pkg} = [] if $pkgpart;
2069 my $error = $cust_main->insert( \%hash );
2072 $dbh->rollback if $oldAutoCommit;
2073 return "can't insert customer for $line: $error";
2076 #false laziness w/bill.cgi
2077 $error = $cust_main->bill( 'time' => $billtime );
2079 $dbh->rollback if $oldAutoCommit;
2080 return "can't bill customer for $line: $error";
2083 $cust_main->apply_payments;
2084 $cust_main->apply_credits;
2086 $error = $cust_main->collect();
2088 $dbh->rollback if $oldAutoCommit;
2089 return "can't collect customer for $line: $error";
2095 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2097 return "Empty file!" unless $imported;
2109 #warn join('-',keys %$param);
2110 my $fh = $param->{filehandle};
2111 my @fields = @{$param->{fields}};
2113 eval "use Date::Parse;";
2115 eval "use Text::CSV_XS;";
2118 my $csv = new Text::CSV_XS;
2125 local $SIG{HUP} = 'IGNORE';
2126 local $SIG{INT} = 'IGNORE';
2127 local $SIG{QUIT} = 'IGNORE';
2128 local $SIG{TERM} = 'IGNORE';
2129 local $SIG{TSTP} = 'IGNORE';
2130 local $SIG{PIPE} = 'IGNORE';
2132 my $oldAutoCommit = $FS::UID::AutoCommit;
2133 local $FS::UID::AutoCommit = 0;
2136 #while ( $columns = $csv->getline($fh) ) {
2138 while ( defined($line=<$fh>) ) {
2140 $csv->parse($line) or do {
2141 $dbh->rollback if $oldAutoCommit;
2142 return "can't parse: ". $csv->error_input();
2145 my @columns = $csv->fields();
2146 #warn join('-',@columns);
2149 foreach my $field ( @fields ) {
2150 $row{$field} = shift @columns;
2153 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2154 unless ( $cust_main ) {
2155 $dbh->rollback if $oldAutoCommit;
2156 return "unknown custnum $row{'custnum'}";
2159 if ( $row{'amount'} > 0 ) {
2160 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2162 $dbh->rollback if $oldAutoCommit;
2166 } elsif ( $row{'amount'} < 0 ) {
2167 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2170 $dbh->rollback if $oldAutoCommit;
2180 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2182 return "Empty file!" unless $imported;
2194 The delete method should possibly take an FS::cust_main object reference
2195 instead of a scalar customer number.
2197 Bill and collect options should probably be passed as references instead of a
2200 There should probably be a configuration file with a list of allowed credit
2203 No multiple currency support (probably a larger project than just this module).
2207 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2208 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2209 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.