4 use vars qw( @ISA $conf $Debug $import );
7 use Time::Local qw(timelocal_nocheck);
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 - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<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|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
704 or return "Illegal payby: ". $self->payby;
707 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
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' || $self->payby eq 'DCHK' ) {
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')
774 || $self->payby !~ /^(CARD|DCRD)$/ )
776 $self->payname( $self->first. " ". $self->getfield('last') );
778 $self->payname =~ /^([\w \,\.\-\']+)$/
779 or return gettext('illegal_name'). " payname: ". $self->payname;
783 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
786 $self->otaker(getotaker);
788 #warn "AFTER: \n". $self->_dump;
795 Returns all packages (see L<FS::cust_pkg>) for this customer.
801 if ( $self->{'_pkgnum'} ) {
802 values %{ $self->{'_pkgnum'}->cache };
804 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
808 =item ncancelled_pkgs
810 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
814 sub ncancelled_pkgs {
816 if ( $self->{'_pkgnum'} ) {
817 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
819 @{ [ # force list context
820 qsearch( 'cust_pkg', {
821 'custnum' => $self->custnum,
824 qsearch( 'cust_pkg', {
825 'custnum' => $self->custnum,
834 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
840 grep { $_->susp } $self->ncancelled_pkgs;
843 =item unflagged_suspended_pkgs
845 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
846 customer (thouse packages without the `manual_flag' set).
850 sub unflagged_suspended_pkgs {
852 return $self->suspended_pkgs
853 unless dbdef->table('cust_pkg')->column('manual_flag');
854 grep { ! $_->manual_flag } $self->suspended_pkgs;
857 =item unsuspended_pkgs
859 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
864 sub unsuspended_pkgs {
866 grep { ! $_->susp } $self->ncancelled_pkgs;
871 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
872 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
873 on success or a list of errors.
879 grep { $_->unsuspend } $self->suspended_pkgs;
884 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
885 Always returns a list: an empty list on success or a list of errors.
891 grep { $_->suspend } $self->unsuspended_pkgs;
896 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
897 Always returns a list: an empty list on success or a list of errors.
903 grep { $_->cancel } $self->ncancelled_pkgs;
908 Returns the agent (see L<FS::agent>) for this customer.
914 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
919 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
920 conjunction with the collect method.
922 Options are passed as name-value pairs.
924 The only currently available option is `time', which bills the customer as if
925 it were that time. It is specified as a UNIX timestamp; see
926 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
927 functions. For example:
931 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
933 If there is an error, returns the error, otherwise returns false.
938 my( $self, %options ) = @_;
939 my $time = $options{'time'} || time;
944 local $SIG{HUP} = 'IGNORE';
945 local $SIG{INT} = 'IGNORE';
946 local $SIG{QUIT} = 'IGNORE';
947 local $SIG{TERM} = 'IGNORE';
948 local $SIG{TSTP} = 'IGNORE';
949 local $SIG{PIPE} = 'IGNORE';
951 my $oldAutoCommit = $FS::UID::AutoCommit;
952 local $FS::UID::AutoCommit = 0;
955 # find the packages which are due for billing, find out how much they are
956 # & generate invoice database.
958 my( $total_setup, $total_recur ) = ( 0, 0 );
959 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
960 my @cust_bill_pkg = ();
962 #my $taxable_charged = 0;##
967 foreach my $cust_pkg (
968 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
971 #NO!! next if $cust_pkg->cancel;
972 next if $cust_pkg->getfield('cancel');
974 #? to avoid use of uninitialized value errors... ?
975 $cust_pkg->setfield('bill', '')
976 unless defined($cust_pkg->bill);
978 my $part_pkg = $cust_pkg->part_pkg;
980 #so we don't modify cust_pkg record unnecessarily
981 my $cust_pkg_mod_flag = 0;
982 my %hash = $cust_pkg->hash;
983 my $old_cust_pkg = new FS::cust_pkg \%hash;
989 unless ( $cust_pkg->setup ) {
990 my $setup_prog = $part_pkg->getfield('setup');
991 $setup_prog =~ /^(.*)$/ or do {
992 $dbh->rollback if $oldAutoCommit;
993 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
997 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1000 ##$cpt->permit(); #what is necessary?
1001 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1002 #$setup = $cpt->reval($setup_prog);
1003 $setup = eval $setup_prog;
1004 unless ( defined($setup) ) {
1005 $dbh->rollback if $oldAutoCommit;
1006 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1007 "(expression $setup_prog): $@";
1009 $cust_pkg->setfield('setup',$time);
1010 $cust_pkg_mod_flag=1;
1016 if ( $part_pkg->getfield('freq') > 0 &&
1017 ! $cust_pkg->getfield('susp') &&
1018 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1020 my $recur_prog = $part_pkg->getfield('recur');
1021 $recur_prog =~ /^(.*)$/ or do {
1022 $dbh->rollback if $oldAutoCommit;
1023 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1027 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1029 # shared with $recur_prog
1030 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1032 #my $cpt = new Safe;
1033 ##$cpt->permit(); #what is necessary?
1034 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1035 #$recur = $cpt->reval($recur_prog);
1036 $recur = eval $recur_prog;
1037 unless ( defined($recur) ) {
1038 $dbh->rollback if $oldAutoCommit;
1039 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1040 "(expression $recur_prog): $@";
1042 #change this bit to use Date::Manip? CAREFUL with timezones (see
1043 # mailing list archive)
1044 my ($sec,$min,$hour,$mday,$mon,$year) =
1045 (localtime($sdate) )[0,1,2,3,4,5];
1047 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1048 # only for figuring next bill date, nothing else, so, reset $sdate again
1050 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1051 $cust_pkg->last_bill($sdate)
1052 if $cust_pkg->dbdef_table->column('last_bill');
1054 $mon += $part_pkg->freq;
1055 until ( $mon < 12 ) { $mon -= 12; $year++; }
1056 $cust_pkg->setfield('bill',
1057 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1058 $cust_pkg_mod_flag = 1;
1061 warn "\$setup is undefined" unless defined($setup);
1062 warn "\$recur is undefined" unless defined($recur);
1063 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1065 my $taxable_charged = 0;
1066 if ( $cust_pkg_mod_flag ) {
1067 $error=$cust_pkg->replace($old_cust_pkg);
1068 if ( $error ) { #just in case
1069 $dbh->rollback if $oldAutoCommit;
1070 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1072 $setup = sprintf( "%.2f", $setup );
1073 $recur = sprintf( "%.2f", $recur );
1075 $dbh->rollback if $oldAutoCommit;
1076 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1079 $dbh->rollback if $oldAutoCommit;
1080 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1082 if ( $setup > 0 || $recur > 0 ) {
1083 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1084 'pkgnum' => $cust_pkg->pkgnum,
1088 'edate' => $cust_pkg->bill,
1089 'details' => \@details,
1091 push @cust_bill_pkg, $cust_bill_pkg;
1092 $total_setup += $setup;
1093 $total_recur += $recur;
1094 $taxable_charged += $setup
1095 unless $part_pkg->setuptax =~ /^Y$/i;
1096 $taxable_charged += $recur
1097 unless $part_pkg->recurtax =~ /^Y$/i;
1099 unless ( $self->tax =~ /Y/i
1100 || $self->payby eq 'COMP'
1101 || $taxable_charged == 0 ) {
1103 my $cust_main_county = qsearchs('cust_main_county',{
1104 'state' => $self->state,
1105 'county' => $self->county,
1106 'country' => $self->country,
1107 'taxclass' => $part_pkg->taxclass,
1109 $cust_main_county ||= qsearchs('cust_main_county',{
1110 'state' => $self->state,
1111 'county' => $self->county,
1112 'country' => $self->country,
1115 unless ( $cust_main_county ) {
1116 $dbh->rollback if $oldAutoCommit;
1118 "fatal: can't find tax rate for state/county/country/taxclass ".
1119 join('/', ( map $self->$_(), qw(state county country) ),
1120 $part_pkg->taxclass ). "\n";
1123 if ( $cust_main_county->exempt_amount ) {
1124 my ($mon,$year) = (localtime($sdate) )[4,5];
1126 my $freq = $part_pkg->freq || 1;
1127 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1128 foreach my $which_month ( 1 .. $freq ) {
1130 'custnum' => $self->custnum,
1131 'taxnum' => $cust_main_county->taxnum,
1132 'year' => 1900+$year,
1135 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1136 until ( $mon < 13 ) { $mon -= 12; $year++; }
1137 my $cust_tax_exempt =
1138 qsearchs('cust_tax_exempt', \%hash)
1139 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1140 my $remaining_exemption = sprintf("%.2f",
1141 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1142 if ( $remaining_exemption > 0 ) {
1143 my $addl = $remaining_exemption > $taxable_per_month
1144 ? $taxable_per_month
1145 : $remaining_exemption;
1146 $taxable_charged -= $addl;
1147 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1148 $cust_tax_exempt->hash,
1149 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1151 $error = $new_cust_tax_exempt->exemptnum
1152 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1153 : $new_cust_tax_exempt->insert;
1155 $dbh->rollback if $oldAutoCommit;
1156 return "fatal: can't update cust_tax_exempt: $error";
1159 } # if $remaining_exemption > 0
1161 } #foreach $which_month
1163 } #if $cust_main_county->exempt_amount
1165 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1167 #$tax += $taxable_charged * $cust_main_county->tax / 100
1168 $tax{ $cust_main_county->taxname || 'Tax' } +=
1169 $taxable_charged * $cust_main_county->tax / 100
1171 } #unless $self->tax =~ /Y/i
1172 # || $self->payby eq 'COMP'
1173 # || $taxable_charged == 0
1175 } #if $setup > 0 || $recur > 0
1177 } #if $cust_pkg_mod_flag
1179 } #foreach my $cust_pkg
1181 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1182 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1184 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1185 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1189 # unless ( $self->tax =~ /Y/i
1190 # || $self->payby eq 'COMP'
1191 # || $taxable_charged == 0 ) {
1192 # my $cust_main_county = qsearchs('cust_main_county',{
1193 # 'state' => $self->state,
1194 # 'county' => $self->county,
1195 # 'country' => $self->country,
1196 # } ) or die "fatal: can't find tax rate for state/county/country ".
1197 # $self->state. "/". $self->county. "/". $self->country. "\n";
1198 # my $tax = sprintf( "%.2f",
1199 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1202 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1203 my $tax = sprintf("%.2f", $tax{$taxname} );
1204 $charged = sprintf( "%.2f", $charged+$tax );
1206 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1212 'itemdesc' => $taxname,
1214 push @cust_bill_pkg, $cust_bill_pkg;
1218 my $cust_bill = new FS::cust_bill ( {
1219 'custnum' => $self->custnum,
1221 'charged' => $charged,
1223 $error = $cust_bill->insert;
1225 $dbh->rollback if $oldAutoCommit;
1226 return "can't create invoice for customer #". $self->custnum. ": $error";
1229 my $invnum = $cust_bill->invnum;
1231 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1233 $cust_bill_pkg->invnum($invnum);
1234 $error = $cust_bill_pkg->insert;
1236 $dbh->rollback if $oldAutoCommit;
1237 return "can't create invoice line item for customer #". $self->custnum.
1242 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1246 =item collect OPTIONS
1248 (Attempt to) collect money for this customer's outstanding invoices (see
1249 L<FS::cust_bill>). Usually used after the bill method.
1251 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1252 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1253 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1255 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1256 and the invoice events web interface.
1258 If there is an error, returns the error, otherwise returns false.
1260 Options are passed as name-value pairs.
1262 Currently available options are:
1264 invoice_time - Use this time when deciding when to print invoices and
1265 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>
1266 for conversion functions.
1268 retry_card - Retry cards even when not scheduled by invoice events.
1270 batch_card - This option is deprecated. See the invoice events web interface
1271 to control whether cards are batched or run against a realtime gateway.
1273 report_badcard - This option is deprecated.
1275 force_print - This option is deprecated; see the invoice events web interface.
1280 my( $self, %options ) = @_;
1281 my $invoice_time = $options{'invoice_time'} || time;
1284 local $SIG{HUP} = 'IGNORE';
1285 local $SIG{INT} = 'IGNORE';
1286 local $SIG{QUIT} = 'IGNORE';
1287 local $SIG{TERM} = 'IGNORE';
1288 local $SIG{TSTP} = 'IGNORE';
1289 local $SIG{PIPE} = 'IGNORE';
1291 my $oldAutoCommit = $FS::UID::AutoCommit;
1292 local $FS::UID::AutoCommit = 0;
1295 my $balance = $self->balance;
1296 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1297 unless ( $balance > 0 ) { #redundant?????
1298 $dbh->rollback if $oldAutoCommit; #hmm
1302 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1303 #false laziness w/replace
1304 foreach my $cust_bill_event (
1306 #$_->part_bill_event->plan eq 'realtime-card'
1307 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1308 && $_->status eq 'done'
1311 map { $_->cust_bill_event }
1312 grep { $_->cust_bill_event }
1313 $self->open_cust_bill
1315 my $error = $cust_bill_event->retry;
1317 $dbh->rollback if $oldAutoCommit;
1318 return "error scheduling invoice events for retry: $error";
1324 foreach my $cust_bill ( $self->cust_bill ) {
1326 #this has to be before next's
1327 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1331 $balance = sprintf( "%.2f", $balance - $amount );
1333 next unless $cust_bill->owed > 0;
1335 # don't try to charge for the same invoice if it's already in a batch
1336 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1338 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1340 next unless $amount > 0;
1343 foreach my $part_bill_event (
1344 sort { $a->seconds <=> $b->seconds
1345 || $a->weight <=> $b->weight
1346 || $a->eventpart <=> $b->eventpart }
1347 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1348 && ! qsearchs( 'cust_bill_event', {
1349 'invnum' => $cust_bill->invnum,
1350 'eventpart' => $_->eventpart,
1354 qsearch('part_bill_event', { 'payby' => $self->payby,
1355 'disabled' => '', } )
1358 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1360 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1362 my $cust_main = $self; #for callback
1363 my $error = eval $part_bill_event->eventcode;
1366 my $statustext = '';
1370 } elsif ( $error ) {
1372 $statustext = $error;
1377 #add cust_bill_event
1378 my $cust_bill_event = new FS::cust_bill_event {
1379 'invnum' => $cust_bill->invnum,
1380 'eventpart' => $part_bill_event->eventpart,
1381 #'_date' => $invoice_time,
1383 'status' => $status,
1384 'statustext' => $statustext,
1386 $error = $cust_bill_event->insert;
1388 #$dbh->rollback if $oldAutoCommit;
1389 #return "error: $error";
1391 # gah, even with transactions.
1392 $dbh->commit if $oldAutoCommit; #well.
1393 my $e = 'WARNING: Event run but database not updated - '.
1394 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1395 ', eventpart '. $part_bill_event->eventpart.
1406 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1413 Returns the total owed for this customer on all invoices
1414 (see L<FS::cust_bill/owed>).
1420 $self->total_owed_date(2145859200); #12/31/2037
1423 =item total_owed_date TIME
1425 Returns the total owed for this customer on all invoices with date earlier than
1426 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1427 see L<Time::Local> and L<Date::Parse> for conversion functions.
1431 sub total_owed_date {
1435 foreach my $cust_bill (
1436 grep { $_->_date <= $time }
1437 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1439 $total_bill += $cust_bill->owed;
1441 sprintf( "%.2f", $total_bill );
1446 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1447 to outstanding invoice balances in chronological order and returns the value
1448 of any remaining unapplied credits available for refund
1449 (see L<FS::cust_refund>).
1456 return 0 unless $self->total_credited;
1458 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1459 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1461 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1462 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1466 foreach my $cust_bill ( @invoices ) {
1469 if ( !defined($credit) || $credit->credited == 0) {
1470 $credit = pop @credits or last;
1473 if ($cust_bill->owed >= $credit->credited) {
1474 $amount=$credit->credited;
1476 $amount=$cust_bill->owed;
1479 my $cust_credit_bill = new FS::cust_credit_bill ( {
1480 'crednum' => $credit->crednum,
1481 'invnum' => $cust_bill->invnum,
1482 'amount' => $amount,
1484 my $error = $cust_credit_bill->insert;
1485 die $error if $error;
1487 redo if ($cust_bill->owed > 0);
1491 return $self->total_credited;
1494 =item apply_payments
1496 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1497 to outstanding invoice balances in chronological order.
1499 #and returns the value of any remaining unapplied payments.
1503 sub apply_payments {
1508 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1509 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1511 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1512 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1516 foreach my $cust_bill ( @invoices ) {
1519 if ( !defined($payment) || $payment->unapplied == 0 ) {
1520 $payment = pop @payments or last;
1523 if ( $cust_bill->owed >= $payment->unapplied ) {
1524 $amount = $payment->unapplied;
1526 $amount = $cust_bill->owed;
1529 my $cust_bill_pay = new FS::cust_bill_pay ( {
1530 'paynum' => $payment->paynum,
1531 'invnum' => $cust_bill->invnum,
1532 'amount' => $amount,
1534 my $error = $cust_bill_pay->insert;
1535 die $error if $error;
1537 redo if ( $cust_bill->owed > 0);
1541 return $self->total_unapplied_payments;
1544 =item total_credited
1546 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1547 customer. See L<FS::cust_credit/credited>.
1551 sub total_credited {
1553 my $total_credit = 0;
1554 foreach my $cust_credit ( qsearch('cust_credit', {
1555 'custnum' => $self->custnum,
1557 $total_credit += $cust_credit->credited;
1559 sprintf( "%.2f", $total_credit );
1562 =item total_unapplied_payments
1564 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1565 See L<FS::cust_pay/unapplied>.
1569 sub total_unapplied_payments {
1571 my $total_unapplied = 0;
1572 foreach my $cust_pay ( qsearch('cust_pay', {
1573 'custnum' => $self->custnum,
1575 $total_unapplied += $cust_pay->unapplied;
1577 sprintf( "%.2f", $total_unapplied );
1582 Returns the balance for this customer (total_owed minus total_credited
1583 minus total_unapplied_payments).
1590 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1594 =item balance_date TIME
1596 Returns the balance for this customer, only considering invoices with date
1597 earlier than TIME (total_owed_date minus total_credited minus
1598 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1599 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1608 $self->total_owed_date($time)
1609 - $self->total_credited
1610 - $self->total_unapplied_payments
1614 =item invoicing_list [ ARRAYREF ]
1616 If an arguement is given, sets these email addresses as invoice recipients
1617 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1618 (except as warnings), so use check_invoicing_list first.
1620 Returns a list of email addresses (with svcnum entries expanded).
1622 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1623 check it without disturbing anything by passing nothing.
1625 This interface may change in the future.
1629 sub invoicing_list {
1630 my( $self, $arrayref ) = @_;
1632 my @cust_main_invoice;
1633 if ( $self->custnum ) {
1634 @cust_main_invoice =
1635 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1637 @cust_main_invoice = ();
1639 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1640 #warn $cust_main_invoice->destnum;
1641 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1642 #warn $cust_main_invoice->destnum;
1643 my $error = $cust_main_invoice->delete;
1644 warn $error if $error;
1647 if ( $self->custnum ) {
1648 @cust_main_invoice =
1649 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1651 @cust_main_invoice = ();
1653 my %seen = map { $_->address => 1 } @cust_main_invoice;
1654 foreach my $address ( @{$arrayref} ) {
1655 next if exists $seen{$address} && $seen{$address};
1656 $seen{$address} = 1;
1657 my $cust_main_invoice = new FS::cust_main_invoice ( {
1658 'custnum' => $self->custnum,
1661 my $error = $cust_main_invoice->insert;
1662 warn $error if $error;
1665 if ( $self->custnum ) {
1667 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1673 =item check_invoicing_list ARRAYREF
1675 Checks these arguements as valid input for the invoicing_list method. If there
1676 is an error, returns the error, otherwise returns false.
1680 sub check_invoicing_list {
1681 my( $self, $arrayref ) = @_;
1682 foreach my $address ( @{$arrayref} ) {
1683 my $cust_main_invoice = new FS::cust_main_invoice ( {
1684 'custnum' => $self->custnum,
1687 my $error = $self->custnum
1688 ? $cust_main_invoice->check
1689 : $cust_main_invoice->checkdest
1691 return $error if $error;
1696 =item set_default_invoicing_list
1698 Sets the invoicing list to all accounts associated with this customer,
1699 overwriting any previous invoicing list.
1703 sub set_default_invoicing_list {
1705 $self->invoicing_list($self->all_emails);
1710 Returns the email addresses of all accounts provisioned for this customer.
1717 foreach my $cust_pkg ( $self->all_pkgs ) {
1718 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1720 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1721 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1723 $list{$_}=1 foreach map { $_->email } @svc_acct;
1728 =item invoicing_list_addpost
1730 Adds postal invoicing to this customer. If this customer is already configured
1731 to receive postal invoices, does nothing.
1735 sub invoicing_list_addpost {
1737 return if grep { $_ eq 'POST' } $self->invoicing_list;
1738 my @invoicing_list = $self->invoicing_list;
1739 push @invoicing_list, 'POST';
1740 $self->invoicing_list(\@invoicing_list);
1743 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1745 Returns an array of customers referred by this customer (referral_custnum set
1746 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1747 customers referred by customers referred by this customer and so on, inclusive.
1748 The default behavior is DEPTH 1 (no recursion).
1752 sub referral_cust_main {
1754 my $depth = @_ ? shift : 1;
1755 my $exclude = @_ ? shift : {};
1758 map { $exclude->{$_->custnum}++; $_; }
1759 grep { ! $exclude->{ $_->custnum } }
1760 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1764 map { $_->referral_cust_main($depth-1, $exclude) }
1771 =item referral_cust_main_ncancelled
1773 Same as referral_cust_main, except only returns customers with uncancelled
1778 sub referral_cust_main_ncancelled {
1780 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1783 =item referral_cust_pkg [ DEPTH ]
1785 Like referral_cust_main, except returns a flat list of all unsuspended (and
1786 uncancelled) packages for each customer. The number of items in this list may
1787 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1791 sub referral_cust_pkg {
1793 my $depth = @_ ? shift : 1;
1795 map { $_->unsuspended_pkgs }
1796 grep { $_->unsuspended_pkgs }
1797 $self->referral_cust_main($depth);
1800 =item credit AMOUNT, REASON
1802 Applies a credit to this customer. If there is an error, returns the error,
1803 otherwise returns false.
1808 my( $self, $amount, $reason ) = @_;
1809 my $cust_credit = new FS::cust_credit {
1810 'custnum' => $self->custnum,
1811 'amount' => $amount,
1812 'reason' => $reason,
1814 $cust_credit->insert;
1817 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1819 Creates a one-time charge for this customer. If there is an error, returns
1820 the error, otherwise returns false.
1825 my ( $self, $amount ) = ( shift, shift );
1826 my $pkg = @_ ? shift : 'One-time charge';
1827 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1828 my $taxclass = @_ ? shift : '';
1830 local $SIG{HUP} = 'IGNORE';
1831 local $SIG{INT} = 'IGNORE';
1832 local $SIG{QUIT} = 'IGNORE';
1833 local $SIG{TERM} = 'IGNORE';
1834 local $SIG{TSTP} = 'IGNORE';
1835 local $SIG{PIPE} = 'IGNORE';
1837 my $oldAutoCommit = $FS::UID::AutoCommit;
1838 local $FS::UID::AutoCommit = 0;
1841 my $part_pkg = new FS::part_pkg ( {
1843 'comment' => $comment,
1848 'taxclass' => $taxclass,
1851 my $error = $part_pkg->insert;
1853 $dbh->rollback if $oldAutoCommit;
1857 my $pkgpart = $part_pkg->pkgpart;
1858 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1859 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1860 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1861 $error = $type_pkgs->insert;
1863 $dbh->rollback if $oldAutoCommit;
1868 my $cust_pkg = new FS::cust_pkg ( {
1869 'custnum' => $self->custnum,
1870 'pkgpart' => $pkgpart,
1873 $error = $cust_pkg->insert;
1875 $dbh->rollback if $oldAutoCommit;
1879 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1886 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1892 sort { $a->_date <=> $b->_date }
1893 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1896 =item open_cust_bill
1898 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1903 sub open_cust_bill {
1905 grep { $_->owed > 0 } $self->cust_bill;
1914 =item check_and_rebuild_fuzzyfiles
1918 sub check_and_rebuild_fuzzyfiles {
1919 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1920 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1921 or &rebuild_fuzzyfiles;
1924 =item rebuild_fuzzyfiles
1928 sub rebuild_fuzzyfiles {
1930 use Fcntl qw(:flock);
1932 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1936 open(LASTLOCK,">>$dir/cust_main.last")
1937 or die "can't open $dir/cust_main.last: $!";
1938 flock(LASTLOCK,LOCK_EX)
1939 or die "can't lock $dir/cust_main.last: $!";
1941 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1943 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1944 if defined dbdef->table('cust_main')->column('ship_last');
1946 open (LASTCACHE,">$dir/cust_main.last.tmp")
1947 or die "can't open $dir/cust_main.last.tmp: $!";
1948 print LASTCACHE join("\n", @all_last), "\n";
1949 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1951 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1956 open(COMPANYLOCK,">>$dir/cust_main.company")
1957 or die "can't open $dir/cust_main.company: $!";
1958 flock(COMPANYLOCK,LOCK_EX)
1959 or die "can't lock $dir/cust_main.company: $!";
1961 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1963 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1964 if defined dbdef->table('cust_main')->column('ship_last');
1966 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1967 or die "can't open $dir/cust_main.company.tmp: $!";
1968 print COMPANYCACHE join("\n", @all_company), "\n";
1969 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1971 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1981 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1982 open(LASTCACHE,"<$dir/cust_main.last")
1983 or die "can't open $dir/cust_main.last: $!";
1984 my @array = map { chomp; $_; } <LASTCACHE>;
1994 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1995 open(COMPANYCACHE,"<$dir/cust_main.company")
1996 or die "can't open $dir/cust_main.last: $!";
1997 my @array = map { chomp; $_; } <COMPANYCACHE>;
2002 =item append_fuzzyfiles LASTNAME COMPANY
2006 sub append_fuzzyfiles {
2007 my( $last, $company ) = @_;
2009 &check_and_rebuild_fuzzyfiles;
2011 use Fcntl qw(:flock);
2013 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2017 open(LAST,">>$dir/cust_main.last")
2018 or die "can't open $dir/cust_main.last: $!";
2020 or die "can't lock $dir/cust_main.last: $!";
2022 print LAST "$last\n";
2025 or die "can't unlock $dir/cust_main.last: $!";
2031 open(COMPANY,">>$dir/cust_main.company")
2032 or die "can't open $dir/cust_main.company: $!";
2033 flock(COMPANY,LOCK_EX)
2034 or die "can't lock $dir/cust_main.company: $!";
2036 print COMPANY "$company\n";
2038 flock(COMPANY,LOCK_UN)
2039 or die "can't unlock $dir/cust_main.company: $!";
2053 #warn join('-',keys %$param);
2054 my $fh = $param->{filehandle};
2055 my $agentnum = $param->{agentnum};
2056 my $refnum = $param->{refnum};
2057 my $pkgpart = $param->{pkgpart};
2058 my @fields = @{$param->{fields}};
2060 eval "use Date::Parse;";
2062 eval "use Text::CSV_XS;";
2065 my $csv = new Text::CSV_XS;
2072 local $SIG{HUP} = 'IGNORE';
2073 local $SIG{INT} = 'IGNORE';
2074 local $SIG{QUIT} = 'IGNORE';
2075 local $SIG{TERM} = 'IGNORE';
2076 local $SIG{TSTP} = 'IGNORE';
2077 local $SIG{PIPE} = 'IGNORE';
2079 my $oldAutoCommit = $FS::UID::AutoCommit;
2080 local $FS::UID::AutoCommit = 0;
2083 #while ( $columns = $csv->getline($fh) ) {
2085 while ( defined($line=<$fh>) ) {
2087 $csv->parse($line) or do {
2088 $dbh->rollback if $oldAutoCommit;
2089 return "can't parse: ". $csv->error_input();
2092 my @columns = $csv->fields();
2093 #warn join('-',@columns);
2096 agentnum => $agentnum,
2098 country => 'US', #default
2099 payby => 'BILL', #default
2100 paydate => '12/2037', #default
2102 my $billtime = time;
2103 my %cust_pkg = ( pkgpart => $pkgpart );
2104 foreach my $field ( @fields ) {
2105 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2106 #$cust_pkg{$1} = str2time( shift @$columns );
2107 if ( $1 eq 'setup' ) {
2108 $billtime = str2time(shift @columns);
2110 $cust_pkg{$1} = str2time( shift @columns );
2113 #$cust_main{$field} = shift @$columns;
2114 $cust_main{$field} = shift @columns;
2118 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2119 my $cust_main = new FS::cust_main ( \%cust_main );
2121 tie my %hash, 'Tie::RefHash'; #this part is important
2122 $hash{$cust_pkg} = [] if $pkgpart;
2123 my $error = $cust_main->insert( \%hash );
2126 $dbh->rollback if $oldAutoCommit;
2127 return "can't insert customer for $line: $error";
2130 #false laziness w/bill.cgi
2131 $error = $cust_main->bill( 'time' => $billtime );
2133 $dbh->rollback if $oldAutoCommit;
2134 return "can't bill customer for $line: $error";
2137 $cust_main->apply_payments;
2138 $cust_main->apply_credits;
2140 $error = $cust_main->collect();
2142 $dbh->rollback if $oldAutoCommit;
2143 return "can't collect customer for $line: $error";
2149 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2151 return "Empty file!" unless $imported;
2163 #warn join('-',keys %$param);
2164 my $fh = $param->{filehandle};
2165 my @fields = @{$param->{fields}};
2167 eval "use Date::Parse;";
2169 eval "use Text::CSV_XS;";
2172 my $csv = new Text::CSV_XS;
2179 local $SIG{HUP} = 'IGNORE';
2180 local $SIG{INT} = 'IGNORE';
2181 local $SIG{QUIT} = 'IGNORE';
2182 local $SIG{TERM} = 'IGNORE';
2183 local $SIG{TSTP} = 'IGNORE';
2184 local $SIG{PIPE} = 'IGNORE';
2186 my $oldAutoCommit = $FS::UID::AutoCommit;
2187 local $FS::UID::AutoCommit = 0;
2190 #while ( $columns = $csv->getline($fh) ) {
2192 while ( defined($line=<$fh>) ) {
2194 $csv->parse($line) or do {
2195 $dbh->rollback if $oldAutoCommit;
2196 return "can't parse: ". $csv->error_input();
2199 my @columns = $csv->fields();
2200 #warn join('-',@columns);
2203 foreach my $field ( @fields ) {
2204 $row{$field} = shift @columns;
2207 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2208 unless ( $cust_main ) {
2209 $dbh->rollback if $oldAutoCommit;
2210 return "unknown custnum $row{'custnum'}";
2213 if ( $row{'amount'} > 0 ) {
2214 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2216 $dbh->rollback if $oldAutoCommit;
2220 } elsif ( $row{'amount'} < 0 ) {
2221 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2224 $dbh->rollback if $oldAutoCommit;
2234 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2236 return "Empty file!" unless $imported;
2248 The delete method should possibly take an FS::cust_main object reference
2249 instead of a scalar customer number.
2251 Bill and collect options should probably be passed as references instead of a
2254 There should probably be a configuration file with a list of allowed credit
2257 No multiple currency support (probably a larger project than just this module).
2261 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2262 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2263 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.