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;
880 =item cancel [ OPTION => VALUE ... ]
882 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
884 Available options are: I<quiet>
886 I<quiet> can be set true to supress email cancellation notices.
888 Always returns a list: an empty list on success or a list of errors.
894 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
899 Returns the agent (see L<FS::agent>) for this customer.
905 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
910 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
911 conjunction with the collect method.
913 Options are passed as name-value pairs.
915 The only currently available option is `time', which bills the customer as if
916 it were that time. It is specified as a UNIX timestamp; see
917 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
918 functions. For example:
922 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
924 If there is an error, returns the error, otherwise returns false.
929 my( $self, %options ) = @_;
930 my $time = $options{'time'} || time;
935 local $SIG{HUP} = 'IGNORE';
936 local $SIG{INT} = 'IGNORE';
937 local $SIG{QUIT} = 'IGNORE';
938 local $SIG{TERM} = 'IGNORE';
939 local $SIG{TSTP} = 'IGNORE';
940 local $SIG{PIPE} = 'IGNORE';
942 my $oldAutoCommit = $FS::UID::AutoCommit;
943 local $FS::UID::AutoCommit = 0;
946 # find the packages which are due for billing, find out how much they are
947 # & generate invoice database.
949 my( $total_setup, $total_recur ) = ( 0, 0 );
950 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
951 my @cust_bill_pkg = ();
953 #my $taxable_charged = 0;##
958 foreach my $cust_pkg (
959 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
962 #NO!! next if $cust_pkg->cancel;
963 next if $cust_pkg->getfield('cancel');
965 #? to avoid use of uninitialized value errors... ?
966 $cust_pkg->setfield('bill', '')
967 unless defined($cust_pkg->bill);
969 my $part_pkg = $cust_pkg->part_pkg;
971 #so we don't modify cust_pkg record unnecessarily
972 my $cust_pkg_mod_flag = 0;
973 my %hash = $cust_pkg->hash;
974 my $old_cust_pkg = new FS::cust_pkg \%hash;
978 unless ( $cust_pkg->setup ) {
979 my $setup_prog = $part_pkg->getfield('setup');
980 $setup_prog =~ /^(.*)$/ or do {
981 $dbh->rollback if $oldAutoCommit;
982 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
986 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
989 ##$cpt->permit(); #what is necessary?
990 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
991 #$setup = $cpt->reval($setup_prog);
992 $setup = eval $setup_prog;
993 unless ( defined($setup) ) {
994 $dbh->rollback if $oldAutoCommit;
995 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
996 "(expression $setup_prog): $@";
998 $cust_pkg->setfield('setup',$time);
999 $cust_pkg_mod_flag=1;
1005 if ( $part_pkg->getfield('freq') > 0 &&
1006 ! $cust_pkg->getfield('susp') &&
1007 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1009 my $recur_prog = $part_pkg->getfield('recur');
1010 $recur_prog =~ /^(.*)$/ or do {
1011 $dbh->rollback if $oldAutoCommit;
1012 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1016 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1018 # shared with $recur_prog
1019 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1021 #my $cpt = new Safe;
1022 ##$cpt->permit(); #what is necessary?
1023 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1024 #$recur = $cpt->reval($recur_prog);
1025 $recur = eval $recur_prog;
1026 unless ( defined($recur) ) {
1027 $dbh->rollback if $oldAutoCommit;
1028 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1029 "(expression $recur_prog): $@";
1031 #change this bit to use Date::Manip? CAREFUL with timezones (see
1032 # mailing list archive)
1033 my ($sec,$min,$hour,$mday,$mon,$year) =
1034 (localtime($sdate) )[0,1,2,3,4,5];
1036 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1037 # only for figuring next bill date, nothing else, so, reset $sdate again
1039 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1040 $cust_pkg->last_bill($sdate)
1041 if $cust_pkg->dbdef_table->column('last_bill');
1043 $mon += $part_pkg->freq;
1044 until ( $mon < 12 ) { $mon -= 12; $year++; }
1045 $cust_pkg->setfield('bill',
1046 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1047 $cust_pkg_mod_flag = 1;
1050 warn "\$setup is undefined" unless defined($setup);
1051 warn "\$recur is undefined" unless defined($recur);
1052 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1054 if ( $cust_pkg_mod_flag ) {
1055 $error=$cust_pkg->replace($old_cust_pkg);
1056 if ( $error ) { #just in case
1057 $dbh->rollback if $oldAutoCommit;
1058 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1060 $setup = sprintf( "%.2f", $setup );
1061 $recur = sprintf( "%.2f", $recur );
1063 $dbh->rollback if $oldAutoCommit;
1064 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1067 $dbh->rollback if $oldAutoCommit;
1068 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1070 if ( $setup > 0 || $recur > 0 ) {
1071 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1072 'pkgnum' => $cust_pkg->pkgnum,
1076 'edate' => $cust_pkg->bill,
1078 push @cust_bill_pkg, $cust_bill_pkg;
1079 $total_setup += $setup;
1080 $total_recur += $recur;
1082 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1084 my @taxes = qsearch( 'cust_main_county', {
1085 'state' => $self->state,
1086 'county' => $self->county,
1087 'country' => $self->country,
1088 'taxclass' => $part_pkg->taxclass,
1090 || qsearch( 'cust_main_county', {
1091 'state' => $self->state,
1092 'county' => $self->county,
1093 'country' => $self->country,
1097 # maybe eliminate this entirely, along with all the 0% records
1099 $dbh->rollback if $oldAutoCommit;
1101 "fatal: can't find tax rate for state/county/country/taxclass ".
1102 join('/', ( map $self->$_(), qw(state county country) ),
1103 $part_pkg->taxclass ). "\n";
1106 foreach my $tax ( @taxes ) {
1108 my $taxable_charged = 0;
1109 $taxable_charged += $setup
1110 unless $part_pkg->setuptax =~ /^Y$/i
1111 || $tax->setuptax =~ /^Y$/i;
1112 $taxable_charged += $recur
1113 unless $part_pkg->recurtax =~ /^Y$/i
1114 || $tax->recurtax =~ /^Y$/i;
1115 next unless $taxable_charged;
1117 if ( $tax->exempt_amount ) {
1118 my ($mon,$year) = (localtime($sdate) )[4,5];
1120 my $freq = $part_pkg->freq || 1;
1121 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1122 foreach my $which_month ( 1 .. $freq ) {
1124 'custnum' => $self->custnum,
1125 'taxnum' => $tax->taxnum,
1126 'year' => 1900+$year,
1129 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1130 until ( $mon < 13 ) { $mon -= 12; $year++; }
1131 my $cust_tax_exempt =
1132 qsearchs('cust_tax_exempt', \%hash)
1133 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1134 my $remaining_exemption = sprintf("%.2f",
1135 $tax->exempt_amount - $cust_tax_exempt->amount );
1136 if ( $remaining_exemption > 0 ) {
1137 my $addl = $remaining_exemption > $taxable_per_month
1138 ? $taxable_per_month
1139 : $remaining_exemption;
1140 $taxable_charged -= $addl;
1141 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1142 $cust_tax_exempt->hash,
1144 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1146 $error = $new_cust_tax_exempt->exemptnum
1147 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1148 : $new_cust_tax_exempt->insert;
1150 $dbh->rollback if $oldAutoCommit;
1151 return "fatal: can't update cust_tax_exempt: $error";
1154 } # if $remaining_exemption > 0
1156 } #foreach $which_month
1158 } #if $tax->exempt_amount
1160 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1162 #$tax += $taxable_charged * $cust_main_county->tax / 100
1163 $tax{ $tax->taxname || 'Tax' } +=
1164 $taxable_charged * $tax->tax / 100
1166 } #foreach my $tax ( @taxes )
1168 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1170 } #if $setup > 0 || $recur > 0
1172 } #if $cust_pkg_mod_flag
1174 } #foreach my $cust_pkg
1176 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1177 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1179 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1180 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1184 # unless ( $self->tax =~ /Y/i
1185 # || $self->payby eq 'COMP'
1186 # || $taxable_charged == 0 ) {
1187 # my $cust_main_county = qsearchs('cust_main_county',{
1188 # 'state' => $self->state,
1189 # 'county' => $self->county,
1190 # 'country' => $self->country,
1191 # } ) or die "fatal: can't find tax rate for state/county/country ".
1192 # $self->state. "/". $self->county. "/". $self->country. "\n";
1193 # my $tax = sprintf( "%.2f",
1194 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1197 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1199 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1200 my $tax = sprintf("%.2f", $tax{$taxname} );
1201 $charged = sprintf( "%.2f", $charged+$tax );
1203 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1209 'itemdesc' => $taxname,
1211 push @cust_bill_pkg, $cust_bill_pkg;
1214 } else { #1.4 schema
1217 foreach ( values %tax ) { $tax += $_ };
1218 $tax = sprintf("%.2f", $tax);
1220 $charged = sprintf( "%.2f", $charged+$tax );
1222 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1229 push @cust_bill_pkg, $cust_bill_pkg;
1234 my $cust_bill = new FS::cust_bill ( {
1235 'custnum' => $self->custnum,
1237 'charged' => $charged,
1239 $error = $cust_bill->insert;
1241 $dbh->rollback if $oldAutoCommit;
1242 return "can't create invoice for customer #". $self->custnum. ": $error";
1245 my $invnum = $cust_bill->invnum;
1247 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1249 $cust_bill_pkg->invnum($invnum);
1250 $error = $cust_bill_pkg->insert;
1252 $dbh->rollback if $oldAutoCommit;
1253 return "can't create invoice line item for customer #". $self->custnum.
1258 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1264 document me. Re-schedules all exports by calling the B<reexport> method
1265 of all associated packages (see L<FS::cust_pkg>). If there is an error,
1266 returns the error; otherwise returns false.
1273 local $SIG{HUP} = 'IGNORE';
1274 local $SIG{INT} = 'IGNORE';
1275 local $SIG{QUIT} = 'IGNORE';
1276 local $SIG{TERM} = 'IGNORE';
1277 local $SIG{TSTP} = 'IGNORE';
1278 local $SIG{PIPE} = 'IGNORE';
1280 my $oldAutoCommit = $FS::UID::AutoCommit;
1281 local $FS::UID::AutoCommit = 0;
1284 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1285 my $error = $cust_pkg->reexport;
1287 $dbh->rollback if $oldAutoCommit;
1292 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1297 =item collect OPTIONS
1299 (Attempt to) collect money for this customer's outstanding invoices (see
1300 L<FS::cust_bill>). Usually used after the bill method.
1302 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1303 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1305 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1306 and the invoice events web interface.
1308 If there is an error, returns the error, otherwise returns false.
1310 Options are passed as name-value pairs.
1312 Currently available options are:
1314 invoice_time - Use this time when deciding when to print invoices and
1315 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>
1316 for conversion functions.
1318 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1321 retry_card - Deprecated alias for 'retry'
1323 batch_card - This option is deprecated. See the invoice events web interface
1324 to control whether cards are batched or run against a realtime gateway.
1326 report_badcard - This option is deprecated.
1328 force_print - This option is deprecated; see the invoice events web interface.
1330 quiet - set true to surpress email card/ACH decline notices.
1335 my( $self, %options ) = @_;
1336 my $invoice_time = $options{'invoice_time'} || time;
1339 local $SIG{HUP} = 'IGNORE';
1340 local $SIG{INT} = 'IGNORE';
1341 local $SIG{QUIT} = 'IGNORE';
1342 local $SIG{TERM} = 'IGNORE';
1343 local $SIG{TSTP} = 'IGNORE';
1344 local $SIG{PIPE} = 'IGNORE';
1346 my $oldAutoCommit = $FS::UID::AutoCommit;
1347 local $FS::UID::AutoCommit = 0;
1350 my $balance = $self->balance;
1351 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1352 unless ( $balance > 0 ) { #redundant?????
1353 $dbh->rollback if $oldAutoCommit; #hmm
1357 if ( exists($options{'retry_card'}) ) {
1358 carp 'retry_card option passed to collect is deprecated; use retry';
1359 $options{'retry'} ||= $options{'retry_card'};
1361 if ( exists($options{'retry'}) && $options{'retry'} ) {
1362 my $error = $self->retry_realtime;
1364 $dbh->rollback if $oldAutoCommit;
1369 foreach my $cust_bill ( $self->cust_bill ) {
1371 #this has to be before next's
1372 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1376 $balance = sprintf( "%.2f", $balance - $amount );
1378 next unless $cust_bill->owed > 0;
1380 # don't try to charge for the same invoice if it's already in a batch
1381 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1383 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1385 next unless $amount > 0;
1388 foreach my $part_bill_event (
1389 sort { $a->seconds <=> $b->seconds
1390 || $a->weight <=> $b->weight
1391 || $a->eventpart <=> $b->eventpart }
1392 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1393 && ! qsearchs( 'cust_bill_event', {
1394 'invnum' => $cust_bill->invnum,
1395 'eventpart' => $_->eventpart,
1399 qsearch('part_bill_event', { 'payby' => $self->payby,
1400 'disabled' => '', } )
1403 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1405 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1407 my $cust_main = $self; #for callback
1411 #supress "used only once" warning
1412 $FS::cust_bill::realtime_bop_decline_quiet += 0;
1413 local $FS::cust_bill::realtime_bop_decline_quiet = 1
1414 if $options{'quiet'};
1415 $error = eval $part_bill_event->eventcode;
1419 my $statustext = '';
1423 } elsif ( $error ) {
1425 $statustext = $error;
1430 #add cust_bill_event
1431 my $cust_bill_event = new FS::cust_bill_event {
1432 'invnum' => $cust_bill->invnum,
1433 'eventpart' => $part_bill_event->eventpart,
1434 #'_date' => $invoice_time,
1436 'status' => $status,
1437 'statustext' => $statustext,
1439 $error = $cust_bill_event->insert;
1441 #$dbh->rollback if $oldAutoCommit;
1442 #return "error: $error";
1444 # gah, even with transactions.
1445 $dbh->commit if $oldAutoCommit; #well.
1446 my $e = 'WARNING: Event run but database not updated - '.
1447 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1448 ', eventpart '. $part_bill_event->eventpart.
1459 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1464 =item retry_realtime
1466 Schedules realtime credit card / electronic check / LEC billing events for
1467 for retry. Useful if card information has changed or manual retry is desired.
1468 The 'collect' method must be called to actually retry the transaction.
1470 Implementation details: For each of this customer's open invoices, changes
1471 the status of the first "done" (with statustext error) realtime processing
1476 sub retry_realtime {
1479 local $SIG{HUP} = 'IGNORE';
1480 local $SIG{INT} = 'IGNORE';
1481 local $SIG{QUIT} = 'IGNORE';
1482 local $SIG{TERM} = 'IGNORE';
1483 local $SIG{TSTP} = 'IGNORE';
1484 local $SIG{PIPE} = 'IGNORE';
1486 my $oldAutoCommit = $FS::UID::AutoCommit;
1487 local $FS::UID::AutoCommit = 0;
1490 foreach my $cust_bill (
1491 grep { $_->cust_bill_event }
1492 $self->open_cust_bill
1494 my @cust_bill_event =
1495 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1497 #$_->part_bill_event->plan eq 'realtime-card'
1498 $_->part_bill_event->eventcode =~
1499 /\$cust_bill\->realtime_(card|ach|lec)/
1500 && $_->status eq 'done'
1503 $cust_bill->cust_bill_event;
1504 next unless @cust_bill_event;
1505 my $error = $cust_bill_event[0]->retry;
1507 $dbh->rollback if $oldAutoCommit;
1508 return "error scheduling invoice event for retry: $error";
1513 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1520 Returns the total owed for this customer on all invoices
1521 (see L<FS::cust_bill/owed>).
1527 $self->total_owed_date(2145859200); #12/31/2037
1530 =item total_owed_date TIME
1532 Returns the total owed for this customer on all invoices with date earlier than
1533 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1534 see L<Time::Local> and L<Date::Parse> for conversion functions.
1538 sub total_owed_date {
1542 foreach my $cust_bill (
1543 grep { $_->_date <= $time }
1544 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1546 $total_bill += $cust_bill->owed;
1548 sprintf( "%.2f", $total_bill );
1553 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1554 to outstanding invoice balances in chronological order and returns the value
1555 of any remaining unapplied credits available for refund
1556 (see L<FS::cust_refund>).
1563 return 0 unless $self->total_credited;
1565 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1566 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1568 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1569 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1573 foreach my $cust_bill ( @invoices ) {
1576 if ( !defined($credit) || $credit->credited == 0) {
1577 $credit = pop @credits or last;
1580 if ($cust_bill->owed >= $credit->credited) {
1581 $amount=$credit->credited;
1583 $amount=$cust_bill->owed;
1586 my $cust_credit_bill = new FS::cust_credit_bill ( {
1587 'crednum' => $credit->crednum,
1588 'invnum' => $cust_bill->invnum,
1589 'amount' => $amount,
1591 my $error = $cust_credit_bill->insert;
1592 die $error if $error;
1594 redo if ($cust_bill->owed > 0);
1598 return $self->total_credited;
1601 =item apply_payments
1603 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1604 to outstanding invoice balances in chronological order.
1606 #and returns the value of any remaining unapplied payments.
1610 sub apply_payments {
1615 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1616 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1618 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1619 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1623 foreach my $cust_bill ( @invoices ) {
1626 if ( !defined($payment) || $payment->unapplied == 0 ) {
1627 $payment = pop @payments or last;
1630 if ( $cust_bill->owed >= $payment->unapplied ) {
1631 $amount = $payment->unapplied;
1633 $amount = $cust_bill->owed;
1636 my $cust_bill_pay = new FS::cust_bill_pay ( {
1637 'paynum' => $payment->paynum,
1638 'invnum' => $cust_bill->invnum,
1639 'amount' => $amount,
1641 my $error = $cust_bill_pay->insert;
1642 die $error if $error;
1644 redo if ( $cust_bill->owed > 0);
1648 return $self->total_unapplied_payments;
1651 =item total_credited
1653 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1654 customer. See L<FS::cust_credit/credited>.
1658 sub total_credited {
1660 my $total_credit = 0;
1661 foreach my $cust_credit ( qsearch('cust_credit', {
1662 'custnum' => $self->custnum,
1664 $total_credit += $cust_credit->credited;
1666 sprintf( "%.2f", $total_credit );
1669 =item total_unapplied_payments
1671 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1672 See L<FS::cust_pay/unapplied>.
1676 sub total_unapplied_payments {
1678 my $total_unapplied = 0;
1679 foreach my $cust_pay ( qsearch('cust_pay', {
1680 'custnum' => $self->custnum,
1682 $total_unapplied += $cust_pay->unapplied;
1684 sprintf( "%.2f", $total_unapplied );
1689 Returns the balance for this customer (total_owed minus total_credited
1690 minus total_unapplied_payments).
1697 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1701 =item balance_date TIME
1703 Returns the balance for this customer, only considering invoices with date
1704 earlier than TIME (total_owed_date minus total_credited minus
1705 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1706 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1715 $self->total_owed_date($time)
1716 - $self->total_credited
1717 - $self->total_unapplied_payments
1721 =item invoicing_list [ ARRAYREF ]
1723 If an arguement is given, sets these email addresses as invoice recipients
1724 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1725 (except as warnings), so use check_invoicing_list first.
1727 Returns a list of email addresses (with svcnum entries expanded).
1729 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1730 check it without disturbing anything by passing nothing.
1732 This interface may change in the future.
1736 sub invoicing_list {
1737 my( $self, $arrayref ) = @_;
1739 my @cust_main_invoice;
1740 if ( $self->custnum ) {
1741 @cust_main_invoice =
1742 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1744 @cust_main_invoice = ();
1746 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1747 #warn $cust_main_invoice->destnum;
1748 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1749 #warn $cust_main_invoice->destnum;
1750 my $error = $cust_main_invoice->delete;
1751 warn $error if $error;
1754 if ( $self->custnum ) {
1755 @cust_main_invoice =
1756 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1758 @cust_main_invoice = ();
1760 my %seen = map { $_->address => 1 } @cust_main_invoice;
1761 foreach my $address ( @{$arrayref} ) {
1762 next if exists $seen{$address} && $seen{$address};
1763 $seen{$address} = 1;
1764 my $cust_main_invoice = new FS::cust_main_invoice ( {
1765 'custnum' => $self->custnum,
1768 my $error = $cust_main_invoice->insert;
1769 warn $error if $error;
1772 if ( $self->custnum ) {
1774 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1780 =item check_invoicing_list ARRAYREF
1782 Checks these arguements as valid input for the invoicing_list method. If there
1783 is an error, returns the error, otherwise returns false.
1787 sub check_invoicing_list {
1788 my( $self, $arrayref ) = @_;
1789 foreach my $address ( @{$arrayref} ) {
1790 my $cust_main_invoice = new FS::cust_main_invoice ( {
1791 'custnum' => $self->custnum,
1794 my $error = $self->custnum
1795 ? $cust_main_invoice->check
1796 : $cust_main_invoice->checkdest
1798 return $error if $error;
1803 =item set_default_invoicing_list
1805 Sets the invoicing list to all accounts associated with this customer,
1806 overwriting any previous invoicing list.
1810 sub set_default_invoicing_list {
1812 $self->invoicing_list($self->all_emails);
1817 Returns the email addresses of all accounts provisioned for this customer.
1824 foreach my $cust_pkg ( $self->all_pkgs ) {
1825 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1827 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1828 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1830 $list{$_}=1 foreach map { $_->email } @svc_acct;
1835 =item invoicing_list_addpost
1837 Adds postal invoicing to this customer. If this customer is already configured
1838 to receive postal invoices, does nothing.
1842 sub invoicing_list_addpost {
1844 return if grep { $_ eq 'POST' } $self->invoicing_list;
1845 my @invoicing_list = $self->invoicing_list;
1846 push @invoicing_list, 'POST';
1847 $self->invoicing_list(\@invoicing_list);
1850 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1852 Returns an array of customers referred by this customer (referral_custnum set
1853 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1854 customers referred by customers referred by this customer and so on, inclusive.
1855 The default behavior is DEPTH 1 (no recursion).
1859 sub referral_cust_main {
1861 my $depth = @_ ? shift : 1;
1862 my $exclude = @_ ? shift : {};
1865 map { $exclude->{$_->custnum}++; $_; }
1866 grep { ! $exclude->{ $_->custnum } }
1867 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1871 map { $_->referral_cust_main($depth-1, $exclude) }
1878 =item referral_cust_main_ncancelled
1880 Same as referral_cust_main, except only returns customers with uncancelled
1885 sub referral_cust_main_ncancelled {
1887 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1890 =item referral_cust_pkg [ DEPTH ]
1892 Like referral_cust_main, except returns a flat list of all unsuspended (and
1893 uncancelled) packages for each customer. The number of items in this list may
1894 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1898 sub referral_cust_pkg {
1900 my $depth = @_ ? shift : 1;
1902 map { $_->unsuspended_pkgs }
1903 grep { $_->unsuspended_pkgs }
1904 $self->referral_cust_main($depth);
1907 =item credit AMOUNT, REASON
1909 Applies a credit to this customer. If there is an error, returns the error,
1910 otherwise returns false.
1915 my( $self, $amount, $reason ) = @_;
1916 my $cust_credit = new FS::cust_credit {
1917 'custnum' => $self->custnum,
1918 'amount' => $amount,
1919 'reason' => $reason,
1921 $cust_credit->insert;
1924 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1926 Creates a one-time charge for this customer. If there is an error, returns
1927 the error, otherwise returns false.
1932 my ( $self, $amount ) = ( shift, shift );
1933 my $pkg = @_ ? shift : 'One-time charge';
1934 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1935 my $taxclass = @_ ? shift : '';
1937 local $SIG{HUP} = 'IGNORE';
1938 local $SIG{INT} = 'IGNORE';
1939 local $SIG{QUIT} = 'IGNORE';
1940 local $SIG{TERM} = 'IGNORE';
1941 local $SIG{TSTP} = 'IGNORE';
1942 local $SIG{PIPE} = 'IGNORE';
1944 my $oldAutoCommit = $FS::UID::AutoCommit;
1945 local $FS::UID::AutoCommit = 0;
1948 my $part_pkg = new FS::part_pkg ( {
1950 'comment' => $comment,
1955 'taxclass' => $taxclass,
1958 my $error = $part_pkg->insert;
1960 $dbh->rollback if $oldAutoCommit;
1964 my $pkgpart = $part_pkg->pkgpart;
1965 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1966 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1967 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1968 $error = $type_pkgs->insert;
1970 $dbh->rollback if $oldAutoCommit;
1975 my $cust_pkg = new FS::cust_pkg ( {
1976 'custnum' => $self->custnum,
1977 'pkgpart' => $pkgpart,
1980 $error = $cust_pkg->insert;
1982 $dbh->rollback if $oldAutoCommit;
1986 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1993 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1999 sort { $a->_date <=> $b->_date }
2000 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2003 =item open_cust_bill
2005 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2010 sub open_cust_bill {
2012 grep { $_->owed > 0 } $self->cust_bill;
2021 =item check_and_rebuild_fuzzyfiles
2025 sub check_and_rebuild_fuzzyfiles {
2026 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2027 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2028 or &rebuild_fuzzyfiles;
2031 =item rebuild_fuzzyfiles
2035 sub rebuild_fuzzyfiles {
2037 use Fcntl qw(:flock);
2039 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2043 open(LASTLOCK,">>$dir/cust_main.last")
2044 or die "can't open $dir/cust_main.last: $!";
2045 flock(LASTLOCK,LOCK_EX)
2046 or die "can't lock $dir/cust_main.last: $!";
2048 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2050 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2051 if defined dbdef->table('cust_main')->column('ship_last');
2053 open (LASTCACHE,">$dir/cust_main.last.tmp")
2054 or die "can't open $dir/cust_main.last.tmp: $!";
2055 print LASTCACHE join("\n", @all_last), "\n";
2056 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2058 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2063 open(COMPANYLOCK,">>$dir/cust_main.company")
2064 or die "can't open $dir/cust_main.company: $!";
2065 flock(COMPANYLOCK,LOCK_EX)
2066 or die "can't lock $dir/cust_main.company: $!";
2068 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2070 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2071 if defined dbdef->table('cust_main')->column('ship_last');
2073 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2074 or die "can't open $dir/cust_main.company.tmp: $!";
2075 print COMPANYCACHE join("\n", @all_company), "\n";
2076 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2078 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2088 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2089 open(LASTCACHE,"<$dir/cust_main.last")
2090 or die "can't open $dir/cust_main.last: $!";
2091 my @array = map { chomp; $_; } <LASTCACHE>;
2101 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2102 open(COMPANYCACHE,"<$dir/cust_main.company")
2103 or die "can't open $dir/cust_main.last: $!";
2104 my @array = map { chomp; $_; } <COMPANYCACHE>;
2109 =item append_fuzzyfiles LASTNAME COMPANY
2113 sub append_fuzzyfiles {
2114 my( $last, $company ) = @_;
2116 &check_and_rebuild_fuzzyfiles;
2118 use Fcntl qw(:flock);
2120 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2124 open(LAST,">>$dir/cust_main.last")
2125 or die "can't open $dir/cust_main.last: $!";
2127 or die "can't lock $dir/cust_main.last: $!";
2129 print LAST "$last\n";
2132 or die "can't unlock $dir/cust_main.last: $!";
2138 open(COMPANY,">>$dir/cust_main.company")
2139 or die "can't open $dir/cust_main.company: $!";
2140 flock(COMPANY,LOCK_EX)
2141 or die "can't lock $dir/cust_main.company: $!";
2143 print COMPANY "$company\n";
2145 flock(COMPANY,LOCK_UN)
2146 or die "can't unlock $dir/cust_main.company: $!";
2160 #warn join('-',keys %$param);
2161 my $fh = $param->{filehandle};
2162 my $agentnum = $param->{agentnum};
2163 my $refnum = $param->{refnum};
2164 my $pkgpart = $param->{pkgpart};
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 agentnum => $agentnum,
2205 country => 'US', #default
2206 payby => 'BILL', #default
2207 paydate => '12/2037', #default
2209 my $billtime = time;
2210 my %cust_pkg = ( pkgpart => $pkgpart );
2211 foreach my $field ( @fields ) {
2212 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2213 #$cust_pkg{$1} = str2time( shift @$columns );
2214 if ( $1 eq 'setup' ) {
2215 $billtime = str2time(shift @columns);
2217 $cust_pkg{$1} = str2time( shift @columns );
2220 #$cust_main{$field} = shift @$columns;
2221 $cust_main{$field} = shift @columns;
2225 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2226 my $cust_main = new FS::cust_main ( \%cust_main );
2228 tie my %hash, 'Tie::RefHash'; #this part is important
2229 $hash{$cust_pkg} = [] if $pkgpart;
2230 my $error = $cust_main->insert( \%hash );
2233 $dbh->rollback if $oldAutoCommit;
2234 return "can't insert customer for $line: $error";
2237 #false laziness w/bill.cgi
2238 $error = $cust_main->bill( 'time' => $billtime );
2240 $dbh->rollback if $oldAutoCommit;
2241 return "can't bill customer for $line: $error";
2244 $cust_main->apply_payments;
2245 $cust_main->apply_credits;
2247 $error = $cust_main->collect();
2249 $dbh->rollback if $oldAutoCommit;
2250 return "can't collect customer for $line: $error";
2256 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2258 return "Empty file!" unless $imported;
2270 #warn join('-',keys %$param);
2271 my $fh = $param->{filehandle};
2272 my @fields = @{$param->{fields}};
2274 eval "use Date::Parse;";
2276 eval "use Text::CSV_XS;";
2279 my $csv = new Text::CSV_XS;
2286 local $SIG{HUP} = 'IGNORE';
2287 local $SIG{INT} = 'IGNORE';
2288 local $SIG{QUIT} = 'IGNORE';
2289 local $SIG{TERM} = 'IGNORE';
2290 local $SIG{TSTP} = 'IGNORE';
2291 local $SIG{PIPE} = 'IGNORE';
2293 my $oldAutoCommit = $FS::UID::AutoCommit;
2294 local $FS::UID::AutoCommit = 0;
2297 #while ( $columns = $csv->getline($fh) ) {
2299 while ( defined($line=<$fh>) ) {
2301 $csv->parse($line) or do {
2302 $dbh->rollback if $oldAutoCommit;
2303 return "can't parse: ". $csv->error_input();
2306 my @columns = $csv->fields();
2307 #warn join('-',@columns);
2310 foreach my $field ( @fields ) {
2311 $row{$field} = shift @columns;
2314 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2315 unless ( $cust_main ) {
2316 $dbh->rollback if $oldAutoCommit;
2317 return "unknown custnum $row{'custnum'}";
2320 if ( $row{'amount'} > 0 ) {
2321 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2323 $dbh->rollback if $oldAutoCommit;
2327 } elsif ( $row{'amount'} < 0 ) {
2328 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2331 $dbh->rollback if $oldAutoCommit;
2341 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2343 return "Empty file!" unless $imported;
2355 The delete method should possibly take an FS::cust_main object reference
2356 instead of a scalar customer number.
2358 Bill and collect options should probably be passed as references instead of a
2361 There should probably be a configuration file with a list of allowed credit
2364 No multiple currency support (probably a larger project than just this module).
2368 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2369 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2370 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.