4 use vars qw( @ISA $conf $Debug $import );
10 use Business::CreditCard;
11 use FS::UID qw( getotaker dbh );
12 use FS::Record qw( qsearchs qsearch dbdef );
15 use FS::cust_bill_pkg;
18 use FS::part_referral;
19 use FS::cust_main_county;
21 use FS::cust_main_invoice;
22 use FS::cust_credit_bill;
23 use FS::cust_bill_pay;
24 use FS::prepay_credit;
27 use FS::part_bill_event;
28 use FS::cust_bill_event;
30 @ISA = qw( FS::Record );
37 #ask FS::UID to run this stuff for us later
38 $FS::UID::callback{'FS::cust_main'} = sub {
40 #yes, need it for stuff below (prolly should be cached)
45 my ( $hashref, $cache ) = @_;
46 if ( exists $hashref->{'pkgnum'} ) {
47 # #@{ $self->{'_pkgnum'} } = ();
48 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
49 $self->{'_pkgnum'} = $subcache;
50 #push @{ $self->{'_pkgnum'} },
51 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
57 FS::cust_main - Object methods for cust_main records
63 $record = new FS::cust_main \%hash;
64 $record = new FS::cust_main { 'column' => 'value' };
66 $error = $record->insert;
68 $error = $new_record->replace($old_record);
70 $error = $record->delete;
72 $error = $record->check;
74 @cust_pkg = $record->all_pkgs;
76 @cust_pkg = $record->ncancelled_pkgs;
78 @cust_pkg = $record->suspended_pkgs;
80 $error = $record->bill;
81 $error = $record->bill %options;
82 $error = $record->bill 'time' => $time;
84 $error = $record->collect;
85 $error = $record->collect %options;
86 $error = $record->collect 'invoice_time' => $time,
87 'batch_card' => 'yes',
88 'report_badcard' => 'yes',
93 An FS::cust_main object represents a customer. FS::cust_main inherits from
94 FS::Record. The following fields are currently supported:
98 =item custnum - primary key (assigned automatically for new customers)
100 =item agentnum - agent (see L<FS::agent>)
102 =item refnum - referral (see L<FS::part_referral>)
108 =item ss - social security number (optional)
110 =item company - (optional)
114 =item address2 - (optional)
118 =item county - (optional, see L<FS::cust_main_county>)
120 =item state - (see L<FS::cust_main_county>)
124 =item country - (see L<FS::cust_main_county>)
126 =item daytime - phone (optional)
128 =item night - phone (optional)
130 =item fax - phone (optional)
132 =item ship_first - name
134 =item ship_last - name
136 =item ship_company - (optional)
140 =item ship_address2 - (optional)
144 =item ship_county - (optional, see L<FS::cust_main_county>)
146 =item ship_state - (see L<FS::cust_main_county>)
150 =item ship_country - (see L<FS::cust_main_county>)
152 =item ship_daytime - phone (optional)
154 =item ship_night - phone (optional)
156 =item ship_fax - phone (optional)
158 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
160 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
162 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
164 =item payname - name on card or billing name
166 =item tax - tax exempt, empty or `Y'
168 =item otaker - order taker (assigned automatically, see L<FS::UID>)
170 =item comments - comments (optional)
180 Creates a new customer. To add the customer to the database, see L<"insert">.
182 Note that this stores the hash reference, not a distinct copy of the hash it
183 points to. You can ask the object for a copy with the I<hash> method.
187 sub table { 'cust_main'; }
189 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
191 Adds this customer to the database. If there is an error, returns the error,
192 otherwise returns false.
194 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
195 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
196 are inserted atomicly, or the transaction is rolled back. Passing an empty
197 hash reference is equivalent to not supplying this parameter. There should be
198 a better explanation of this, but until then, here's an example:
201 tie %hash, 'Tie::RefHash'; #this part is important
203 $cust_pkg => [ $svc_acct ],
206 $cust_main->insert( \%hash );
208 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
209 be set as the invoicing list (see L<"invoicing_list">). Errors return as
210 expected and rollback the entire transaction; it is not necessary to call
211 check_invoicing_list first. The invoicing_list is set after the records in the
212 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
213 invoicing_list destination to the newly-created svc_acct. Here's an example:
215 $cust_main->insert( {}, [ $email, 'POST' ] );
223 local $SIG{HUP} = 'IGNORE';
224 local $SIG{INT} = 'IGNORE';
225 local $SIG{QUIT} = 'IGNORE';
226 local $SIG{TERM} = 'IGNORE';
227 local $SIG{TSTP} = 'IGNORE';
228 local $SIG{PIPE} = 'IGNORE';
230 my $oldAutoCommit = $FS::UID::AutoCommit;
231 local $FS::UID::AutoCommit = 0;
236 if ( $self->payby eq 'PREPAY' ) {
237 $self->payby('BILL');
238 my $prepay_credit = qsearchs(
240 { 'identifier' => $self->payinfo },
244 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
245 unless $prepay_credit;
246 $amount = $prepay_credit->amount;
247 $seconds = $prepay_credit->seconds;
248 my $error = $prepay_credit->delete;
250 $dbh->rollback if $oldAutoCommit;
251 return "removing prepay_credit (transaction rolled back): $error";
255 my $error = $self->SUPER::insert;
257 $dbh->rollback if $oldAutoCommit;
258 return "inserting cust_main record (transaction rolled back): $error";
261 if ( @param ) { # CUST_PKG_HASHREF
262 my $cust_pkgs = shift @param;
263 foreach my $cust_pkg ( keys %$cust_pkgs ) {
264 $cust_pkg->custnum( $self->custnum );
265 $error = $cust_pkg->insert;
267 $dbh->rollback if $oldAutoCommit;
268 return "inserting cust_pkg (transaction rolled back): $error";
270 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
271 $svc_something->pkgnum( $cust_pkg->pkgnum );
272 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
273 $svc_something->seconds( $svc_something->seconds + $seconds );
276 $error = $svc_something->insert;
278 $dbh->rollback if $oldAutoCommit;
279 return "inserting svc_ (transaction rolled back): $error";
286 $dbh->rollback if $oldAutoCommit;
287 return "No svc_acct record to apply pre-paid time";
290 if ( @param ) { # INVOICING_LIST_ARYREF
291 my $invoicing_list = shift @param;
292 $error = $self->check_invoicing_list( $invoicing_list );
294 $dbh->rollback if $oldAutoCommit;
295 return "checking invoicing_list (transaction rolled back): $error";
297 $self->invoicing_list( $invoicing_list );
301 my $cust_credit = new FS::cust_credit {
302 'custnum' => $self->custnum,
305 $error = $cust_credit->insert;
307 $dbh->rollback if $oldAutoCommit;
308 return "inserting credit (transaction rolled back): $error";
312 #false laziness with sub replace
313 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
314 $error = $queue->insert($self->getfield('last'), $self->company);
316 $dbh->rollback if $oldAutoCommit;
317 return "queueing job (transaction rolled back): $error";
320 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
321 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
322 $error = $queue->insert($self->getfield('last'), $self->company);
324 $dbh->rollback if $oldAutoCommit;
325 return "queueing job (transaction rolled back): $error";
330 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
335 =item delete NEW_CUSTNUM
337 This deletes the customer. If there is an error, returns the error, otherwise
340 This will completely remove all traces of the customer record. This is not
341 what you want when a customer cancels service; for that, cancel all of the
342 customer's packages (see L<FS::cust_pkg/cancel>).
344 If the customer has any uncancelled packages, you need to pass a new (valid)
345 customer number for those packages to be transferred to. Cancelled packages
346 will be deleted. Did I mention that this is NOT what you want when a customer
347 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
349 You can't delete a customer with invoices (see L<FS::cust_bill>),
350 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
351 refunds (see L<FS::cust_refund>).
358 local $SIG{HUP} = 'IGNORE';
359 local $SIG{INT} = 'IGNORE';
360 local $SIG{QUIT} = 'IGNORE';
361 local $SIG{TERM} = 'IGNORE';
362 local $SIG{TSTP} = 'IGNORE';
363 local $SIG{PIPE} = 'IGNORE';
365 my $oldAutoCommit = $FS::UID::AutoCommit;
366 local $FS::UID::AutoCommit = 0;
369 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
370 $dbh->rollback if $oldAutoCommit;
371 return "Can't delete a customer with invoices";
373 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
374 $dbh->rollback if $oldAutoCommit;
375 return "Can't delete a customer with credits";
377 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
378 $dbh->rollback if $oldAutoCommit;
379 return "Can't delete a customer with payments";
381 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
382 $dbh->rollback if $oldAutoCommit;
383 return "Can't delete a customer with refunds";
386 my @cust_pkg = $self->ncancelled_pkgs;
388 my $new_custnum = shift;
389 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
390 $dbh->rollback if $oldAutoCommit;
391 return "Invalid new customer number: $new_custnum";
393 foreach my $cust_pkg ( @cust_pkg ) {
394 my %hash = $cust_pkg->hash;
395 $hash{'custnum'} = $new_custnum;
396 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
397 my $error = $new_cust_pkg->replace($cust_pkg);
399 $dbh->rollback if $oldAutoCommit;
404 my @cancelled_cust_pkg = $self->all_pkgs;
405 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
406 my $error = $cust_pkg->delete;
408 $dbh->rollback if $oldAutoCommit;
413 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
414 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
416 my $error = $cust_main_invoice->delete;
418 $dbh->rollback if $oldAutoCommit;
423 my $error = $self->SUPER::delete;
425 $dbh->rollback if $oldAutoCommit;
429 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
434 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
436 Replaces the OLD_RECORD with this one in the database. If there is an error,
437 returns the error, otherwise returns false.
439 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
440 be set as the invoicing list (see L<"invoicing_list">). Errors return as
441 expected and rollback the entire transaction; it is not necessary to call
442 check_invoicing_list first. Here's an example:
444 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
453 local $SIG{HUP} = 'IGNORE';
454 local $SIG{INT} = 'IGNORE';
455 local $SIG{QUIT} = 'IGNORE';
456 local $SIG{TERM} = 'IGNORE';
457 local $SIG{TSTP} = 'IGNORE';
458 local $SIG{PIPE} = 'IGNORE';
460 my $oldAutoCommit = $FS::UID::AutoCommit;
461 local $FS::UID::AutoCommit = 0;
464 my $error = $self->SUPER::replace($old);
467 $dbh->rollback if $oldAutoCommit;
471 if ( @param ) { # INVOICING_LIST_ARYREF
472 my $invoicing_list = shift @param;
473 $error = $self->check_invoicing_list( $invoicing_list );
475 $dbh->rollback if $oldAutoCommit;
478 $self->invoicing_list( $invoicing_list );
481 #false laziness with sub insert
482 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
483 $error = $queue->insert($self->getfield('last'), $self->company);
485 $dbh->rollback if $oldAutoCommit;
486 return "queueing job (transaction rolled back): $error";
489 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
490 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
491 $error = $queue->insert($self->getfield('last'), $self->company);
493 $dbh->rollback if $oldAutoCommit;
494 return "queueing job (transaction rolled back): $error";
499 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
506 Checks all fields to make sure this is a valid customer record. If there is
507 an error, returns the error, otherwise returns false. Called by the insert
516 $self->ut_numbern('custnum')
517 || $self->ut_number('agentnum')
518 || $self->ut_number('refnum')
519 || $self->ut_name('last')
520 || $self->ut_name('first')
521 || $self->ut_textn('company')
522 || $self->ut_text('address1')
523 || $self->ut_textn('address2')
524 || $self->ut_text('city')
525 || $self->ut_textn('county')
526 || $self->ut_textn('state')
527 || $self->ut_country('country')
528 || $self->ut_anything('comments')
529 || $self->ut_numbern('referral_custnum')
531 #barf. need message catalogs. i18n. etc.
532 $error .= "Please select a referral."
533 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
534 return $error if $error;
536 return "Unknown agent"
537 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
539 return "Unknown referral"
540 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
542 return "Unknown referring custnum ". $self->referral_custnum
543 unless ! $self->referral_custnum
544 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
546 if ( $self->ss eq '' ) {
551 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
552 or return "Illegal social security number: ". $self->ss;
553 $self->ss("$1-$2-$3");
557 unless ( qsearchs('cust_main_county', {
558 'country' => $self->country,
561 return "Unknown state/county/country: ".
562 $self->state. "/". $self->county. "/". $self->country
563 unless qsearchs('cust_main_county',{
564 'state' => $self->state,
565 'county' => $self->county,
566 'country' => $self->country,
572 $self->ut_phonen('daytime', $self->country)
573 || $self->ut_phonen('night', $self->country)
574 || $self->ut_phonen('fax', $self->country)
575 || $self->ut_zip('zip', $self->country)
577 return $error if $error;
580 last first company address1 address2 city county state zip
581 country daytime night fax
584 if ( defined $self->dbdef_table->column('ship_last') ) {
585 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
586 && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
590 $self->ut_name('ship_last')
591 || $self->ut_name('ship_first')
592 || $self->ut_textn('ship_company')
593 || $self->ut_text('ship_address1')
594 || $self->ut_textn('ship_address2')
595 || $self->ut_text('ship_city')
596 || $self->ut_textn('ship_county')
597 || $self->ut_textn('ship_state')
598 || $self->ut_country('ship_country')
600 return $error if $error;
602 #false laziness with above
603 unless ( qsearchs('cust_main_county', {
604 'country' => $self->ship_country,
607 return "Unknown ship_state/ship_county/ship_country: ".
608 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
609 unless qsearchs('cust_main_county',{
610 'state' => $self->ship_state,
611 'county' => $self->ship_county,
612 'country' => $self->ship_country,
618 $self->ut_phonen('ship_daytime', $self->ship_country)
619 || $self->ut_phonen('ship_night', $self->ship_country)
620 || $self->ut_phonen('ship_fax', $self->ship_country)
621 || $self->ut_zip('ship_zip', $self->ship_country)
623 return $error if $error;
625 } else { # ship_ info eq billing info, so don't store dup info in database
626 $self->setfield("ship_$_", '')
627 foreach qw( last first company address1 address2 city county state zip
628 country daytime night fax );
632 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
633 or return "Illegal payby: ". $self->payby;
636 if ( $self->payby eq 'CARD' ) {
638 my $payinfo = $self->payinfo;
640 $payinfo =~ /^(\d{13,16})$/
641 or return "Illegal credit card number: ". $self->payinfo;
643 $self->payinfo($payinfo);
645 or return "Illegal credit card number: ". $self->payinfo;
646 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
648 } elsif ( $self->payby eq 'BILL' ) {
650 $error = $self->ut_textn('payinfo');
651 return "Illegal P.O. number: ". $self->payinfo if $error;
653 } elsif ( $self->payby eq 'COMP' ) {
655 $error = $self->ut_textn('payinfo');
656 return "Illegal comp account issuer: ". $self->payinfo if $error;
658 } elsif ( $self->payby eq 'PREPAY' ) {
660 my $payinfo = $self->payinfo;
661 $payinfo =~ s/\W//g; #anything else would just confuse things
662 $self->payinfo($payinfo);
663 $error = $self->ut_alpha('payinfo');
664 return "Illegal prepayment identifier: ". $self->payinfo if $error;
665 return "Unknown prepayment identifier"
666 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
670 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
671 return "Expriation date required"
672 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
675 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
676 or return "Illegal expiration date: ". $self->paydate;
677 if ( length($2) == 4 ) {
678 $self->paydate("$2-$1-01");
680 $self->paydate("20$2-$1-01");
684 if ( $self->payname eq '' ) {
685 $self->payname( $self->first. " ". $self->getfield('last') );
687 $self->payname =~ /^([\w \,\.\-\']+)$/
688 or return "Illegal billing name: ". $self->payname;
692 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
695 $self->otaker(getotaker);
702 Returns all packages (see L<FS::cust_pkg>) for this customer.
708 if ( $self->{'_pkgnum'} ) {
709 values %{ $self->{'_pkgnum'}->cache };
711 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
715 =item ncancelled_pkgs
717 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
721 sub ncancelled_pkgs {
723 if ( $self->{'_pkgnum'} ) {
724 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
726 @{ [ # force list context
727 qsearch( 'cust_pkg', {
728 'custnum' => $self->custnum,
731 qsearch( 'cust_pkg', {
732 'custnum' => $self->custnum,
741 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
747 grep { $_->susp } $self->ncancelled_pkgs;
750 =item unflagged_suspended_pkgs
752 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
753 customer (thouse packages without the `manual_flag' set).
757 sub unflagged_suspended_pkgs {
759 return $self->suspended_pkgs
760 unless dbdef->table('cust_pkg')->column('manual_flag');
761 grep { ! $_->manual_flag } $self->suspended_pkgs;
764 =item unsuspended_pkgs
766 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
771 sub unsuspended_pkgs {
773 grep { ! $_->susp } $self->ncancelled_pkgs;
778 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
779 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
780 on success or a list of errors.
786 grep { $_->unsuspend } $self->suspended_pkgs;
791 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
792 Always returns a list: an empty list on success or a list of errors.
798 grep { $_->suspend } $self->unsuspended_pkgs;
803 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
804 Always returns a list: an empty list on success or a list of errors.
810 grep { $_->cancel } $self->ncancelled_pkgs;
815 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
816 conjunction with the collect method.
818 Options are passed as name-value pairs.
820 The only currently available option is `time', which bills the customer as if
821 it were that time. It is specified as a UNIX timestamp; see
822 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
823 functions. For example:
827 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
829 If there is an error, returns the error, otherwise returns false.
834 my( $self, %options ) = @_;
835 my $time = $options{'time'} || time;
840 local $SIG{HUP} = 'IGNORE';
841 local $SIG{INT} = 'IGNORE';
842 local $SIG{QUIT} = 'IGNORE';
843 local $SIG{TERM} = 'IGNORE';
844 local $SIG{TSTP} = 'IGNORE';
845 local $SIG{PIPE} = 'IGNORE';
847 my $oldAutoCommit = $FS::UID::AutoCommit;
848 local $FS::UID::AutoCommit = 0;
851 # find the packages which are due for billing, find out how much they are
852 # & generate invoice database.
854 my( $total_setup, $total_recur ) = ( 0, 0 );
855 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
856 my @cust_bill_pkg = ();
858 foreach my $cust_pkg (
859 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
862 #NO!! next if $cust_pkg->cancel;
863 next if $cust_pkg->getfield('cancel');
865 #? to avoid use of uninitialized value errors... ?
866 $cust_pkg->setfield('bill', '')
867 unless defined($cust_pkg->bill);
869 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
871 #so we don't modify cust_pkg record unnecessarily
872 my $cust_pkg_mod_flag = 0;
873 my %hash = $cust_pkg->hash;
874 my $old_cust_pkg = new FS::cust_pkg \%hash;
878 unless ( $cust_pkg->setup ) {
879 my $setup_prog = $part_pkg->getfield('setup');
880 $setup_prog =~ /^(.*)$/ or do {
881 $dbh->rollback if $oldAutoCommit;
882 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
888 ##$cpt->permit(); #what is necessary?
889 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
890 #$setup = $cpt->reval($setup_prog);
891 $setup = eval $setup_prog;
892 unless ( defined($setup) ) {
893 $dbh->rollback if $oldAutoCommit;
894 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
895 "(expression $setup_prog): $@";
897 $cust_pkg->setfield('setup',$time);
898 $cust_pkg_mod_flag=1;
904 if ( $part_pkg->getfield('freq') > 0 &&
905 ! $cust_pkg->getfield('susp') &&
906 ( $cust_pkg->getfield('bill') || 0 ) < $time
908 my $recur_prog = $part_pkg->getfield('recur');
909 $recur_prog =~ /^(.*)$/ or do {
910 $dbh->rollback if $oldAutoCommit;
911 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
916 # shared with $recur_prog
917 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
920 ##$cpt->permit(); #what is necessary?
921 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
922 #$recur = $cpt->reval($recur_prog);
923 $recur = eval $recur_prog;
924 unless ( defined($recur) ) {
925 $dbh->rollback if $oldAutoCommit;
926 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
927 "(expression $recur_prog): $@";
929 #change this bit to use Date::Manip? CAREFUL with timezones (see
930 # mailing list archive)
931 my ($sec,$min,$hour,$mday,$mon,$year) =
932 (localtime($sdate) )[0,1,2,3,4,5];
934 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
935 # only for figuring next bill date, nothing else, so, reset $sdate again
937 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
939 $mon += $part_pkg->getfield('freq');
940 until ( $mon < 12 ) { $mon -= 12; $year++; }
941 $cust_pkg->setfield('bill',
942 timelocal($sec,$min,$hour,$mday,$mon,$year));
943 $cust_pkg_mod_flag = 1;
946 warn "\$setup is undefined" unless defined($setup);
947 warn "\$recur is undefined" unless defined($recur);
948 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
950 if ( $cust_pkg_mod_flag ) {
951 $error=$cust_pkg->replace($old_cust_pkg);
952 if ( $error ) { #just in case
953 $dbh->rollback if $oldAutoCommit;
954 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
956 $setup = sprintf( "%.2f", $setup );
957 $recur = sprintf( "%.2f", $recur );
959 $dbh->rollback if $oldAutoCommit;
960 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
963 $dbh->rollback if $oldAutoCommit;
964 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
966 if ( $setup > 0 || $recur > 0 ) {
967 my $cust_bill_pkg = new FS::cust_bill_pkg ({
968 'pkgnum' => $cust_pkg->pkgnum,
972 'edate' => $cust_pkg->bill,
974 push @cust_bill_pkg, $cust_bill_pkg;
975 $total_setup += $setup;
976 $total_recur += $recur;
977 $taxable_setup += $setup
978 unless $part_pkg->dbdef_table->column('setuptax')
979 && $part_pkg->setuptax =~ /^Y$/i;
980 $taxable_recur += $recur
981 unless $part_pkg->dbdef_table->column('recurtax')
982 && $part_pkg->recurtax =~ /^Y$/i;
988 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
989 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
991 unless ( @cust_bill_pkg ) {
992 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
996 unless ( $self->tax =~ /Y/i
997 || $self->payby eq 'COMP'
998 || $taxable_charged == 0 ) {
999 my $cust_main_county = qsearchs('cust_main_county',{
1000 'state' => $self->state,
1001 'county' => $self->county,
1002 'country' => $self->country,
1003 } ) or die "fatal: can't find tax rate for state/county/country ".
1004 $self->state. "/". $self->county. "/". $self->country. "\n";
1005 my $tax = sprintf( "%.2f",
1006 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1010 $charged = sprintf( "%.2f", $charged+$tax );
1012 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1019 push @cust_bill_pkg, $cust_bill_pkg;
1023 my $cust_bill = new FS::cust_bill ( {
1024 'custnum' => $self->custnum,
1026 'charged' => $charged,
1028 $error = $cust_bill->insert;
1030 $dbh->rollback if $oldAutoCommit;
1031 return "can't create invoice for customer #". $self->custnum. ": $error";
1034 my $invnum = $cust_bill->invnum;
1036 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1038 $cust_bill_pkg->invnum($invnum);
1039 $error = $cust_bill_pkg->insert;
1041 $dbh->rollback if $oldAutoCommit;
1042 return "can't create invoice line item for customer #". $self->custnum.
1047 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1051 =item collect OPTIONS
1053 (Attempt to) collect money for this customer's outstanding invoices (see
1054 L<FS::cust_bill>). Usually used after the bill method.
1056 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1057 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1059 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1060 and the invoice events web interface.
1062 If there is an error, returns the error, otherwise returns false.
1064 Options are passed as name-value pairs.
1066 Currently available options are:
1068 invoice_time - Use this time when deciding when to print invoices and
1069 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>
1070 for conversion functions.
1072 batch_card - This option is deprecated. See the invoice events web interface
1073 to control whether cards are batched or run against a realtime gateway.
1075 report_badcard - This option is deprecated.
1077 force_print - This option is deprecated; see the invoice events web interface.
1082 my( $self, %options ) = @_;
1083 my $invoice_time = $options{'invoice_time'} || time;
1086 local $SIG{HUP} = 'IGNORE';
1087 local $SIG{INT} = 'IGNORE';
1088 local $SIG{QUIT} = 'IGNORE';
1089 local $SIG{TERM} = 'IGNORE';
1090 local $SIG{TSTP} = 'IGNORE';
1091 local $SIG{PIPE} = 'IGNORE';
1093 my $oldAutoCommit = $FS::UID::AutoCommit;
1094 local $FS::UID::AutoCommit = 0;
1097 my $balance = $self->balance;
1098 warn "collect: balance $balance" if $Debug;
1099 unless ( $balance > 0 ) { #redundant?????
1100 $dbh->rollback if $oldAutoCommit; #hmm
1104 foreach my $cust_bill (
1105 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1108 #this has to be before next's
1109 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1113 $balance = sprintf( "%.2f", $balance - $amount );
1115 next unless $cust_bill->owed > 0;
1117 # don't try to charge for the same invoice if it's already in a batch
1118 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1120 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1122 next unless $amount > 0;
1124 foreach my $part_bill_event (
1125 sort { $a->seconds <=> $b->seconds
1126 || $a->weight <=> $b->weight
1127 || $a->eventpart <=> $b->eventpart }
1128 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1129 && ! qsearchs( 'cust_bill_event', {
1130 'invnum' => $cust_bill->invnum,
1131 'eventpart' => $_->eventpart } )
1133 qsearch('part_bill_event', { 'payby' => $self->payby,
1134 'disabled' => '', } )
1137 my $cust_main = $self; #for callback
1138 my $error = eval $part_bill_event->eventcode;
1142 warn "Error running invoice event (". $part_bill_event->eventcode.
1147 #add cust_bill_event
1148 my $cust_bill_event = new FS::cust_bill_event {
1149 'invnum' => $cust_bill->invnum,
1150 'eventpart' => $part_bill_event->eventpart,
1151 '_date' => $invoice_time,
1153 $cust_bill_event->insert;
1155 #$dbh->rollback if $oldAutoCommit;
1156 #return "error: $error";
1158 # gah, even with transactions.
1159 $dbh->commit if $oldAutoCommit; #well.
1160 my $e = 'WARNING: Event run but database not updated - '.
1161 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1162 ', eventpart '. $part_bill_event->eventpart.
1174 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1181 Returns the total owed for this customer on all invoices
1182 (see L<FS::cust_bill/owed>).
1188 $self->total_owed_date(2145859200); #12/31/2037
1191 =item total_owed_date TIME
1193 Returns the total owed for this customer on all invoices with date earlier than
1194 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1195 see L<Time::Local> and L<Date::Parse> for conversion functions.
1199 sub total_owed_date {
1203 foreach my $cust_bill (
1204 grep { $_->_date <= $time }
1205 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1207 $total_bill += $cust_bill->owed;
1209 sprintf( "%.2f", $total_bill );
1214 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1215 to outstanding invoice balances in chronological order and returns the value
1216 of any remaining unapplied credits available for refund
1217 (see L<FS::cust_refund>).
1224 return 0 unless $self->total_credited;
1226 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1227 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1229 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1230 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1234 foreach my $cust_bill ( @invoices ) {
1237 if ( !defined($credit) || $credit->credited == 0) {
1238 $credit = pop @credits or last;
1241 if ($cust_bill->owed >= $credit->credited) {
1242 $amount=$credit->credited;
1244 $amount=$cust_bill->owed;
1247 my $cust_credit_bill = new FS::cust_credit_bill ( {
1248 'crednum' => $credit->crednum,
1249 'invnum' => $cust_bill->invnum,
1250 'amount' => $amount,
1252 my $error = $cust_credit_bill->insert;
1253 die $error if $error;
1255 redo if ($cust_bill->owed > 0);
1259 return $self->total_credited;
1262 =item apply_payments
1264 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1265 to outstanding invoice balances in chronological order.
1267 #and returns the value of any remaining unapplied payments.
1271 sub apply_payments {
1276 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1277 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1279 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1280 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1284 foreach my $cust_bill ( @invoices ) {
1287 if ( !defined($payment) || $payment->unapplied == 0 ) {
1288 $payment = pop @payments or last;
1291 if ( $cust_bill->owed >= $payment->unapplied ) {
1292 $amount = $payment->unapplied;
1294 $amount = $cust_bill->owed;
1297 my $cust_bill_pay = new FS::cust_bill_pay ( {
1298 'paynum' => $payment->paynum,
1299 'invnum' => $cust_bill->invnum,
1300 'amount' => $amount,
1302 my $error = $cust_bill_pay->insert;
1303 die $error if $error;
1305 redo if ( $cust_bill->owed > 0);
1309 return $self->total_unapplied_payments;
1312 =item total_credited
1314 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1315 customer. See L<FS::cust_credit/credited>.
1319 sub total_credited {
1321 my $total_credit = 0;
1322 foreach my $cust_credit ( qsearch('cust_credit', {
1323 'custnum' => $self->custnum,
1325 $total_credit += $cust_credit->credited;
1327 sprintf( "%.2f", $total_credit );
1330 =item total_unapplied_payments
1332 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1333 See L<FS::cust_pay/unapplied>.
1337 sub total_unapplied_payments {
1339 my $total_unapplied = 0;
1340 foreach my $cust_pay ( qsearch('cust_pay', {
1341 'custnum' => $self->custnum,
1343 $total_unapplied += $cust_pay->unapplied;
1345 sprintf( "%.2f", $total_unapplied );
1350 Returns the balance for this customer (total_owed minus total_credited
1351 minus total_unapplied_payments).
1358 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1362 =item balance_date TIME
1364 Returns the balance for this customer, only considering invoices with date
1365 earlier than TIME (total_owed_date minus total_credited minus
1366 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1367 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1376 $self->total_owed_date($time)
1377 - $self->total_credited
1378 - $self->total_unapplied_payments
1382 =item invoicing_list [ ARRAYREF ]
1384 If an arguement is given, sets these email addresses as invoice recipients
1385 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1386 (except as warnings), so use check_invoicing_list first.
1388 Returns a list of email addresses (with svcnum entries expanded).
1390 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1391 check it without disturbing anything by passing nothing.
1393 This interface may change in the future.
1397 sub invoicing_list {
1398 my( $self, $arrayref ) = @_;
1400 my @cust_main_invoice;
1401 if ( $self->custnum ) {
1402 @cust_main_invoice =
1403 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1405 @cust_main_invoice = ();
1407 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1408 #warn $cust_main_invoice->destnum;
1409 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1410 #warn $cust_main_invoice->destnum;
1411 my $error = $cust_main_invoice->delete;
1412 warn $error if $error;
1415 if ( $self->custnum ) {
1416 @cust_main_invoice =
1417 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1419 @cust_main_invoice = ();
1421 my %seen = map { $_->address => 1 } @cust_main_invoice;
1422 foreach my $address ( @{$arrayref} ) {
1423 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1424 next if exists $seen{$address} && $seen{$address};
1425 $seen{$address} = 1;
1426 my $cust_main_invoice = new FS::cust_main_invoice ( {
1427 'custnum' => $self->custnum,
1430 my $error = $cust_main_invoice->insert;
1431 warn $error if $error;
1434 if ( $self->custnum ) {
1436 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1442 =item check_invoicing_list ARRAYREF
1444 Checks these arguements as valid input for the invoicing_list method. If there
1445 is an error, returns the error, otherwise returns false.
1449 sub check_invoicing_list {
1450 my( $self, $arrayref ) = @_;
1451 foreach my $address ( @{$arrayref} ) {
1452 my $cust_main_invoice = new FS::cust_main_invoice ( {
1453 'custnum' => $self->custnum,
1456 my $error = $self->custnum
1457 ? $cust_main_invoice->check
1458 : $cust_main_invoice->checkdest
1460 return $error if $error;
1465 =item default_invoicing_list
1467 Sets the invoicing list to all accounts associated with this customer.
1471 sub default_invoicing_list {
1474 foreach my $cust_pkg ( $self->all_pkgs ) {
1475 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1477 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1478 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1480 push @list, map { $_->email } @svc_acct;
1482 $self->invoicing_list(\@list);
1485 =item invoicing_list_addpost
1487 Adds postal invoicing to this customer. If this customer is already configured
1488 to receive postal invoices, does nothing.
1492 sub invoicing_list_addpost {
1494 return if grep { $_ eq 'POST' } $self->invoicing_list;
1495 my @invoicing_list = $self->invoicing_list;
1496 push @invoicing_list, 'POST';
1497 $self->invoicing_list(\@invoicing_list);
1500 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1502 Returns an array of customers referred by this customer (referral_custnum set
1503 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1504 customers referred by customers referred by this customer and so on, inclusive.
1505 The default behavior is DEPTH 1 (no recursion).
1509 sub referral_cust_main {
1511 my $depth = @_ ? shift : 1;
1512 my $exclude = @_ ? shift : {};
1515 map { $exclude->{$_->custnum}++; $_; }
1516 grep { ! $exclude->{ $_->custnum } }
1517 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1521 map { $_->referral_cust_main($depth-1, $exclude) }
1528 =item referral_cust_main_ncancelled
1530 Same as referral_cust_main, except only returns customers with uncancelled
1535 sub referral_cust_main_ncancelled {
1537 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1540 =item referral_cust_pkg [ DEPTH ]
1542 Like referral_cust_main, except returns a flat list of all unsuspended (and
1543 uncancelled) packages for each customer. The number of items in this list may
1544 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1548 sub referral_cust_pkg {
1550 my $depth = @_ ? shift : 1;
1552 map { $_->unsuspended_pkgs }
1553 grep { $_->unsuspended_pkgs }
1554 $self->referral_cust_main($depth);
1557 =item credit AMOUNT, REASON
1559 Applies a credit to this customer. If there is an error, returns the error,
1560 otherwise returns false.
1565 my( $self, $amount, $reason ) = @_;
1566 my $cust_credit = new FS::cust_credit {
1567 'custnum' => $self->custnum,
1568 'amount' => $amount,
1569 'reason' => $reason,
1571 $cust_credit->insert;
1574 =item charge AMOUNT PKG COMMENT
1576 Creates a one-time charge for this customer. If there is an error, returns
1577 the error, otherwise returns false.
1582 my ( $self, $amount, $pkg, $comment ) = @_;
1584 my $part_pkg = new FS::part_pkg ( {
1585 'pkg' => $pkg || 'One-time charge',
1586 'comment' => $comment || '$'. sprintf("%.2f".$amount),
1603 =item check_and_rebuild_fuzzyfiles
1607 sub check_and_rebuild_fuzzyfiles {
1608 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1609 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1610 or &rebuild_fuzzyfiles;
1613 =item rebuild_fuzzyfiles
1617 sub rebuild_fuzzyfiles {
1619 use Fcntl qw(:flock);
1621 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1625 open(LASTLOCK,">>$dir/cust_main.last")
1626 or die "can't open $dir/cust_main.last: $!";
1627 flock(LASTLOCK,LOCK_EX)
1628 or die "can't lock $dir/cust_main.last: $!";
1630 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1632 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1633 if defined dbdef->table('cust_main')->column('ship_last');
1635 open (LASTCACHE,">$dir/cust_main.last.tmp")
1636 or die "can't open $dir/cust_main.last.tmp: $!";
1637 print LASTCACHE join("\n", @all_last), "\n";
1638 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1640 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1645 open(COMPANYLOCK,">>$dir/cust_main.company")
1646 or die "can't open $dir/cust_main.company: $!";
1647 flock(COMPANYLOCK,LOCK_EX)
1648 or die "can't lock $dir/cust_main.company: $!";
1650 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1652 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1653 if defined dbdef->table('cust_main')->column('ship_last');
1655 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1656 or die "can't open $dir/cust_main.company.tmp: $!";
1657 print COMPANYCACHE join("\n", @all_company), "\n";
1658 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1660 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1670 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1671 open(LASTCACHE,"<$dir/cust_main.last")
1672 or die "can't open $dir/cust_main.last: $!";
1673 my @array = map { chomp; $_; } <LASTCACHE>;
1683 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1684 open(COMPANYCACHE,"<$dir/cust_main.company")
1685 or die "can't open $dir/cust_main.last: $!";
1686 my @array = map { chomp; $_; } <COMPANYCACHE>;
1691 =item append_fuzzyfiles LASTNAME COMPANY
1695 sub append_fuzzyfiles {
1696 my( $last, $company ) = @_;
1698 &check_and_rebuild_fuzzyfiles;
1700 use Fcntl qw(:flock);
1702 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1706 open(LAST,">>$dir/cust_main.last")
1707 or die "can't open $dir/cust_main.last: $!";
1709 or die "can't lock $dir/cust_main.last: $!";
1711 print LAST "$last\n";
1714 or die "can't unlock $dir/cust_main.last: $!";
1720 open(COMPANY,">>$dir/cust_main.company")
1721 or die "can't open $dir/cust_main.company: $!";
1722 flock(COMPANY,LOCK_EX)
1723 or die "can't lock $dir/cust_main.company: $!";
1725 print COMPANY "$company\n";
1727 flock(COMPANY,LOCK_UN)
1728 or die "can't unlock $dir/cust_main.company: $!";
1742 The delete method should possibly take an FS::cust_main object reference
1743 instead of a scalar customer number.
1745 Bill and collect options should probably be passed as references instead of a
1748 There should probably be a configuration file with a list of allowed credit
1751 No multiple currency support (probably a larger project than just this module).
1755 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1756 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1757 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.