4 use vars qw( @ISA $conf $Debug $import );
8 eval "use Time::Local;";
9 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
10 if $] < 5.006 && !defined($Time::Local::VERSION);
11 eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 use Business::CreditCard;
16 use FS::UID qw( getotaker dbh );
17 use FS::Record qw( qsearchs qsearch dbdef );
20 use FS::cust_bill_pkg;
23 use FS::part_referral;
24 use FS::cust_main_county;
26 use FS::cust_main_invoice;
27 use FS::cust_credit_bill;
28 use FS::cust_bill_pay;
29 use FS::prepay_credit;
32 use FS::part_bill_event;
33 use FS::cust_bill_event;
34 use FS::cust_tax_exempt;
36 use FS::Msgcat qw(gettext);
38 @ISA = qw( FS::Record );
45 #ask FS::UID to run this stuff for us later
46 $FS::UID::callback{'FS::cust_main'} = sub {
48 #yes, need it for stuff below (prolly should be cached)
53 my ( $hashref, $cache ) = @_;
54 if ( exists $hashref->{'pkgnum'} ) {
55 # #@{ $self->{'_pkgnum'} } = ();
56 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
57 $self->{'_pkgnum'} = $subcache;
58 #push @{ $self->{'_pkgnum'} },
59 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
65 FS::cust_main - Object methods for cust_main records
71 $record = new FS::cust_main \%hash;
72 $record = new FS::cust_main { 'column' => 'value' };
74 $error = $record->insert;
76 $error = $new_record->replace($old_record);
78 $error = $record->delete;
80 $error = $record->check;
82 @cust_pkg = $record->all_pkgs;
84 @cust_pkg = $record->ncancelled_pkgs;
86 @cust_pkg = $record->suspended_pkgs;
88 $error = $record->bill;
89 $error = $record->bill %options;
90 $error = $record->bill 'time' => $time;
92 $error = $record->collect;
93 $error = $record->collect %options;
94 $error = $record->collect 'invoice_time' => $time,
95 'batch_card' => 'yes',
96 'report_badcard' => 'yes',
101 An FS::cust_main object represents a customer. FS::cust_main inherits from
102 FS::Record. The following fields are currently supported:
106 =item custnum - primary key (assigned automatically for new customers)
108 =item agentnum - agent (see L<FS::agent>)
110 =item refnum - Advertising source (see L<FS::part_referral>)
116 =item ss - social security number (optional)
118 =item company - (optional)
122 =item address2 - (optional)
126 =item county - (optional, see L<FS::cust_main_county>)
128 =item state - (see L<FS::cust_main_county>)
132 =item country - (see L<FS::cust_main_county>)
134 =item daytime - phone (optional)
136 =item night - phone (optional)
138 =item fax - phone (optional)
140 =item ship_first - name
142 =item ship_last - name
144 =item ship_company - (optional)
148 =item ship_address2 - (optional)
152 =item ship_county - (optional, see L<FS::cust_main_county>)
154 =item ship_state - (see L<FS::cust_main_county>)
158 =item ship_country - (see L<FS::cust_main_county>)
160 =item ship_daytime - phone (optional)
162 =item ship_night - phone (optional)
164 =item ship_fax - phone (optional)
166 =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)
168 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
170 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
172 =item payname - name on card or billing name
174 =item tax - tax exempt, empty or `Y'
176 =item otaker - order taker (assigned automatically, see L<FS::UID>)
178 =item comments - comments (optional)
188 Creates a new customer. To add the customer to the database, see L<"insert">.
190 Note that this stores the hash reference, not a distinct copy of the hash it
191 points to. You can ask the object for a copy with the I<hash> method.
195 sub table { 'cust_main'; }
197 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
199 Adds this customer to the database. If there is an error, returns the error,
200 otherwise returns false.
202 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
203 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
204 are inserted atomicly, or the transaction is rolled back. Passing an empty
205 hash reference is equivalent to not supplying this parameter. There should be
206 a better explanation of this, but until then, here's an example:
209 tie %hash, 'Tie::RefHash'; #this part is important
211 $cust_pkg => [ $svc_acct ],
214 $cust_main->insert( \%hash );
216 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
217 be set as the invoicing list (see L<"invoicing_list">). Errors return as
218 expected and rollback the entire transaction; it is not necessary to call
219 check_invoicing_list first. The invoicing_list is set after the records in the
220 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
221 invoicing_list destination to the newly-created svc_acct. Here's an example:
223 $cust_main->insert( {}, [ $email, 'POST' ] );
225 Currently available options are: I<noexport>
227 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
228 (You can schedule them later with the B<reexport> method.)
234 my $cust_pkgs = @_ ? shift : {};
235 my $invoicing_list = @_ ? shift : '';
238 local $SIG{HUP} = 'IGNORE';
239 local $SIG{INT} = 'IGNORE';
240 local $SIG{QUIT} = 'IGNORE';
241 local $SIG{TERM} = 'IGNORE';
242 local $SIG{TSTP} = 'IGNORE';
243 local $SIG{PIPE} = 'IGNORE';
245 my $oldAutoCommit = $FS::UID::AutoCommit;
246 local $FS::UID::AutoCommit = 0;
251 if ( $self->payby eq 'PREPAY' ) {
252 $self->payby('BILL');
253 my $prepay_credit = qsearchs(
255 { 'identifier' => $self->payinfo },
259 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
260 unless $prepay_credit;
261 $amount = $prepay_credit->amount;
262 $seconds = $prepay_credit->seconds;
263 my $error = $prepay_credit->delete;
265 $dbh->rollback if $oldAutoCommit;
266 return "removing prepay_credit (transaction rolled back): $error";
270 my $error = $self->SUPER::insert;
272 $dbh->rollback if $oldAutoCommit;
273 #return "inserting cust_main record (transaction rolled back): $error";
278 if ( $invoicing_list ) {
279 $error = $self->check_invoicing_list( $invoicing_list );
281 $dbh->rollback if $oldAutoCommit;
282 return "checking invoicing_list (transaction rolled back): $error";
284 $self->invoicing_list( $invoicing_list );
288 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
289 foreach my $cust_pkg ( keys %$cust_pkgs ) {
290 $cust_pkg->custnum( $self->custnum );
291 $error = $cust_pkg->insert;
293 $dbh->rollback if $oldAutoCommit;
294 return "inserting cust_pkg (transaction rolled back): $error";
296 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
297 $svc_something->pkgnum( $cust_pkg->pkgnum );
298 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
299 $svc_something->seconds( $svc_something->seconds + $seconds );
302 $error = $svc_something->insert;
304 $dbh->rollback if $oldAutoCommit;
305 #return "inserting svc_ (transaction rolled back): $error";
312 $dbh->rollback if $oldAutoCommit;
313 return "No svc_acct record to apply pre-paid time";
317 my $cust_credit = new FS::cust_credit {
318 'custnum' => $self->custnum,
321 $error = $cust_credit->insert;
323 $dbh->rollback if $oldAutoCommit;
324 return "inserting credit (transaction rolled back): $error";
328 $error = $self->queue_fuzzyfiles_update;
330 $dbh->rollback if $oldAutoCommit;
331 return "updating fuzzy search cache: $error";
334 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
339 =item delete NEW_CUSTNUM
341 This deletes the customer. If there is an error, returns the error, otherwise
344 This will completely remove all traces of the customer record. This is not
345 what you want when a customer cancels service; for that, cancel all of the
346 customer's packages (see L</cancel>).
348 If the customer has any uncancelled packages, you need to pass a new (valid)
349 customer number for those packages to be transferred to. Cancelled packages
350 will be deleted. Did I mention that this is NOT what you want when a customer
351 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
353 You can't delete a customer with invoices (see L<FS::cust_bill>),
354 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
355 refunds (see L<FS::cust_refund>).
362 local $SIG{HUP} = 'IGNORE';
363 local $SIG{INT} = 'IGNORE';
364 local $SIG{QUIT} = 'IGNORE';
365 local $SIG{TERM} = 'IGNORE';
366 local $SIG{TSTP} = 'IGNORE';
367 local $SIG{PIPE} = 'IGNORE';
369 my $oldAutoCommit = $FS::UID::AutoCommit;
370 local $FS::UID::AutoCommit = 0;
373 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
374 $dbh->rollback if $oldAutoCommit;
375 return "Can't delete a customer with invoices";
377 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
378 $dbh->rollback if $oldAutoCommit;
379 return "Can't delete a customer with credits";
381 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Can't delete a customer with payments";
385 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
386 $dbh->rollback if $oldAutoCommit;
387 return "Can't delete a customer with refunds";
390 my @cust_pkg = $self->ncancelled_pkgs;
392 my $new_custnum = shift;
393 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
394 $dbh->rollback if $oldAutoCommit;
395 return "Invalid new customer number: $new_custnum";
397 foreach my $cust_pkg ( @cust_pkg ) {
398 my %hash = $cust_pkg->hash;
399 $hash{'custnum'} = $new_custnum;
400 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
401 my $error = $new_cust_pkg->replace($cust_pkg);
403 $dbh->rollback if $oldAutoCommit;
408 my @cancelled_cust_pkg = $self->all_pkgs;
409 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
410 my $error = $cust_pkg->delete;
412 $dbh->rollback if $oldAutoCommit;
417 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
418 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
420 my $error = $cust_main_invoice->delete;
422 $dbh->rollback if $oldAutoCommit;
427 my $error = $self->SUPER::delete;
429 $dbh->rollback if $oldAutoCommit;
433 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
438 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
440 Replaces the OLD_RECORD with this one in the database. If there is an error,
441 returns the error, otherwise returns false.
443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
444 be set as the invoicing list (see L<"invoicing_list">). Errors return as
445 expected and rollback the entire transaction; it is not necessary to call
446 check_invoicing_list first. Here's an example:
448 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
457 local $SIG{HUP} = 'IGNORE';
458 local $SIG{INT} = 'IGNORE';
459 local $SIG{QUIT} = 'IGNORE';
460 local $SIG{TERM} = 'IGNORE';
461 local $SIG{TSTP} = 'IGNORE';
462 local $SIG{PIPE} = 'IGNORE';
464 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
465 && $conf->config('users-allow_comp') ) {
466 return "You are not permitted to create complimentary accounts."
467 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
470 my $oldAutoCommit = $FS::UID::AutoCommit;
471 local $FS::UID::AutoCommit = 0;
474 my $error = $self->SUPER::replace($old);
477 $dbh->rollback if $oldAutoCommit;
481 if ( @param ) { # INVOICING_LIST_ARYREF
482 my $invoicing_list = shift @param;
483 $error = $self->check_invoicing_list( $invoicing_list );
485 $dbh->rollback if $oldAutoCommit;
488 $self->invoicing_list( $invoicing_list );
491 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
492 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
493 # card/check/lec info has changed, want to retry realtime_ invoice events
494 my $error = $self->retry_realtime;
496 $dbh->rollback if $oldAutoCommit;
501 $error = $self->queue_fuzzyfiles_update;
503 $dbh->rollback if $oldAutoCommit;
504 return "updating fuzzy search cache: $error";
507 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
512 =item queue_fuzzyfiles_update
514 Used by insert & replace to update the fuzzy search cache
518 sub queue_fuzzyfiles_update {
521 local $SIG{HUP} = 'IGNORE';
522 local $SIG{INT} = 'IGNORE';
523 local $SIG{QUIT} = 'IGNORE';
524 local $SIG{TERM} = 'IGNORE';
525 local $SIG{TSTP} = 'IGNORE';
526 local $SIG{PIPE} = 'IGNORE';
528 my $oldAutoCommit = $FS::UID::AutoCommit;
529 local $FS::UID::AutoCommit = 0;
532 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
533 my $error = $queue->insert($self->getfield('last'), $self->company);
535 $dbh->rollback if $oldAutoCommit;
536 return "queueing job (transaction rolled back): $error";
539 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
540 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
541 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
543 $dbh->rollback if $oldAutoCommit;
544 return "queueing job (transaction rolled back): $error";
548 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
555 Checks all fields to make sure this is a valid customer record. If there is
556 an error, returns the error, otherwise returns false. Called by the insert
564 #warn "BEFORE: \n". $self->_dump;
567 $self->ut_numbern('custnum')
568 || $self->ut_number('agentnum')
569 || $self->ut_number('refnum')
570 || $self->ut_name('last')
571 || $self->ut_name('first')
572 || $self->ut_textn('company')
573 || $self->ut_text('address1')
574 || $self->ut_textn('address2')
575 || $self->ut_text('city')
576 || $self->ut_textn('county')
577 || $self->ut_textn('state')
578 || $self->ut_country('country')
579 || $self->ut_anything('comments')
580 || $self->ut_numbern('referral_custnum')
582 #barf. need message catalogs. i18n. etc.
583 $error .= "Please select an advertising source."
584 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
585 return $error if $error;
587 return "Unknown agent"
588 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
590 return "Unknown refnum"
591 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
593 return "Unknown referring custnum ". $self->referral_custnum
594 unless ! $self->referral_custnum
595 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
597 if ( $self->ss eq '' ) {
602 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
603 or return "Illegal social security number: ". $self->ss;
604 $self->ss("$1-$2-$3");
608 # bad idea to disable, causes billing to fail because of no tax rates later
609 # unless ( $import ) {
610 unless ( qsearch('cust_main_county', {
611 'country' => $self->country,
614 return "Unknown state/county/country: ".
615 $self->state. "/". $self->county. "/". $self->country
616 unless qsearch('cust_main_county',{
617 'state' => $self->state,
618 'county' => $self->county,
619 'country' => $self->country,
625 $self->ut_phonen('daytime', $self->country)
626 || $self->ut_phonen('night', $self->country)
627 || $self->ut_phonen('fax', $self->country)
628 || $self->ut_zip('zip', $self->country)
630 return $error if $error;
633 last first company address1 address2 city county state zip
634 country daytime night fax
637 if ( defined $self->dbdef_table->column('ship_last') ) {
638 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
640 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
644 $self->ut_name('ship_last')
645 || $self->ut_name('ship_first')
646 || $self->ut_textn('ship_company')
647 || $self->ut_text('ship_address1')
648 || $self->ut_textn('ship_address2')
649 || $self->ut_text('ship_city')
650 || $self->ut_textn('ship_county')
651 || $self->ut_textn('ship_state')
652 || $self->ut_country('ship_country')
654 return $error if $error;
656 #false laziness with above
657 unless ( qsearchs('cust_main_county', {
658 'country' => $self->ship_country,
661 return "Unknown ship_state/ship_county/ship_country: ".
662 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
663 unless qsearchs('cust_main_county',{
664 'state' => $self->ship_state,
665 'county' => $self->ship_county,
666 'country' => $self->ship_country,
672 $self->ut_phonen('ship_daytime', $self->ship_country)
673 || $self->ut_phonen('ship_night', $self->ship_country)
674 || $self->ut_phonen('ship_fax', $self->ship_country)
675 || $self->ut_zip('ship_zip', $self->ship_country)
677 return $error if $error;
679 } else { # ship_ info eq billing info, so don't store dup info in database
680 $self->setfield("ship_$_", '')
681 foreach qw( last first company address1 address2 city county state zip
682 country daytime night fax );
686 $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
687 or return "Illegal payby: ". $self->payby;
690 if ( $self->payby eq 'CARD' ) {
692 my $payinfo = $self->payinfo;
694 $payinfo =~ /^(\d{13,16})$/
695 or return gettext('invalid_card'); # . ": ". $self->payinfo;
697 $self->payinfo($payinfo);
699 or return gettext('invalid_card'); # . ": ". $self->payinfo;
700 return gettext('unknown_card_type')
701 if cardtype($self->payinfo) eq "Unknown";
703 } elsif ( $self->payby eq 'CHEK' ) {
705 my $payinfo = $self->payinfo;
706 $payinfo =~ s/[^\d\@]//g;
707 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
709 $self->payinfo($payinfo);
711 } elsif ( $self->payby eq 'LECB' ) {
713 my $payinfo = $self->payinfo;
715 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
717 $self->payinfo($payinfo);
719 } elsif ( $self->payby eq 'BILL' ) {
721 $error = $self->ut_textn('payinfo');
722 return "Illegal P.O. number: ". $self->payinfo if $error;
724 } elsif ( $self->payby eq 'COMP' ) {
726 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
727 return "You are not permitted to create complimentary accounts."
728 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
731 $error = $self->ut_textn('payinfo');
732 return "Illegal comp account issuer: ". $self->payinfo if $error;
734 } elsif ( $self->payby eq 'PREPAY' ) {
736 my $payinfo = $self->payinfo;
737 $payinfo =~ s/\W//g; #anything else would just confuse things
738 $self->payinfo($payinfo);
739 $error = $self->ut_alpha('payinfo');
740 return "Illegal prepayment identifier: ". $self->payinfo if $error;
741 return "Unknown prepayment identifier"
742 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
746 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
747 return "Expriation date required"
748 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
751 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
752 or return "Illegal expiration date: ". $self->paydate;
753 my $y = length($2) == 4 ? $2 : "20$2";
754 $self->paydate("$y-$1-01");
755 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
756 return gettext('expired_card')
757 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
760 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
761 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
762 $self->payname( $self->first. " ". $self->getfield('last') );
764 $self->payname =~ /^([\w \,\.\-\']+)$/
765 or return gettext('illegal_name'). " payname: ". $self->payname;
769 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
772 $self->otaker(getotaker);
774 #warn "AFTER: \n". $self->_dump;
781 Returns all packages (see L<FS::cust_pkg>) for this customer.
787 if ( $self->{'_pkgnum'} ) {
788 values %{ $self->{'_pkgnum'}->cache };
790 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
794 =item ncancelled_pkgs
796 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
800 sub ncancelled_pkgs {
802 if ( $self->{'_pkgnum'} ) {
803 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
805 @{ [ # force list context
806 qsearch( 'cust_pkg', {
807 'custnum' => $self->custnum,
810 qsearch( 'cust_pkg', {
811 'custnum' => $self->custnum,
820 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
826 grep { $_->susp } $self->ncancelled_pkgs;
829 =item unflagged_suspended_pkgs
831 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
832 customer (thouse packages without the `manual_flag' set).
836 sub unflagged_suspended_pkgs {
838 return $self->suspended_pkgs
839 unless dbdef->table('cust_pkg')->column('manual_flag');
840 grep { ! $_->manual_flag } $self->suspended_pkgs;
843 =item unsuspended_pkgs
845 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
850 sub unsuspended_pkgs {
852 grep { ! $_->susp } $self->ncancelled_pkgs;
857 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
858 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
859 on success or a list of errors.
865 grep { $_->unsuspend } $self->suspended_pkgs;
870 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
871 Always returns a list: an empty list on success or a list of errors.
877 grep { $_->suspend } $self->unsuspended_pkgs;
882 Cancels all uncancelled 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 { $_->cancel } $self->ncancelled_pkgs;
894 Returns the agent (see L<FS::agent>) for this customer.
900 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
905 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
906 conjunction with the collect method.
908 Options are passed as name-value pairs.
910 The only currently available option is `time', which bills the customer as if
911 it were that time. It is specified as a UNIX timestamp; see
912 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
913 functions. For example:
917 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
919 If there is an error, returns the error, otherwise returns false.
924 my( $self, %options ) = @_;
925 my $time = $options{'time'} || time;
930 local $SIG{HUP} = 'IGNORE';
931 local $SIG{INT} = 'IGNORE';
932 local $SIG{QUIT} = 'IGNORE';
933 local $SIG{TERM} = 'IGNORE';
934 local $SIG{TSTP} = 'IGNORE';
935 local $SIG{PIPE} = 'IGNORE';
937 my $oldAutoCommit = $FS::UID::AutoCommit;
938 local $FS::UID::AutoCommit = 0;
941 # find the packages which are due for billing, find out how much they are
942 # & generate invoice database.
944 my( $total_setup, $total_recur ) = ( 0, 0 );
945 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
946 my @cust_bill_pkg = ();
948 #my $taxable_charged = 0;##
951 foreach my $cust_pkg (
952 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
955 #NO!! next if $cust_pkg->cancel;
956 next if $cust_pkg->getfield('cancel');
958 #? to avoid use of uninitialized value errors... ?
959 $cust_pkg->setfield('bill', '')
960 unless defined($cust_pkg->bill);
962 my $part_pkg = $cust_pkg->part_pkg;
964 #so we don't modify cust_pkg record unnecessarily
965 my $cust_pkg_mod_flag = 0;
966 my %hash = $cust_pkg->hash;
967 my $old_cust_pkg = new FS::cust_pkg \%hash;
971 unless ( $cust_pkg->setup ) {
972 my $setup_prog = $part_pkg->getfield('setup');
973 $setup_prog =~ /^(.*)$/ or do {
974 $dbh->rollback if $oldAutoCommit;
975 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
979 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
982 ##$cpt->permit(); #what is necessary?
983 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
984 #$setup = $cpt->reval($setup_prog);
985 $setup = eval $setup_prog;
986 unless ( defined($setup) ) {
987 $dbh->rollback if $oldAutoCommit;
988 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
989 "(expression $setup_prog): $@";
991 $cust_pkg->setfield('setup',$time);
992 $cust_pkg_mod_flag=1;
998 if ( $part_pkg->getfield('freq') > 0 &&
999 ! $cust_pkg->getfield('susp') &&
1000 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1002 my $recur_prog = $part_pkg->getfield('recur');
1003 $recur_prog =~ /^(.*)$/ or do {
1004 $dbh->rollback if $oldAutoCommit;
1005 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1009 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1011 # shared with $recur_prog
1012 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1014 #my $cpt = new Safe;
1015 ##$cpt->permit(); #what is necessary?
1016 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1017 #$recur = $cpt->reval($recur_prog);
1018 $recur = eval $recur_prog;
1019 unless ( defined($recur) ) {
1020 $dbh->rollback if $oldAutoCommit;
1021 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1022 "(expression $recur_prog): $@";
1024 #change this bit to use Date::Manip? CAREFUL with timezones (see
1025 # mailing list archive)
1026 my ($sec,$min,$hour,$mday,$mon,$year) =
1027 (localtime($sdate) )[0,1,2,3,4,5];
1029 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1030 # only for figuring next bill date, nothing else, so, reset $sdate again
1032 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1033 $cust_pkg->last_bill($sdate)
1034 if $cust_pkg->dbdef_table->column('last_bill');
1036 $mon += $part_pkg->freq;
1037 until ( $mon < 12 ) { $mon -= 12; $year++; }
1038 $cust_pkg->setfield('bill',
1039 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1040 $cust_pkg_mod_flag = 1;
1043 warn "\$setup is undefined" unless defined($setup);
1044 warn "\$recur is undefined" unless defined($recur);
1045 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1047 my $taxable_charged = 0;
1048 if ( $cust_pkg_mod_flag ) {
1049 $error=$cust_pkg->replace($old_cust_pkg);
1050 if ( $error ) { #just in case
1051 $dbh->rollback if $oldAutoCommit;
1052 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1054 $setup = sprintf( "%.2f", $setup );
1055 $recur = sprintf( "%.2f", $recur );
1057 $dbh->rollback if $oldAutoCommit;
1058 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1061 $dbh->rollback if $oldAutoCommit;
1062 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1064 if ( $setup > 0 || $recur > 0 ) {
1065 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1066 'pkgnum' => $cust_pkg->pkgnum,
1070 'edate' => $cust_pkg->bill,
1072 push @cust_bill_pkg, $cust_bill_pkg;
1073 $total_setup += $setup;
1074 $total_recur += $recur;
1075 $taxable_charged += $setup
1076 unless $part_pkg->setuptax =~ /^Y$/i;
1077 $taxable_charged += $recur
1078 unless $part_pkg->recurtax =~ /^Y$/i;
1080 unless ( $self->tax =~ /Y/i
1081 || $self->payby eq 'COMP'
1082 || $taxable_charged == 0 ) {
1084 my $cust_main_county = qsearchs('cust_main_county',{
1085 'state' => $self->state,
1086 'county' => $self->county,
1087 'country' => $self->country,
1088 'taxclass' => $part_pkg->taxclass,
1090 $cust_main_county ||= qsearchs('cust_main_county',{
1091 'state' => $self->state,
1092 'county' => $self->county,
1093 'country' => $self->country,
1096 unless ( $cust_main_county ) {
1097 $dbh->rollback if $oldAutoCommit;
1099 "fatal: can't find tax rate for state/county/country/taxclass ".
1100 join('/', ( map $self->$_(), qw(state county country) ),
1101 $part_pkg->taxclass ). "\n";
1104 if ( $cust_main_county->exempt_amount ) {
1105 my ($mon,$year) = (localtime($sdate) )[4,5];
1107 my $freq = $part_pkg->freq || 1;
1108 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1109 foreach my $which_month ( 1 .. $freq ) {
1111 'custnum' => $self->custnum,
1112 'taxnum' => $cust_main_county->taxnum,
1113 'year' => 1900+$year,
1116 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1117 until ( $mon < 13 ) { $mon -= 12; $year++; }
1118 my $cust_tax_exempt =
1119 qsearchs('cust_tax_exempt', \%hash)
1120 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1121 my $remaining_exemption = sprintf("%.2f",
1122 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1123 if ( $remaining_exemption > 0 ) {
1124 my $addl = $remaining_exemption > $taxable_per_month
1125 ? $taxable_per_month
1126 : $remaining_exemption;
1127 $taxable_charged -= $addl;
1128 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1129 $cust_tax_exempt->hash,
1130 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1132 $error = $new_cust_tax_exempt->exemptnum
1133 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1134 : $new_cust_tax_exempt->insert;
1136 $dbh->rollback if $oldAutoCommit;
1137 return "fatal: can't update cust_tax_exempt: $error";
1140 } # if $remaining_exemption > 0
1142 } #foreach $which_month
1144 } #if $cust_main_county->exempt_amount
1146 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1147 $tax += $taxable_charged * $cust_main_county->tax / 100
1149 } #unless $self->tax =~ /Y/i
1150 # || $self->payby eq 'COMP'
1151 # || $taxable_charged == 0
1153 } #if $setup > 0 || $recur > 0
1155 } #if $cust_pkg_mod_flag
1157 } #foreach my $cust_pkg
1159 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1160 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1162 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1163 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1167 # unless ( $self->tax =~ /Y/i
1168 # || $self->payby eq 'COMP'
1169 # || $taxable_charged == 0 ) {
1170 # my $cust_main_county = qsearchs('cust_main_county',{
1171 # 'state' => $self->state,
1172 # 'county' => $self->county,
1173 # 'country' => $self->country,
1174 # } ) or die "fatal: can't find tax rate for state/county/country ".
1175 # $self->state. "/". $self->county. "/". $self->country. "\n";
1176 # my $tax = sprintf( "%.2f",
1177 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1180 $tax = sprintf("%.2f", $tax);
1182 $charged = sprintf( "%.2f", $charged+$tax );
1184 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1191 push @cust_bill_pkg, $cust_bill_pkg;
1195 my $cust_bill = new FS::cust_bill ( {
1196 'custnum' => $self->custnum,
1198 'charged' => $charged,
1200 $error = $cust_bill->insert;
1202 $dbh->rollback if $oldAutoCommit;
1203 return "can't create invoice for customer #". $self->custnum. ": $error";
1206 my $invnum = $cust_bill->invnum;
1208 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1210 $cust_bill_pkg->invnum($invnum);
1211 $error = $cust_bill_pkg->insert;
1213 $dbh->rollback if $oldAutoCommit;
1214 return "can't create invoice line item for customer #". $self->custnum.
1219 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1225 document me. Re-schedules all exports by calling the B<reexport> method
1226 of all associated packages (see L<FS::cust_pkg>). If there is an error,
1227 returns the error; otherwise returns false.
1234 local $SIG{HUP} = 'IGNORE';
1235 local $SIG{INT} = 'IGNORE';
1236 local $SIG{QUIT} = 'IGNORE';
1237 local $SIG{TERM} = 'IGNORE';
1238 local $SIG{TSTP} = 'IGNORE';
1239 local $SIG{PIPE} = 'IGNORE';
1241 my $oldAutoCommit = $FS::UID::AutoCommit;
1242 local $FS::UID::AutoCommit = 0;
1245 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1246 my $error = $cust_pkg->reexport;
1248 $dbh->rollback if $oldAutoCommit;
1253 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1258 =item collect OPTIONS
1260 (Attempt to) collect money for this customer's outstanding invoices (see
1261 L<FS::cust_bill>). Usually used after the bill method.
1263 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1264 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1266 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1267 and the invoice events web interface.
1269 If there is an error, returns the error, otherwise returns false.
1271 Options are passed as name-value pairs.
1273 Currently available options are:
1275 invoice_time - Use this time when deciding when to print invoices and
1276 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>
1277 for conversion functions.
1279 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1282 retry_card - Deprecated alias for 'retry'
1284 batch_card - This option is deprecated. See the invoice events web interface
1285 to control whether cards are batched or run against a realtime gateway.
1287 report_badcard - This option is deprecated.
1289 force_print - This option is deprecated; see the invoice events web interface.
1291 quiet - set true to surpress email card/ACH decline notices.
1296 my( $self, %options ) = @_;
1297 my $invoice_time = $options{'invoice_time'} || time;
1300 local $SIG{HUP} = 'IGNORE';
1301 local $SIG{INT} = 'IGNORE';
1302 local $SIG{QUIT} = 'IGNORE';
1303 local $SIG{TERM} = 'IGNORE';
1304 local $SIG{TSTP} = 'IGNORE';
1305 local $SIG{PIPE} = 'IGNORE';
1307 my $oldAutoCommit = $FS::UID::AutoCommit;
1308 local $FS::UID::AutoCommit = 0;
1311 my $balance = $self->balance;
1312 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1313 unless ( $balance > 0 ) { #redundant?????
1314 $dbh->rollback if $oldAutoCommit; #hmm
1318 if ( exists($options{'retry_card'}) ) {
1319 carp 'retry_card option passed to collect is deprecated; use retry';
1320 $options{'retry'} ||= $options{'retry_card'};
1322 if ( exists($options{'retry'}) && $options{'retry'} ) {
1323 my $error = $self->retry_realtime;
1325 $dbh->rollback if $oldAutoCommit;
1330 foreach my $cust_bill ( $self->cust_bill ) {
1332 #this has to be before next's
1333 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1337 $balance = sprintf( "%.2f", $balance - $amount );
1339 next unless $cust_bill->owed > 0;
1341 # don't try to charge for the same invoice if it's already in a batch
1342 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1344 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1346 next unless $amount > 0;
1349 foreach my $part_bill_event (
1350 sort { $a->seconds <=> $b->seconds
1351 || $a->weight <=> $b->weight
1352 || $a->eventpart <=> $b->eventpart }
1353 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1354 && ! qsearchs( 'cust_bill_event', {
1355 'invnum' => $cust_bill->invnum,
1356 'eventpart' => $_->eventpart,
1360 qsearch('part_bill_event', { 'payby' => $self->payby,
1361 'disabled' => '', } )
1364 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1366 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1368 my $cust_main = $self; #for callback
1372 #supress "used only once" warning
1373 $FS::cust_bill::realtime_bop_decline_quiet += 0;
1374 local $FS::cust_bill::realtime_bop_decline_quiet = 1
1375 if $options{'quiet'};
1376 $error = eval $part_bill_event->eventcode;
1380 my $statustext = '';
1384 } elsif ( $error ) {
1386 $statustext = $error;
1391 #add cust_bill_event
1392 my $cust_bill_event = new FS::cust_bill_event {
1393 'invnum' => $cust_bill->invnum,
1394 'eventpart' => $part_bill_event->eventpart,
1395 #'_date' => $invoice_time,
1397 'status' => $status,
1398 'statustext' => $statustext,
1400 $error = $cust_bill_event->insert;
1402 #$dbh->rollback if $oldAutoCommit;
1403 #return "error: $error";
1405 # gah, even with transactions.
1406 $dbh->commit if $oldAutoCommit; #well.
1407 my $e = 'WARNING: Event run but database not updated - '.
1408 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1409 ', eventpart '. $part_bill_event->eventpart.
1420 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1425 =item retry_realtime
1427 Schedules realtime credit card / electronic check / LEC billing events for
1428 for retry. Useful if card information has changed or manual retry is desired.
1429 The 'collect' method must be called to actually retry the transaction.
1431 Implementation details: For each of this customer's open invoices, changes
1432 the status of the first "done" (with statustext error) realtime processing
1437 sub retry_realtime {
1440 local $SIG{HUP} = 'IGNORE';
1441 local $SIG{INT} = 'IGNORE';
1442 local $SIG{QUIT} = 'IGNORE';
1443 local $SIG{TERM} = 'IGNORE';
1444 local $SIG{TSTP} = 'IGNORE';
1445 local $SIG{PIPE} = 'IGNORE';
1447 my $oldAutoCommit = $FS::UID::AutoCommit;
1448 local $FS::UID::AutoCommit = 0;
1451 foreach my $cust_bill (
1452 grep { $_->cust_bill_event }
1453 $self->open_cust_bill
1455 my @cust_bill_event =
1456 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1458 #$_->part_bill_event->plan eq 'realtime-card'
1459 $_->part_bill_event->eventcode =~
1460 /\$cust_bill\->realtime_(card|ach|lec)/
1461 && $_->status eq 'done'
1464 $cust_bill->cust_bill_event;
1465 next unless @cust_bill_event;
1466 my $error = $cust_bill_event[0]->retry;
1468 $dbh->rollback if $oldAutoCommit;
1469 return "error scheduling invoice event for retry: $error";
1474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1481 Returns the total owed for this customer on all invoices
1482 (see L<FS::cust_bill/owed>).
1488 $self->total_owed_date(2145859200); #12/31/2037
1491 =item total_owed_date TIME
1493 Returns the total owed for this customer on all invoices with date earlier than
1494 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1495 see L<Time::Local> and L<Date::Parse> for conversion functions.
1499 sub total_owed_date {
1503 foreach my $cust_bill (
1504 grep { $_->_date <= $time }
1505 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1507 $total_bill += $cust_bill->owed;
1509 sprintf( "%.2f", $total_bill );
1514 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1515 to outstanding invoice balances in chronological order and returns the value
1516 of any remaining unapplied credits available for refund
1517 (see L<FS::cust_refund>).
1524 return 0 unless $self->total_credited;
1526 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1527 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1529 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1530 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1534 foreach my $cust_bill ( @invoices ) {
1537 if ( !defined($credit) || $credit->credited == 0) {
1538 $credit = pop @credits or last;
1541 if ($cust_bill->owed >= $credit->credited) {
1542 $amount=$credit->credited;
1544 $amount=$cust_bill->owed;
1547 my $cust_credit_bill = new FS::cust_credit_bill ( {
1548 'crednum' => $credit->crednum,
1549 'invnum' => $cust_bill->invnum,
1550 'amount' => $amount,
1552 my $error = $cust_credit_bill->insert;
1553 die $error if $error;
1555 redo if ($cust_bill->owed > 0);
1559 return $self->total_credited;
1562 =item apply_payments
1564 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1565 to outstanding invoice balances in chronological order.
1567 #and returns the value of any remaining unapplied payments.
1571 sub apply_payments {
1576 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1577 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1579 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1580 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1584 foreach my $cust_bill ( @invoices ) {
1587 if ( !defined($payment) || $payment->unapplied == 0 ) {
1588 $payment = pop @payments or last;
1591 if ( $cust_bill->owed >= $payment->unapplied ) {
1592 $amount = $payment->unapplied;
1594 $amount = $cust_bill->owed;
1597 my $cust_bill_pay = new FS::cust_bill_pay ( {
1598 'paynum' => $payment->paynum,
1599 'invnum' => $cust_bill->invnum,
1600 'amount' => $amount,
1602 my $error = $cust_bill_pay->insert;
1603 die $error if $error;
1605 redo if ( $cust_bill->owed > 0);
1609 return $self->total_unapplied_payments;
1612 =item total_credited
1614 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1615 customer. See L<FS::cust_credit/credited>.
1619 sub total_credited {
1621 my $total_credit = 0;
1622 foreach my $cust_credit ( qsearch('cust_credit', {
1623 'custnum' => $self->custnum,
1625 $total_credit += $cust_credit->credited;
1627 sprintf( "%.2f", $total_credit );
1630 =item total_unapplied_payments
1632 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1633 See L<FS::cust_pay/unapplied>.
1637 sub total_unapplied_payments {
1639 my $total_unapplied = 0;
1640 foreach my $cust_pay ( qsearch('cust_pay', {
1641 'custnum' => $self->custnum,
1643 $total_unapplied += $cust_pay->unapplied;
1645 sprintf( "%.2f", $total_unapplied );
1650 Returns the balance for this customer (total_owed minus total_credited
1651 minus total_unapplied_payments).
1658 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1662 =item balance_date TIME
1664 Returns the balance for this customer, only considering invoices with date
1665 earlier than TIME (total_owed_date minus total_credited minus
1666 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1667 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1676 $self->total_owed_date($time)
1677 - $self->total_credited
1678 - $self->total_unapplied_payments
1682 =item invoicing_list [ ARRAYREF ]
1684 If an arguement is given, sets these email addresses as invoice recipients
1685 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1686 (except as warnings), so use check_invoicing_list first.
1688 Returns a list of email addresses (with svcnum entries expanded).
1690 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1691 check it without disturbing anything by passing nothing.
1693 This interface may change in the future.
1697 sub invoicing_list {
1698 my( $self, $arrayref ) = @_;
1700 my @cust_main_invoice;
1701 if ( $self->custnum ) {
1702 @cust_main_invoice =
1703 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1705 @cust_main_invoice = ();
1707 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1708 #warn $cust_main_invoice->destnum;
1709 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1710 #warn $cust_main_invoice->destnum;
1711 my $error = $cust_main_invoice->delete;
1712 warn $error if $error;
1715 if ( $self->custnum ) {
1716 @cust_main_invoice =
1717 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1719 @cust_main_invoice = ();
1721 my %seen = map { $_->address => 1 } @cust_main_invoice;
1722 foreach my $address ( @{$arrayref} ) {
1723 next if exists $seen{$address} && $seen{$address};
1724 $seen{$address} = 1;
1725 my $cust_main_invoice = new FS::cust_main_invoice ( {
1726 'custnum' => $self->custnum,
1729 my $error = $cust_main_invoice->insert;
1730 warn $error if $error;
1733 if ( $self->custnum ) {
1735 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1741 =item check_invoicing_list ARRAYREF
1743 Checks these arguements as valid input for the invoicing_list method. If there
1744 is an error, returns the error, otherwise returns false.
1748 sub check_invoicing_list {
1749 my( $self, $arrayref ) = @_;
1750 foreach my $address ( @{$arrayref} ) {
1751 my $cust_main_invoice = new FS::cust_main_invoice ( {
1752 'custnum' => $self->custnum,
1755 my $error = $self->custnum
1756 ? $cust_main_invoice->check
1757 : $cust_main_invoice->checkdest
1759 return $error if $error;
1764 =item set_default_invoicing_list
1766 Sets the invoicing list to all accounts associated with this customer,
1767 overwriting any previous invoicing list.
1771 sub set_default_invoicing_list {
1773 $self->invoicing_list($self->all_emails);
1778 Returns the email addresses of all accounts provisioned for this customer.
1785 foreach my $cust_pkg ( $self->all_pkgs ) {
1786 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1788 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1789 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1791 $list{$_}=1 foreach map { $_->email } @svc_acct;
1796 =item invoicing_list_addpost
1798 Adds postal invoicing to this customer. If this customer is already configured
1799 to receive postal invoices, does nothing.
1803 sub invoicing_list_addpost {
1805 return if grep { $_ eq 'POST' } $self->invoicing_list;
1806 my @invoicing_list = $self->invoicing_list;
1807 push @invoicing_list, 'POST';
1808 $self->invoicing_list(\@invoicing_list);
1811 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1813 Returns an array of customers referred by this customer (referral_custnum set
1814 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1815 customers referred by customers referred by this customer and so on, inclusive.
1816 The default behavior is DEPTH 1 (no recursion).
1820 sub referral_cust_main {
1822 my $depth = @_ ? shift : 1;
1823 my $exclude = @_ ? shift : {};
1826 map { $exclude->{$_->custnum}++; $_; }
1827 grep { ! $exclude->{ $_->custnum } }
1828 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1832 map { $_->referral_cust_main($depth-1, $exclude) }
1839 =item referral_cust_main_ncancelled
1841 Same as referral_cust_main, except only returns customers with uncancelled
1846 sub referral_cust_main_ncancelled {
1848 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1851 =item referral_cust_pkg [ DEPTH ]
1853 Like referral_cust_main, except returns a flat list of all unsuspended (and
1854 uncancelled) packages for each customer. The number of items in this list may
1855 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1859 sub referral_cust_pkg {
1861 my $depth = @_ ? shift : 1;
1863 map { $_->unsuspended_pkgs }
1864 grep { $_->unsuspended_pkgs }
1865 $self->referral_cust_main($depth);
1868 =item credit AMOUNT, REASON
1870 Applies a credit to this customer. If there is an error, returns the error,
1871 otherwise returns false.
1876 my( $self, $amount, $reason ) = @_;
1877 my $cust_credit = new FS::cust_credit {
1878 'custnum' => $self->custnum,
1879 'amount' => $amount,
1880 'reason' => $reason,
1882 $cust_credit->insert;
1885 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1887 Creates a one-time charge for this customer. If there is an error, returns
1888 the error, otherwise returns false.
1893 my ( $self, $amount ) = ( shift, shift );
1894 my $pkg = @_ ? shift : 'One-time charge';
1895 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1896 my $taxclass = @_ ? shift : '';
1898 local $SIG{HUP} = 'IGNORE';
1899 local $SIG{INT} = 'IGNORE';
1900 local $SIG{QUIT} = 'IGNORE';
1901 local $SIG{TERM} = 'IGNORE';
1902 local $SIG{TSTP} = 'IGNORE';
1903 local $SIG{PIPE} = 'IGNORE';
1905 my $oldAutoCommit = $FS::UID::AutoCommit;
1906 local $FS::UID::AutoCommit = 0;
1909 my $part_pkg = new FS::part_pkg ( {
1911 'comment' => $comment,
1916 'taxclass' => $taxclass,
1919 my $error = $part_pkg->insert;
1921 $dbh->rollback if $oldAutoCommit;
1925 my $pkgpart = $part_pkg->pkgpart;
1926 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1927 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1928 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1929 $error = $type_pkgs->insert;
1931 $dbh->rollback if $oldAutoCommit;
1936 my $cust_pkg = new FS::cust_pkg ( {
1937 'custnum' => $self->custnum,
1938 'pkgpart' => $pkgpart,
1941 $error = $cust_pkg->insert;
1943 $dbh->rollback if $oldAutoCommit;
1947 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1954 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1960 sort { $a->_date <=> $b->_date }
1961 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1964 =item open_cust_bill
1966 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1971 sub open_cust_bill {
1973 grep { $_->owed > 0 } $self->cust_bill;
1982 =item check_and_rebuild_fuzzyfiles
1986 sub check_and_rebuild_fuzzyfiles {
1987 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1988 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1989 or &rebuild_fuzzyfiles;
1992 =item rebuild_fuzzyfiles
1996 sub rebuild_fuzzyfiles {
1998 use Fcntl qw(:flock);
2000 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2004 open(LASTLOCK,">>$dir/cust_main.last")
2005 or die "can't open $dir/cust_main.last: $!";
2006 flock(LASTLOCK,LOCK_EX)
2007 or die "can't lock $dir/cust_main.last: $!";
2009 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2011 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2012 if defined dbdef->table('cust_main')->column('ship_last');
2014 open (LASTCACHE,">$dir/cust_main.last.tmp")
2015 or die "can't open $dir/cust_main.last.tmp: $!";
2016 print LASTCACHE join("\n", @all_last), "\n";
2017 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2019 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2024 open(COMPANYLOCK,">>$dir/cust_main.company")
2025 or die "can't open $dir/cust_main.company: $!";
2026 flock(COMPANYLOCK,LOCK_EX)
2027 or die "can't lock $dir/cust_main.company: $!";
2029 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2031 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2032 if defined dbdef->table('cust_main')->column('ship_last');
2034 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2035 or die "can't open $dir/cust_main.company.tmp: $!";
2036 print COMPANYCACHE join("\n", @all_company), "\n";
2037 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2039 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2049 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2050 open(LASTCACHE,"<$dir/cust_main.last")
2051 or die "can't open $dir/cust_main.last: $!";
2052 my @array = map { chomp; $_; } <LASTCACHE>;
2062 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2063 open(COMPANYCACHE,"<$dir/cust_main.company")
2064 or die "can't open $dir/cust_main.last: $!";
2065 my @array = map { chomp; $_; } <COMPANYCACHE>;
2070 =item append_fuzzyfiles LASTNAME COMPANY
2074 sub append_fuzzyfiles {
2075 my( $last, $company ) = @_;
2077 &check_and_rebuild_fuzzyfiles;
2079 use Fcntl qw(:flock);
2081 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2085 open(LAST,">>$dir/cust_main.last")
2086 or die "can't open $dir/cust_main.last: $!";
2088 or die "can't lock $dir/cust_main.last: $!";
2090 print LAST "$last\n";
2093 or die "can't unlock $dir/cust_main.last: $!";
2099 open(COMPANY,">>$dir/cust_main.company")
2100 or die "can't open $dir/cust_main.company: $!";
2101 flock(COMPANY,LOCK_EX)
2102 or die "can't lock $dir/cust_main.company: $!";
2104 print COMPANY "$company\n";
2106 flock(COMPANY,LOCK_UN)
2107 or die "can't unlock $dir/cust_main.company: $!";
2121 #warn join('-',keys %$param);
2122 my $fh = $param->{filehandle};
2123 my $agentnum = $param->{agentnum};
2124 my $refnum = $param->{refnum};
2125 my $pkgpart = $param->{pkgpart};
2126 my @fields = @{$param->{fields}};
2128 eval "use Date::Parse;";
2130 eval "use Text::CSV_XS;";
2133 my $csv = new Text::CSV_XS;
2140 local $SIG{HUP} = 'IGNORE';
2141 local $SIG{INT} = 'IGNORE';
2142 local $SIG{QUIT} = 'IGNORE';
2143 local $SIG{TERM} = 'IGNORE';
2144 local $SIG{TSTP} = 'IGNORE';
2145 local $SIG{PIPE} = 'IGNORE';
2147 my $oldAutoCommit = $FS::UID::AutoCommit;
2148 local $FS::UID::AutoCommit = 0;
2151 #while ( $columns = $csv->getline($fh) ) {
2153 while ( defined($line=<$fh>) ) {
2155 $csv->parse($line) or do {
2156 $dbh->rollback if $oldAutoCommit;
2157 return "can't parse: ". $csv->error_input();
2160 my @columns = $csv->fields();
2161 #warn join('-',@columns);
2164 agentnum => $agentnum,
2166 country => 'US', #default
2167 payby => 'BILL', #default
2168 paydate => '12/2037', #default
2170 my $billtime = time;
2171 my %cust_pkg = ( pkgpart => $pkgpart );
2172 foreach my $field ( @fields ) {
2173 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2174 #$cust_pkg{$1} = str2time( shift @$columns );
2175 if ( $1 eq 'setup' ) {
2176 $billtime = str2time(shift @columns);
2178 $cust_pkg{$1} = str2time( shift @columns );
2181 #$cust_main{$field} = shift @$columns;
2182 $cust_main{$field} = shift @columns;
2186 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2187 my $cust_main = new FS::cust_main ( \%cust_main );
2189 tie my %hash, 'Tie::RefHash'; #this part is important
2190 $hash{$cust_pkg} = [] if $pkgpart;
2191 my $error = $cust_main->insert( \%hash );
2194 $dbh->rollback if $oldAutoCommit;
2195 return "can't insert customer for $line: $error";
2198 #false laziness w/bill.cgi
2199 $error = $cust_main->bill( 'time' => $billtime );
2201 $dbh->rollback if $oldAutoCommit;
2202 return "can't bill customer for $line: $error";
2205 $cust_main->apply_payments;
2206 $cust_main->apply_credits;
2208 $error = $cust_main->collect();
2210 $dbh->rollback if $oldAutoCommit;
2211 return "can't collect customer for $line: $error";
2217 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2219 return "Empty file!" unless $imported;
2231 #warn join('-',keys %$param);
2232 my $fh = $param->{filehandle};
2233 my @fields = @{$param->{fields}};
2235 eval "use Date::Parse;";
2237 eval "use Text::CSV_XS;";
2240 my $csv = new Text::CSV_XS;
2247 local $SIG{HUP} = 'IGNORE';
2248 local $SIG{INT} = 'IGNORE';
2249 local $SIG{QUIT} = 'IGNORE';
2250 local $SIG{TERM} = 'IGNORE';
2251 local $SIG{TSTP} = 'IGNORE';
2252 local $SIG{PIPE} = 'IGNORE';
2254 my $oldAutoCommit = $FS::UID::AutoCommit;
2255 local $FS::UID::AutoCommit = 0;
2258 #while ( $columns = $csv->getline($fh) ) {
2260 while ( defined($line=<$fh>) ) {
2262 $csv->parse($line) or do {
2263 $dbh->rollback if $oldAutoCommit;
2264 return "can't parse: ". $csv->error_input();
2267 my @columns = $csv->fields();
2268 #warn join('-',@columns);
2271 foreach my $field ( @fields ) {
2272 $row{$field} = shift @columns;
2275 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2276 unless ( $cust_main ) {
2277 $dbh->rollback if $oldAutoCommit;
2278 return "unknown custnum $row{'custnum'}";
2281 if ( $row{'amount'} > 0 ) {
2282 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2284 $dbh->rollback if $oldAutoCommit;
2288 } elsif ( $row{'amount'} < 0 ) {
2289 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2292 $dbh->rollback if $oldAutoCommit;
2302 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2304 return "Empty file!" unless $imported;
2316 The delete method should possibly take an FS::cust_main object reference
2317 instead of a scalar customer number.
2319 Bill and collect options should probably be passed as references instead of a
2322 There should probably be a configuration file with a list of allowed credit
2325 No multiple currency support (probably a larger project than just this module).
2329 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2330 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2331 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.