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 {
42 install_callback FS::UID sub {
44 #yes, need it for stuff below (prolly should be cached)
49 my ( $hashref, $cache ) = @_;
50 if ( exists $hashref->{'pkgnum'} ) {
51 # #@{ $self->{'_pkgnum'} } = ();
52 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
53 $self->{'_pkgnum'} = $subcache;
54 #push @{ $self->{'_pkgnum'} },
55 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
61 FS::cust_main - Object methods for cust_main records
67 $record = new FS::cust_main \%hash;
68 $record = new FS::cust_main { 'column' => 'value' };
70 $error = $record->insert;
72 $error = $new_record->replace($old_record);
74 $error = $record->delete;
76 $error = $record->check;
78 @cust_pkg = $record->all_pkgs;
80 @cust_pkg = $record->ncancelled_pkgs;
82 @cust_pkg = $record->suspended_pkgs;
84 $error = $record->bill;
85 $error = $record->bill %options;
86 $error = $record->bill 'time' => $time;
88 $error = $record->collect;
89 $error = $record->collect %options;
90 $error = $record->collect 'invoice_time' => $time,
91 'batch_card' => 'yes',
92 'report_badcard' => 'yes',
97 An FS::cust_main object represents a customer. FS::cust_main inherits from
98 FS::Record. The following fields are currently supported:
102 =item custnum - primary key (assigned automatically for new customers)
104 =item agentnum - agent (see L<FS::agent>)
106 =item refnum - Advertising source (see L<FS::part_referral>)
112 =item ss - social security number (optional)
114 =item company - (optional)
118 =item address2 - (optional)
122 =item county - (optional, see L<FS::cust_main_county>)
124 =item state - (see L<FS::cust_main_county>)
128 =item country - (see L<FS::cust_main_county>)
130 =item daytime - phone (optional)
132 =item night - phone (optional)
134 =item fax - phone (optional)
136 =item ship_first - name
138 =item ship_last - name
140 =item ship_company - (optional)
144 =item ship_address2 - (optional)
148 =item ship_county - (optional, see L<FS::cust_main_county>)
150 =item ship_state - (see L<FS::cust_main_county>)
154 =item ship_country - (see L<FS::cust_main_county>)
156 =item ship_daytime - phone (optional)
158 =item ship_night - phone (optional)
160 =item ship_fax - phone (optional)
162 =item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
164 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
166 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
168 =item payname - name on card or billing name
170 =item tax - tax exempt, empty or `Y'
172 =item otaker - order taker (assigned automatically, see L<FS::UID>)
174 =item comments - comments (optional)
176 =item referral_custnum - referring customer number
186 Creates a new customer. To add the customer to the database, see L<"insert">.
188 Note that this stores the hash reference, not a distinct copy of the hash it
189 points to. You can ask the object for a copy with the I<hash> method.
193 sub table { 'cust_main'; }
195 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
197 Adds this customer to the database. If there is an error, returns the error,
198 otherwise returns false.
200 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
201 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
202 are inserted atomicly, or the transaction is rolled back. Passing an empty
203 hash reference is equivalent to not supplying this parameter. There should be
204 a better explanation of this, but until then, here's an example:
207 tie %hash, 'Tie::RefHash'; #this part is important
209 $cust_pkg => [ $svc_acct ],
212 $cust_main->insert( \%hash );
214 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
215 be set as the invoicing list (see L<"invoicing_list">). Errors return as
216 expected and rollback the entire transaction; it is not necessary to call
217 check_invoicing_list first. The invoicing_list is set after the records in the
218 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
219 invoicing_list destination to the newly-created svc_acct. Here's an example:
221 $cust_main->insert( {}, [ $email, 'POST' ] );
227 my $cust_pkgs = @_ ? shift : {};
228 my $invoicing_list = @_ ? shift : '';
230 local $SIG{HUP} = 'IGNORE';
231 local $SIG{INT} = 'IGNORE';
232 local $SIG{QUIT} = 'IGNORE';
233 local $SIG{TERM} = 'IGNORE';
234 local $SIG{TSTP} = 'IGNORE';
235 local $SIG{PIPE} = 'IGNORE';
237 my $oldAutoCommit = $FS::UID::AutoCommit;
238 local $FS::UID::AutoCommit = 0;
243 if ( $self->payby eq 'PREPAY' ) {
244 $self->payby('BILL');
245 my $prepay_credit = qsearchs(
247 { 'identifier' => $self->payinfo },
251 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
252 unless $prepay_credit;
253 $amount = $prepay_credit->amount;
254 $seconds = $prepay_credit->seconds;
255 my $error = $prepay_credit->delete;
257 $dbh->rollback if $oldAutoCommit;
258 return "removing prepay_credit (transaction rolled back): $error";
262 my $error = $self->SUPER::insert;
264 $dbh->rollback if $oldAutoCommit;
265 #return "inserting cust_main record (transaction rolled back): $error";
270 if ( $invoicing_list ) {
271 $error = $self->check_invoicing_list( $invoicing_list );
273 $dbh->rollback if $oldAutoCommit;
274 return "checking invoicing_list (transaction rolled back): $error";
276 $self->invoicing_list( $invoicing_list );
280 $error = $self->order_pkgs($cust_pkgs, \$seconds);
282 $dbh->rollback if $oldAutoCommit;
287 $dbh->rollback if $oldAutoCommit;
288 return "No svc_acct record to apply pre-paid time";
292 my $cust_credit = new FS::cust_credit {
293 'custnum' => $self->custnum,
296 $error = $cust_credit->insert;
298 $dbh->rollback if $oldAutoCommit;
299 return "inserting credit (transaction rolled back): $error";
303 #false laziness with sub replace
304 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
305 $error = $queue->insert($self->getfield('last'), $self->company);
307 $dbh->rollback if $oldAutoCommit;
308 return "queueing job (transaction rolled back): $error";
311 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
312 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
313 $error = $queue->insert($self->getfield('last'), $self->company);
315 $dbh->rollback if $oldAutoCommit;
316 return "queueing job (transaction rolled back): $error";
321 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
328 document me. like ->insert(%cust_pkg) on an existing record
334 my $cust_pkgs = shift;
337 local $SIG{HUP} = 'IGNORE';
338 local $SIG{INT} = 'IGNORE';
339 local $SIG{QUIT} = 'IGNORE';
340 local $SIG{TERM} = 'IGNORE';
341 local $SIG{TSTP} = 'IGNORE';
342 local $SIG{PIPE} = 'IGNORE';
344 my $oldAutoCommit = $FS::UID::AutoCommit;
345 local $FS::UID::AutoCommit = 0;
348 foreach my $cust_pkg ( keys %$cust_pkgs ) {
349 $cust_pkg->custnum( $self->custnum );
350 my $error = $cust_pkg->insert;
352 $dbh->rollback if $oldAutoCommit;
353 return "inserting cust_pkg (transaction rolled back): $error";
355 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
356 $svc_something->pkgnum( $cust_pkg->pkgnum );
357 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
358 $svc_something->seconds( $svc_something->seconds + $$seconds );
361 $error = $svc_something->insert;
363 $dbh->rollback if $oldAutoCommit;
364 #return "inserting svc_ (transaction rolled back): $error";
370 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
374 =item delete NEW_CUSTNUM
376 This deletes the customer. If there is an error, returns the error, otherwise
379 This will completely remove all traces of the customer record. This is not
380 what you want when a customer cancels service; for that, cancel all of the
381 customer's packages (see L<FS::cust_pkg/cancel>).
383 If the customer has any uncancelled packages, you need to pass a new (valid)
384 customer number for those packages to be transferred to. Cancelled packages
385 will be deleted. Did I mention that this is NOT what you want when a customer
386 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
388 You can't delete a customer with invoices (see L<FS::cust_bill>),
389 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
390 refunds (see L<FS::cust_refund>).
397 local $SIG{HUP} = 'IGNORE';
398 local $SIG{INT} = 'IGNORE';
399 local $SIG{QUIT} = 'IGNORE';
400 local $SIG{TERM} = 'IGNORE';
401 local $SIG{TSTP} = 'IGNORE';
402 local $SIG{PIPE} = 'IGNORE';
404 my $oldAutoCommit = $FS::UID::AutoCommit;
405 local $FS::UID::AutoCommit = 0;
408 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
409 $dbh->rollback if $oldAutoCommit;
410 return "Can't delete a customer with invoices";
412 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
413 $dbh->rollback if $oldAutoCommit;
414 return "Can't delete a customer with credits";
416 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
417 $dbh->rollback if $oldAutoCommit;
418 return "Can't delete a customer with payments";
420 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
421 $dbh->rollback if $oldAutoCommit;
422 return "Can't delete a customer with refunds";
425 my @cust_pkg = $self->ncancelled_pkgs;
427 my $new_custnum = shift;
428 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
429 $dbh->rollback if $oldAutoCommit;
430 return "Invalid new customer number: $new_custnum";
432 foreach my $cust_pkg ( @cust_pkg ) {
433 my %hash = $cust_pkg->hash;
434 $hash{'custnum'} = $new_custnum;
435 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
436 my $error = $new_cust_pkg->replace($cust_pkg);
438 $dbh->rollback if $oldAutoCommit;
443 my @cancelled_cust_pkg = $self->all_pkgs;
444 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
445 my $error = $cust_pkg->delete;
447 $dbh->rollback if $oldAutoCommit;
452 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
453 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
455 my $error = $cust_main_invoice->delete;
457 $dbh->rollback if $oldAutoCommit;
462 my $error = $self->SUPER::delete;
464 $dbh->rollback if $oldAutoCommit;
468 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
473 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
475 Replaces the OLD_RECORD with this one in the database. If there is an error,
476 returns the error, otherwise returns false.
478 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
479 be set as the invoicing list (see L<"invoicing_list">). Errors return as
480 expected and rollback the entire transaction; it is not necessary to call
481 check_invoicing_list first. Here's an example:
483 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
492 local $SIG{HUP} = 'IGNORE';
493 local $SIG{INT} = 'IGNORE';
494 local $SIG{QUIT} = 'IGNORE';
495 local $SIG{TERM} = 'IGNORE';
496 local $SIG{TSTP} = 'IGNORE';
497 local $SIG{PIPE} = 'IGNORE';
499 my $oldAutoCommit = $FS::UID::AutoCommit;
500 local $FS::UID::AutoCommit = 0;
503 my $error = $self->SUPER::replace($old);
506 $dbh->rollback if $oldAutoCommit;
510 if ( @param ) { # INVOICING_LIST_ARYREF
511 my $invoicing_list = shift @param;
512 $error = $self->check_invoicing_list( $invoicing_list );
514 $dbh->rollback if $oldAutoCommit;
517 $self->invoicing_list( $invoicing_list );
520 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
521 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
522 # card/check info has changed, want to retry realtime_card invoice events
523 #false laziness w/collect
524 foreach my $cust_bill_event (
526 #$_->part_bill_event->plan eq 'realtime-card'
527 $_->part_bill_event->eventcode =~
528 /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
529 && $_->status eq 'done'
532 map { $_->cust_bill_event }
533 grep { $_->cust_bill_event }
534 $self->open_cust_bill
537 my $error = $cust_bill_event->retry;
539 $dbh->rollback if $oldAutoCommit;
540 return "error scheduling invoice events for retry: $error";
547 #false laziness with sub insert
548 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
549 $error = $queue->insert($self->getfield('last'), $self->company);
551 $dbh->rollback if $oldAutoCommit;
552 return "queueing job (transaction rolled back): $error";
555 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
556 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
557 $error = $queue->insert($self->getfield('last'), $self->company);
559 $dbh->rollback if $oldAutoCommit;
560 return "queueing job (transaction rolled back): $error";
565 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
572 Checks all fields to make sure this is a valid customer record. If there is
573 an error, returns the error, otherwise returns false. Called by the insert
581 #warn "BEFORE: \n". $self->_dump;
584 $self->ut_numbern('custnum')
585 || $self->ut_number('agentnum')
586 || $self->ut_number('refnum')
587 || $self->ut_name('last')
588 || $self->ut_name('first')
589 || $self->ut_textn('company')
590 || $self->ut_text('address1')
591 || $self->ut_textn('address2')
592 || $self->ut_text('city')
593 || $self->ut_textn('county')
594 || $self->ut_textn('state')
595 || $self->ut_country('country')
596 || $self->ut_anything('comments')
597 || $self->ut_numbern('referral_custnum')
599 #barf. need message catalogs. i18n. etc.
600 $error .= "Please select a advertising source."
601 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
602 return $error if $error;
604 return "Unknown agent"
605 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
607 return "Unknown refnum"
608 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
610 return "Unknown referring custnum ". $self->referral_custnum
611 unless ! $self->referral_custnum
612 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
614 if ( $self->ss eq '' ) {
619 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
620 or return "Illegal social security number: ". $self->ss;
621 $self->ss("$1-$2-$3");
625 # bad idea to disable, causes billing to fail because of no tax rates later
626 # unless ( $import ) {
627 unless ( qsearch('cust_main_county', {
628 'country' => $self->country,
631 return "Unknown state/county/country: ".
632 $self->state. "/". $self->county. "/". $self->country
633 unless qsearch('cust_main_county',{
634 'state' => $self->state,
635 'county' => $self->county,
636 'country' => $self->country,
642 $self->ut_phonen('daytime', $self->country)
643 || $self->ut_phonen('night', $self->country)
644 || $self->ut_phonen('fax', $self->country)
645 || $self->ut_zip('zip', $self->country)
647 return $error if $error;
650 last first company address1 address2 city county state zip
651 country daytime night fax
654 if ( defined $self->dbdef_table->column('ship_last') ) {
655 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
657 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
661 $self->ut_name('ship_last')
662 || $self->ut_name('ship_first')
663 || $self->ut_textn('ship_company')
664 || $self->ut_text('ship_address1')
665 || $self->ut_textn('ship_address2')
666 || $self->ut_text('ship_city')
667 || $self->ut_textn('ship_county')
668 || $self->ut_textn('ship_state')
669 || $self->ut_country('ship_country')
671 return $error if $error;
673 #false laziness with above
674 unless ( qsearchs('cust_main_county', {
675 'country' => $self->ship_country,
678 return "Unknown ship_state/ship_county/ship_country: ".
679 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
680 unless qsearchs('cust_main_county',{
681 'state' => $self->ship_state,
682 'county' => $self->ship_county,
683 'country' => $self->ship_country,
689 $self->ut_phonen('ship_daytime', $self->ship_country)
690 || $self->ut_phonen('ship_night', $self->ship_country)
691 || $self->ut_phonen('ship_fax', $self->ship_country)
692 || $self->ut_zip('ship_zip', $self->ship_country)
694 return $error if $error;
696 } else { # ship_ info eq billing info, so don't store dup info in database
697 $self->setfield("ship_$_", '')
698 foreach qw( last first company address1 address2 city county state zip
699 country daytime night fax );
703 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
704 or return "Illegal payby: ". $self->payby;
707 if ( $self->payby eq 'CARD' ) {
709 my $payinfo = $self->payinfo;
711 $payinfo =~ /^(\d{13,16})$/
712 or return gettext('invalid_card'); # . ": ". $self->payinfo;
714 $self->payinfo($payinfo);
716 or return gettext('invalid_card'); # . ": ". $self->payinfo;
717 return gettext('unknown_card_type')
718 if cardtype($self->payinfo) eq "Unknown";
720 } elsif ( $self->payby eq 'CHEK' ) {
722 my $payinfo = $self->payinfo;
723 $payinfo =~ s/[^\d\@]//g;
724 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
726 $self->payinfo($payinfo);
728 } elsif ( $self->payby eq 'LECB' ) {
730 my $payinfo = $self->payinfo;
732 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
734 $self->payinfo($payinfo);
736 } elsif ( $self->payby eq 'BILL' ) {
738 $error = $self->ut_textn('payinfo');
739 return "Illegal P.O. number: ". $self->payinfo if $error;
741 } elsif ( $self->payby eq 'COMP' ) {
743 $error = $self->ut_textn('payinfo');
744 return "Illegal comp account issuer: ". $self->payinfo if $error;
746 } elsif ( $self->payby eq 'PREPAY' ) {
748 my $payinfo = $self->payinfo;
749 $payinfo =~ s/\W//g; #anything else would just confuse things
750 $self->payinfo($payinfo);
751 $error = $self->ut_alpha('payinfo');
752 return "Illegal prepayment identifier: ". $self->payinfo if $error;
753 return "Unknown prepayment identifier"
754 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
758 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
759 return "Expriation date required"
760 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
763 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
764 or return "Illegal expiration date: ". $self->paydate;
765 my $y = length($2) == 4 ? $2 : "20$2";
766 $self->paydate("$y-$1-01");
767 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
768 return gettext('expired_card')
769 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
772 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
773 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
774 $self->payname( $self->first. " ". $self->getfield('last') );
776 $self->payname =~ /^([\w \,\.\-\']+)$/
777 or return gettext('illegal_name'). " payname: ". $self->payname;
781 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
784 $self->otaker(getotaker);
786 #warn "AFTER: \n". $self->_dump;
793 Returns all packages (see L<FS::cust_pkg>) for this customer.
799 if ( $self->{'_pkgnum'} ) {
800 values %{ $self->{'_pkgnum'}->cache };
802 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
806 =item ncancelled_pkgs
808 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
812 sub ncancelled_pkgs {
814 if ( $self->{'_pkgnum'} ) {
815 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
817 @{ [ # force list context
818 qsearch( 'cust_pkg', {
819 'custnum' => $self->custnum,
822 qsearch( 'cust_pkg', {
823 'custnum' => $self->custnum,
832 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
838 grep { $_->susp } $self->ncancelled_pkgs;
841 =item unflagged_suspended_pkgs
843 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
844 customer (thouse packages without the `manual_flag' set).
848 sub unflagged_suspended_pkgs {
850 return $self->suspended_pkgs
851 unless dbdef->table('cust_pkg')->column('manual_flag');
852 grep { ! $_->manual_flag } $self->suspended_pkgs;
855 =item unsuspended_pkgs
857 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
862 sub unsuspended_pkgs {
864 grep { ! $_->susp } $self->ncancelled_pkgs;
869 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
870 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
871 on success or a list of errors.
877 grep { $_->unsuspend } $self->suspended_pkgs;
882 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
883 Always returns a list: an empty list on success or a list of errors.
889 grep { $_->suspend } $self->unsuspended_pkgs;
894 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
895 Always returns a list: an empty list on success or a list of errors.
901 grep { $_->cancel } $self->ncancelled_pkgs;
906 Returns the agent (see L<FS::agent>) for this customer.
912 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
917 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
918 conjunction with the collect method.
920 Options are passed as name-value pairs.
922 The only currently available option is `time', which bills the customer as if
923 it were that time. It is specified as a UNIX timestamp; see
924 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
925 functions. For example:
929 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
931 If there is an error, returns the error, otherwise returns false.
936 my( $self, %options ) = @_;
937 my $time = $options{'time'} || time;
942 local $SIG{HUP} = 'IGNORE';
943 local $SIG{INT} = 'IGNORE';
944 local $SIG{QUIT} = 'IGNORE';
945 local $SIG{TERM} = 'IGNORE';
946 local $SIG{TSTP} = 'IGNORE';
947 local $SIG{PIPE} = 'IGNORE';
949 my $oldAutoCommit = $FS::UID::AutoCommit;
950 local $FS::UID::AutoCommit = 0;
953 # find the packages which are due for billing, find out how much they are
954 # & generate invoice database.
956 my( $total_setup, $total_recur ) = ( 0, 0 );
957 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
958 my @cust_bill_pkg = ();
960 #my $taxable_charged = 0;##
965 foreach my $cust_pkg (
966 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
969 #NO!! next if $cust_pkg->cancel;
970 next if $cust_pkg->getfield('cancel');
972 #? to avoid use of uninitialized value errors... ?
973 $cust_pkg->setfield('bill', '')
974 unless defined($cust_pkg->bill);
976 my $part_pkg = $cust_pkg->part_pkg;
978 #so we don't modify cust_pkg record unnecessarily
979 my $cust_pkg_mod_flag = 0;
980 my %hash = $cust_pkg->hash;
981 my $old_cust_pkg = new FS::cust_pkg \%hash;
987 unless ( $cust_pkg->setup ) {
988 my $setup_prog = $part_pkg->getfield('setup');
989 $setup_prog =~ /^(.*)$/ or do {
990 $dbh->rollback if $oldAutoCommit;
991 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
997 ##$cpt->permit(); #what is necessary?
998 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
999 #$setup = $cpt->reval($setup_prog);
1000 $setup = eval $setup_prog;
1001 unless ( defined($setup) ) {
1002 $dbh->rollback if $oldAutoCommit;
1003 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1004 "(expression $setup_prog): $@";
1006 $cust_pkg->setfield('setup',$time);
1007 $cust_pkg_mod_flag=1;
1013 if ( $part_pkg->getfield('freq') > 0 &&
1014 ! $cust_pkg->getfield('susp') &&
1015 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1017 my $recur_prog = $part_pkg->getfield('recur');
1018 $recur_prog =~ /^(.*)$/ or do {
1019 $dbh->rollback if $oldAutoCommit;
1020 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1025 # shared with $recur_prog
1026 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1028 #my $cpt = new Safe;
1029 ##$cpt->permit(); #what is necessary?
1030 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1031 #$recur = $cpt->reval($recur_prog);
1032 $recur = eval $recur_prog;
1033 unless ( defined($recur) ) {
1034 $dbh->rollback if $oldAutoCommit;
1035 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1036 "(expression $recur_prog): $@";
1038 #change this bit to use Date::Manip? CAREFUL with timezones (see
1039 # mailing list archive)
1040 my ($sec,$min,$hour,$mday,$mon,$year) =
1041 (localtime($sdate) )[0,1,2,3,4,5];
1043 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1044 # only for figuring next bill date, nothing else, so, reset $sdate again
1046 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1047 $cust_pkg->last_bill($sdate)
1048 if $cust_pkg->dbdef_table->column('last_bill');
1050 $mon += $part_pkg->freq;
1051 until ( $mon < 12 ) { $mon -= 12; $year++; }
1052 $cust_pkg->setfield('bill',
1053 timelocal($sec,$min,$hour,$mday,$mon,$year));
1054 $cust_pkg_mod_flag = 1;
1057 warn "\$setup is undefined" unless defined($setup);
1058 warn "\$recur is undefined" unless defined($recur);
1059 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1061 my $taxable_charged = 0;
1062 if ( $cust_pkg_mod_flag ) {
1063 $error=$cust_pkg->replace($old_cust_pkg);
1064 if ( $error ) { #just in case
1065 $dbh->rollback if $oldAutoCommit;
1066 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1068 $setup = sprintf( "%.2f", $setup );
1069 $recur = sprintf( "%.2f", $recur );
1071 $dbh->rollback if $oldAutoCommit;
1072 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1075 $dbh->rollback if $oldAutoCommit;
1076 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1078 if ( $setup > 0 || $recur > 0 ) {
1079 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1080 'pkgnum' => $cust_pkg->pkgnum,
1084 'edate' => $cust_pkg->bill,
1085 'details' => \@details,
1087 push @cust_bill_pkg, $cust_bill_pkg;
1088 $total_setup += $setup;
1089 $total_recur += $recur;
1090 $taxable_charged += $setup
1091 unless $part_pkg->setuptax =~ /^Y$/i;
1092 $taxable_charged += $recur
1093 unless $part_pkg->recurtax =~ /^Y$/i;
1095 unless ( $self->tax =~ /Y/i
1096 || $self->payby eq 'COMP'
1097 || $taxable_charged == 0 ) {
1099 my $cust_main_county = qsearchs('cust_main_county',{
1100 'state' => $self->state,
1101 'county' => $self->county,
1102 'country' => $self->country,
1103 'taxclass' => $part_pkg->taxclass,
1105 $cust_main_county ||= qsearchs('cust_main_county',{
1106 'state' => $self->state,
1107 'county' => $self->county,
1108 'country' => $self->country,
1111 unless ( $cust_main_county ) {
1112 $dbh->rollback if $oldAutoCommit;
1114 "fatal: can't find tax rate for state/county/country/taxclass ".
1115 join('/', ( map $self->$_(), qw(state county country) ),
1116 $part_pkg->taxclass ). "\n";
1119 if ( $cust_main_county->exempt_amount ) {
1120 my ($mon,$year) = (localtime($sdate) )[4,5];
1122 my $freq = $part_pkg->freq || 1;
1123 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1124 foreach my $which_month ( 1 .. $freq ) {
1126 'custnum' => $self->custnum,
1127 'taxnum' => $cust_main_county->taxnum,
1128 'year' => 1900+$year,
1131 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1132 until ( $mon < 13 ) { $mon -= 12; $year++; }
1133 my $cust_tax_exempt =
1134 qsearchs('cust_tax_exempt', \%hash)
1135 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1136 my $remaining_exemption = sprintf("%.2f",
1137 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1138 if ( $remaining_exemption > 0 ) {
1139 my $addl = $remaining_exemption > $taxable_per_month
1140 ? $taxable_per_month
1141 : $remaining_exemption;
1142 $taxable_charged -= $addl;
1143 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1144 $cust_tax_exempt->hash,
1145 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1147 $error = $new_cust_tax_exempt->exemptnum
1148 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1149 : $new_cust_tax_exempt->insert;
1151 $dbh->rollback if $oldAutoCommit;
1152 return "fatal: can't update cust_tax_exempt: $error";
1155 } # if $remaining_exemption > 0
1157 } #foreach $which_month
1159 } #if $cust_main_county->exempt_amount
1161 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1163 #$tax += $taxable_charged * $cust_main_county->tax / 100
1164 $tax{ $cust_main_county->taxname || 'Tax' } +=
1165 $taxable_charged * $cust_main_county->tax / 100
1167 } #unless $self->tax =~ /Y/i
1168 # || $self->payby eq 'COMP'
1169 # || $taxable_charged == 0
1171 } #if $setup > 0 || $recur > 0
1173 } #if $cust_pkg_mod_flag
1175 } #foreach my $cust_pkg
1177 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1178 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1180 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1181 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1185 # unless ( $self->tax =~ /Y/i
1186 # || $self->payby eq 'COMP'
1187 # || $taxable_charged == 0 ) {
1188 # my $cust_main_county = qsearchs('cust_main_county',{
1189 # 'state' => $self->state,
1190 # 'county' => $self->county,
1191 # 'country' => $self->country,
1192 # } ) or die "fatal: can't find tax rate for state/county/country ".
1193 # $self->state. "/". $self->county. "/". $self->country. "\n";
1194 # my $tax = sprintf( "%.2f",
1195 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1198 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1199 my $tax = sprintf("%.2f", $tax{$taxname} );
1200 $charged = sprintf( "%.2f", $charged+$tax );
1202 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1208 'itemdesc' => $taxname,
1210 push @cust_bill_pkg, $cust_bill_pkg;
1214 my $cust_bill = new FS::cust_bill ( {
1215 'custnum' => $self->custnum,
1217 'charged' => $charged,
1219 $error = $cust_bill->insert;
1221 $dbh->rollback if $oldAutoCommit;
1222 return "can't create invoice for customer #". $self->custnum. ": $error";
1225 my $invnum = $cust_bill->invnum;
1227 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1229 $cust_bill_pkg->invnum($invnum);
1230 $error = $cust_bill_pkg->insert;
1232 $dbh->rollback if $oldAutoCommit;
1233 return "can't create invoice line item for customer #". $self->custnum.
1238 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1242 =item collect OPTIONS
1244 (Attempt to) collect money for this customer's outstanding invoices (see
1245 L<FS::cust_bill>). Usually used after the bill method.
1247 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1248 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1250 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1251 and the invoice events web interface.
1253 If there is an error, returns the error, otherwise returns false.
1255 Options are passed as name-value pairs.
1257 Currently available options are:
1259 invoice_time - Use this time when deciding when to print invoices and
1260 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>
1261 for conversion functions.
1263 retry_card - Retry cards even when not scheduled by invoice events.
1265 batch_card - This option is deprecated. See the invoice events web interface
1266 to control whether cards are batched or run against a realtime gateway.
1268 report_badcard - This option is deprecated.
1270 force_print - This option is deprecated; see the invoice events web interface.
1275 my( $self, %options ) = @_;
1276 my $invoice_time = $options{'invoice_time'} || time;
1279 local $SIG{HUP} = 'IGNORE';
1280 local $SIG{INT} = 'IGNORE';
1281 local $SIG{QUIT} = 'IGNORE';
1282 local $SIG{TERM} = 'IGNORE';
1283 local $SIG{TSTP} = 'IGNORE';
1284 local $SIG{PIPE} = 'IGNORE';
1286 my $oldAutoCommit = $FS::UID::AutoCommit;
1287 local $FS::UID::AutoCommit = 0;
1290 my $balance = $self->balance;
1291 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1292 unless ( $balance > 0 ) { #redundant?????
1293 $dbh->rollback if $oldAutoCommit; #hmm
1297 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1298 #false laziness w/replace
1299 foreach my $cust_bill_event (
1301 #$_->part_bill_event->plan eq 'realtime-card'
1302 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1303 && $_->status eq 'done'
1306 map { $_->cust_bill_event }
1307 grep { $_->cust_bill_event }
1308 $self->open_cust_bill
1310 my $error = $cust_bill_event->retry;
1312 $dbh->rollback if $oldAutoCommit;
1313 return "error scheduling invoice events for retry: $error";
1319 foreach my $cust_bill ( $self->cust_bill ) {
1321 #this has to be before next's
1322 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1326 $balance = sprintf( "%.2f", $balance - $amount );
1328 next unless $cust_bill->owed > 0;
1330 # don't try to charge for the same invoice if it's already in a batch
1331 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1333 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1335 next unless $amount > 0;
1338 foreach my $part_bill_event (
1339 sort { $a->seconds <=> $b->seconds
1340 || $a->weight <=> $b->weight
1341 || $a->eventpart <=> $b->eventpart }
1342 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1343 && ! qsearchs( 'cust_bill_event', {
1344 'invnum' => $cust_bill->invnum,
1345 'eventpart' => $_->eventpart,
1349 qsearch('part_bill_event', { 'payby' => $self->payby,
1350 'disabled' => '', } )
1353 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1355 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1357 my $cust_main = $self; #for callback
1358 my $error = eval $part_bill_event->eventcode;
1361 my $statustext = '';
1365 } elsif ( $error ) {
1367 $statustext = $error;
1372 #add cust_bill_event
1373 my $cust_bill_event = new FS::cust_bill_event {
1374 'invnum' => $cust_bill->invnum,
1375 'eventpart' => $part_bill_event->eventpart,
1376 #'_date' => $invoice_time,
1378 'status' => $status,
1379 'statustext' => $statustext,
1381 $error = $cust_bill_event->insert;
1383 #$dbh->rollback if $oldAutoCommit;
1384 #return "error: $error";
1386 # gah, even with transactions.
1387 $dbh->commit if $oldAutoCommit; #well.
1388 my $e = 'WARNING: Event run but database not updated - '.
1389 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1390 ', eventpart '. $part_bill_event->eventpart.
1401 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1408 Returns the total owed for this customer on all invoices
1409 (see L<FS::cust_bill/owed>).
1415 $self->total_owed_date(2145859200); #12/31/2037
1418 =item total_owed_date TIME
1420 Returns the total owed for this customer on all invoices with date earlier than
1421 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1422 see L<Time::Local> and L<Date::Parse> for conversion functions.
1426 sub total_owed_date {
1430 foreach my $cust_bill (
1431 grep { $_->_date <= $time }
1432 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1434 $total_bill += $cust_bill->owed;
1436 sprintf( "%.2f", $total_bill );
1441 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1442 to outstanding invoice balances in chronological order and returns the value
1443 of any remaining unapplied credits available for refund
1444 (see L<FS::cust_refund>).
1451 return 0 unless $self->total_credited;
1453 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1454 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1456 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1457 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1461 foreach my $cust_bill ( @invoices ) {
1464 if ( !defined($credit) || $credit->credited == 0) {
1465 $credit = pop @credits or last;
1468 if ($cust_bill->owed >= $credit->credited) {
1469 $amount=$credit->credited;
1471 $amount=$cust_bill->owed;
1474 my $cust_credit_bill = new FS::cust_credit_bill ( {
1475 'crednum' => $credit->crednum,
1476 'invnum' => $cust_bill->invnum,
1477 'amount' => $amount,
1479 my $error = $cust_credit_bill->insert;
1480 die $error if $error;
1482 redo if ($cust_bill->owed > 0);
1486 return $self->total_credited;
1489 =item apply_payments
1491 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1492 to outstanding invoice balances in chronological order.
1494 #and returns the value of any remaining unapplied payments.
1498 sub apply_payments {
1503 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1504 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1506 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1507 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1511 foreach my $cust_bill ( @invoices ) {
1514 if ( !defined($payment) || $payment->unapplied == 0 ) {
1515 $payment = pop @payments or last;
1518 if ( $cust_bill->owed >= $payment->unapplied ) {
1519 $amount = $payment->unapplied;
1521 $amount = $cust_bill->owed;
1524 my $cust_bill_pay = new FS::cust_bill_pay ( {
1525 'paynum' => $payment->paynum,
1526 'invnum' => $cust_bill->invnum,
1527 'amount' => $amount,
1529 my $error = $cust_bill_pay->insert;
1530 die $error if $error;
1532 redo if ( $cust_bill->owed > 0);
1536 return $self->total_unapplied_payments;
1539 =item total_credited
1541 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1542 customer. See L<FS::cust_credit/credited>.
1546 sub total_credited {
1548 my $total_credit = 0;
1549 foreach my $cust_credit ( qsearch('cust_credit', {
1550 'custnum' => $self->custnum,
1552 $total_credit += $cust_credit->credited;
1554 sprintf( "%.2f", $total_credit );
1557 =item total_unapplied_payments
1559 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1560 See L<FS::cust_pay/unapplied>.
1564 sub total_unapplied_payments {
1566 my $total_unapplied = 0;
1567 foreach my $cust_pay ( qsearch('cust_pay', {
1568 'custnum' => $self->custnum,
1570 $total_unapplied += $cust_pay->unapplied;
1572 sprintf( "%.2f", $total_unapplied );
1577 Returns the balance for this customer (total_owed minus total_credited
1578 minus total_unapplied_payments).
1585 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1589 =item balance_date TIME
1591 Returns the balance for this customer, only considering invoices with date
1592 earlier than TIME (total_owed_date minus total_credited minus
1593 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1594 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1603 $self->total_owed_date($time)
1604 - $self->total_credited
1605 - $self->total_unapplied_payments
1609 =item invoicing_list [ ARRAYREF ]
1611 If an arguement is given, sets these email addresses as invoice recipients
1612 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1613 (except as warnings), so use check_invoicing_list first.
1615 Returns a list of email addresses (with svcnum entries expanded).
1617 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1618 check it without disturbing anything by passing nothing.
1620 This interface may change in the future.
1624 sub invoicing_list {
1625 my( $self, $arrayref ) = @_;
1627 my @cust_main_invoice;
1628 if ( $self->custnum ) {
1629 @cust_main_invoice =
1630 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1632 @cust_main_invoice = ();
1634 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1635 #warn $cust_main_invoice->destnum;
1636 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1637 #warn $cust_main_invoice->destnum;
1638 my $error = $cust_main_invoice->delete;
1639 warn $error if $error;
1642 if ( $self->custnum ) {
1643 @cust_main_invoice =
1644 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1646 @cust_main_invoice = ();
1648 my %seen = map { $_->address => 1 } @cust_main_invoice;
1649 foreach my $address ( @{$arrayref} ) {
1650 next if exists $seen{$address} && $seen{$address};
1651 $seen{$address} = 1;
1652 my $cust_main_invoice = new FS::cust_main_invoice ( {
1653 'custnum' => $self->custnum,
1656 my $error = $cust_main_invoice->insert;
1657 warn $error if $error;
1660 if ( $self->custnum ) {
1662 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1668 =item check_invoicing_list ARRAYREF
1670 Checks these arguements as valid input for the invoicing_list method. If there
1671 is an error, returns the error, otherwise returns false.
1675 sub check_invoicing_list {
1676 my( $self, $arrayref ) = @_;
1677 foreach my $address ( @{$arrayref} ) {
1678 my $cust_main_invoice = new FS::cust_main_invoice ( {
1679 'custnum' => $self->custnum,
1682 my $error = $self->custnum
1683 ? $cust_main_invoice->check
1684 : $cust_main_invoice->checkdest
1686 return $error if $error;
1691 =item set_default_invoicing_list
1693 Sets the invoicing list to all accounts associated with this customer,
1694 overwriting any previous invoicing list.
1698 sub set_default_invoicing_list {
1700 $self->invoicing_list($self->all_emails);
1705 Returns the email addresses of all accounts provisioned for this customer.
1712 foreach my $cust_pkg ( $self->all_pkgs ) {
1713 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1715 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1716 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1718 $list{$_}=1 foreach map { $_->email } @svc_acct;
1723 =item invoicing_list_addpost
1725 Adds postal invoicing to this customer. If this customer is already configured
1726 to receive postal invoices, does nothing.
1730 sub invoicing_list_addpost {
1732 return if grep { $_ eq 'POST' } $self->invoicing_list;
1733 my @invoicing_list = $self->invoicing_list;
1734 push @invoicing_list, 'POST';
1735 $self->invoicing_list(\@invoicing_list);
1738 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1740 Returns an array of customers referred by this customer (referral_custnum set
1741 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1742 customers referred by customers referred by this customer and so on, inclusive.
1743 The default behavior is DEPTH 1 (no recursion).
1747 sub referral_cust_main {
1749 my $depth = @_ ? shift : 1;
1750 my $exclude = @_ ? shift : {};
1753 map { $exclude->{$_->custnum}++; $_; }
1754 grep { ! $exclude->{ $_->custnum } }
1755 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1759 map { $_->referral_cust_main($depth-1, $exclude) }
1766 =item referral_cust_main_ncancelled
1768 Same as referral_cust_main, except only returns customers with uncancelled
1773 sub referral_cust_main_ncancelled {
1775 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1778 =item referral_cust_pkg [ DEPTH ]
1780 Like referral_cust_main, except returns a flat list of all unsuspended (and
1781 uncancelled) packages for each customer. The number of items in this list may
1782 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1786 sub referral_cust_pkg {
1788 my $depth = @_ ? shift : 1;
1790 map { $_->unsuspended_pkgs }
1791 grep { $_->unsuspended_pkgs }
1792 $self->referral_cust_main($depth);
1795 =item credit AMOUNT, REASON
1797 Applies a credit to this customer. If there is an error, returns the error,
1798 otherwise returns false.
1803 my( $self, $amount, $reason ) = @_;
1804 my $cust_credit = new FS::cust_credit {
1805 'custnum' => $self->custnum,
1806 'amount' => $amount,
1807 'reason' => $reason,
1809 $cust_credit->insert;
1812 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1814 Creates a one-time charge for this customer. If there is an error, returns
1815 the error, otherwise returns false.
1820 my ( $self, $amount ) = ( shift, shift );
1821 my $pkg = @_ ? shift : 'One-time charge';
1822 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1823 my $taxclass = @_ ? shift : '';
1825 local $SIG{HUP} = 'IGNORE';
1826 local $SIG{INT} = 'IGNORE';
1827 local $SIG{QUIT} = 'IGNORE';
1828 local $SIG{TERM} = 'IGNORE';
1829 local $SIG{TSTP} = 'IGNORE';
1830 local $SIG{PIPE} = 'IGNORE';
1832 my $oldAutoCommit = $FS::UID::AutoCommit;
1833 local $FS::UID::AutoCommit = 0;
1836 my $part_pkg = new FS::part_pkg ( {
1838 'comment' => $comment,
1843 'taxclass' => $taxclass,
1846 my $error = $part_pkg->insert;
1848 $dbh->rollback if $oldAutoCommit;
1852 my $pkgpart = $part_pkg->pkgpart;
1853 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1854 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1855 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1856 $error = $type_pkgs->insert;
1858 $dbh->rollback if $oldAutoCommit;
1863 my $cust_pkg = new FS::cust_pkg ( {
1864 'custnum' => $self->custnum,
1865 'pkgpart' => $pkgpart,
1868 $error = $cust_pkg->insert;
1870 $dbh->rollback if $oldAutoCommit;
1874 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1881 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1887 sort { $a->_date <=> $b->_date }
1888 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1891 =item open_cust_bill
1893 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1898 sub open_cust_bill {
1900 grep { $_->owed > 0 } $self->cust_bill;
1909 =item check_and_rebuild_fuzzyfiles
1913 sub check_and_rebuild_fuzzyfiles {
1914 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1915 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1916 or &rebuild_fuzzyfiles;
1919 =item rebuild_fuzzyfiles
1923 sub rebuild_fuzzyfiles {
1925 use Fcntl qw(:flock);
1927 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1931 open(LASTLOCK,">>$dir/cust_main.last")
1932 or die "can't open $dir/cust_main.last: $!";
1933 flock(LASTLOCK,LOCK_EX)
1934 or die "can't lock $dir/cust_main.last: $!";
1936 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1938 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1939 if defined dbdef->table('cust_main')->column('ship_last');
1941 open (LASTCACHE,">$dir/cust_main.last.tmp")
1942 or die "can't open $dir/cust_main.last.tmp: $!";
1943 print LASTCACHE join("\n", @all_last), "\n";
1944 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1946 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1951 open(COMPANYLOCK,">>$dir/cust_main.company")
1952 or die "can't open $dir/cust_main.company: $!";
1953 flock(COMPANYLOCK,LOCK_EX)
1954 or die "can't lock $dir/cust_main.company: $!";
1956 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1958 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1959 if defined dbdef->table('cust_main')->column('ship_last');
1961 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1962 or die "can't open $dir/cust_main.company.tmp: $!";
1963 print COMPANYCACHE join("\n", @all_company), "\n";
1964 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1966 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1976 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1977 open(LASTCACHE,"<$dir/cust_main.last")
1978 or die "can't open $dir/cust_main.last: $!";
1979 my @array = map { chomp; $_; } <LASTCACHE>;
1989 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1990 open(COMPANYCACHE,"<$dir/cust_main.company")
1991 or die "can't open $dir/cust_main.last: $!";
1992 my @array = map { chomp; $_; } <COMPANYCACHE>;
1997 =item append_fuzzyfiles LASTNAME COMPANY
2001 sub append_fuzzyfiles {
2002 my( $last, $company ) = @_;
2004 &check_and_rebuild_fuzzyfiles;
2006 use Fcntl qw(:flock);
2008 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2012 open(LAST,">>$dir/cust_main.last")
2013 or die "can't open $dir/cust_main.last: $!";
2015 or die "can't lock $dir/cust_main.last: $!";
2017 print LAST "$last\n";
2020 or die "can't unlock $dir/cust_main.last: $!";
2026 open(COMPANY,">>$dir/cust_main.company")
2027 or die "can't open $dir/cust_main.company: $!";
2028 flock(COMPANY,LOCK_EX)
2029 or die "can't lock $dir/cust_main.company: $!";
2031 print COMPANY "$company\n";
2033 flock(COMPANY,LOCK_UN)
2034 or die "can't unlock $dir/cust_main.company: $!";
2048 #warn join('-',keys %$param);
2049 my $fh = $param->{filehandle};
2050 my $agentnum = $param->{agentnum};
2051 my $refnum = $param->{refnum};
2052 my $pkgpart = $param->{pkgpart};
2053 my @fields = @{$param->{fields}};
2055 eval "use Date::Parse;";
2057 eval "use Text::CSV_XS;";
2060 my $csv = new Text::CSV_XS;
2067 local $SIG{HUP} = 'IGNORE';
2068 local $SIG{INT} = 'IGNORE';
2069 local $SIG{QUIT} = 'IGNORE';
2070 local $SIG{TERM} = 'IGNORE';
2071 local $SIG{TSTP} = 'IGNORE';
2072 local $SIG{PIPE} = 'IGNORE';
2074 my $oldAutoCommit = $FS::UID::AutoCommit;
2075 local $FS::UID::AutoCommit = 0;
2078 #while ( $columns = $csv->getline($fh) ) {
2080 while ( defined($line=<$fh>) ) {
2082 $csv->parse($line) or do {
2083 $dbh->rollback if $oldAutoCommit;
2084 return "can't parse: ". $csv->error_input();
2087 my @columns = $csv->fields();
2088 #warn join('-',@columns);
2091 agentnum => $agentnum,
2093 country => 'US', #default
2094 payby => 'BILL', #default
2095 paydate => '12/2037', #default
2097 my $billtime = time;
2098 my %cust_pkg = ( pkgpart => $pkgpart );
2099 foreach my $field ( @fields ) {
2100 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2101 #$cust_pkg{$1} = str2time( shift @$columns );
2102 if ( $1 eq 'setup' ) {
2103 $billtime = str2time(shift @columns);
2105 $cust_pkg{$1} = str2time( shift @columns );
2108 #$cust_main{$field} = shift @$columns;
2109 $cust_main{$field} = shift @columns;
2113 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2114 my $cust_main = new FS::cust_main ( \%cust_main );
2116 tie my %hash, 'Tie::RefHash'; #this part is important
2117 $hash{$cust_pkg} = [] if $pkgpart;
2118 my $error = $cust_main->insert( \%hash );
2121 $dbh->rollback if $oldAutoCommit;
2122 return "can't insert customer for $line: $error";
2125 #false laziness w/bill.cgi
2126 $error = $cust_main->bill( 'time' => $billtime );
2128 $dbh->rollback if $oldAutoCommit;
2129 return "can't bill customer for $line: $error";
2132 $cust_main->apply_payments;
2133 $cust_main->apply_credits;
2135 $error = $cust_main->collect();
2137 $dbh->rollback if $oldAutoCommit;
2138 return "can't collect customer for $line: $error";
2144 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2146 return "Empty file!" unless $imported;
2158 #warn join('-',keys %$param);
2159 my $fh = $param->{filehandle};
2160 my @fields = @{$param->{fields}};
2162 eval "use Date::Parse;";
2164 eval "use Text::CSV_XS;";
2167 my $csv = new Text::CSV_XS;
2174 local $SIG{HUP} = 'IGNORE';
2175 local $SIG{INT} = 'IGNORE';
2176 local $SIG{QUIT} = 'IGNORE';
2177 local $SIG{TERM} = 'IGNORE';
2178 local $SIG{TSTP} = 'IGNORE';
2179 local $SIG{PIPE} = 'IGNORE';
2181 my $oldAutoCommit = $FS::UID::AutoCommit;
2182 local $FS::UID::AutoCommit = 0;
2185 #while ( $columns = $csv->getline($fh) ) {
2187 while ( defined($line=<$fh>) ) {
2189 $csv->parse($line) or do {
2190 $dbh->rollback if $oldAutoCommit;
2191 return "can't parse: ". $csv->error_input();
2194 my @columns = $csv->fields();
2195 #warn join('-',@columns);
2198 foreach my $field ( @fields ) {
2199 $row{$field} = shift @columns;
2202 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2203 unless ( $cust_main ) {
2204 $dbh->rollback if $oldAutoCommit;
2205 return "unknown custnum $row{'custnum'}";
2208 if ( $row{'amount'} > 0 ) {
2209 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2211 $dbh->rollback if $oldAutoCommit;
2215 } elsif ( $row{'amount'} < 0 ) {
2216 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2219 $dbh->rollback if $oldAutoCommit;
2229 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2231 return "Empty file!" unless $imported;
2243 The delete method should possibly take an FS::cust_main object reference
2244 instead of a scalar customer number.
2246 Bill and collect options should probably be passed as references instead of a
2249 There should probably be a configuration file with a list of allowed credit
2252 No multiple currency support (probably a larger project than just this module).
2256 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2257 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2258 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.