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
515 warn "BEFORE: \n". $self->_dump;
518 $self->ut_numbern('custnum')
519 || $self->ut_number('agentnum')
520 || $self->ut_number('refnum')
521 || $self->ut_name('last')
522 || $self->ut_name('first')
523 || $self->ut_textn('company')
524 || $self->ut_text('address1')
525 || $self->ut_textn('address2')
526 || $self->ut_text('city')
527 || $self->ut_textn('county')
528 || $self->ut_textn('state')
529 || $self->ut_country('country')
530 || $self->ut_anything('comments')
531 || $self->ut_numbern('referral_custnum')
533 #barf. need message catalogs. i18n. etc.
534 $error .= "Please select a referral."
535 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
536 return $error if $error;
538 return "Unknown agent"
539 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
541 return "Unknown referral"
542 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
544 return "Unknown referring custnum ". $self->referral_custnum
545 unless ! $self->referral_custnum
546 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
548 if ( $self->ss eq '' ) {
553 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
554 or return "Illegal social security number: ". $self->ss;
555 $self->ss("$1-$2-$3");
559 # bad idea to disable, causes billing to fail because of no tax rates later
560 # unless ( $import ) {
561 unless ( qsearchs('cust_main_county', {
562 'country' => $self->country,
565 return "Unknown state/county/country: ".
566 $self->state. "/". $self->county. "/". $self->country
567 unless qsearchs('cust_main_county',{
568 'state' => $self->state,
569 'county' => $self->county,
570 'country' => $self->country,
576 $self->ut_phonen('daytime', $self->country)
577 || $self->ut_phonen('night', $self->country)
578 || $self->ut_phonen('fax', $self->country)
579 || $self->ut_zip('zip', $self->country)
581 return $error if $error;
584 last first company address1 address2 city county state zip
585 country daytime night fax
588 if ( defined $self->dbdef_table->column('ship_last') ) {
589 if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
590 && grep { $self->getfield("ship_$_") ne '' } @addfields
594 $self->ut_name('ship_last')
595 || $self->ut_name('ship_first')
596 || $self->ut_textn('ship_company')
597 || $self->ut_text('ship_address1')
598 || $self->ut_textn('ship_address2')
599 || $self->ut_text('ship_city')
600 || $self->ut_textn('ship_county')
601 || $self->ut_textn('ship_state')
602 || $self->ut_country('ship_country')
604 return $error if $error;
606 #false laziness with above
607 unless ( qsearchs('cust_main_county', {
608 'country' => $self->ship_country,
611 return "Unknown ship_state/ship_county/ship_country: ".
612 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
613 unless qsearchs('cust_main_county',{
614 'state' => $self->ship_state,
615 'county' => $self->ship_county,
616 'country' => $self->ship_country,
622 $self->ut_phonen('ship_daytime', $self->ship_country)
623 || $self->ut_phonen('ship_night', $self->ship_country)
624 || $self->ut_phonen('ship_fax', $self->ship_country)
625 || $self->ut_zip('ship_zip', $self->ship_country)
627 return $error if $error;
629 } else { # ship_ info eq billing info, so don't store dup info in database
630 $self->setfield("ship_$_", '')
631 foreach qw( last first company address1 address2 city county state zip
632 country daytime night fax );
636 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
637 or return "Illegal payby: ". $self->payby;
640 if ( $self->payby eq 'CARD' ) {
642 my $payinfo = $self->payinfo;
644 $payinfo =~ /^(\d{13,16})$/
645 or return "Illegal credit card number: ". $self->payinfo;
647 $self->payinfo($payinfo);
649 or return "Illegal credit card number: ". $self->payinfo;
650 return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
652 } elsif ( $self->payby eq 'BILL' ) {
654 $error = $self->ut_textn('payinfo');
655 return "Illegal P.O. number: ". $self->payinfo if $error;
657 } elsif ( $self->payby eq 'COMP' ) {
659 $error = $self->ut_textn('payinfo');
660 return "Illegal comp account issuer: ". $self->payinfo if $error;
662 } elsif ( $self->payby eq 'PREPAY' ) {
664 my $payinfo = $self->payinfo;
665 $payinfo =~ s/\W//g; #anything else would just confuse things
666 $self->payinfo($payinfo);
667 $error = $self->ut_alpha('payinfo');
668 return "Illegal prepayment identifier: ". $self->payinfo if $error;
669 return "Unknown prepayment identifier"
670 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
674 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
675 return "Expriation date required"
676 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
679 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
680 or return "Illegal expiration date: ". $self->paydate;
681 if ( length($2) == 4 ) {
682 $self->paydate("$2-$1-01");
684 $self->paydate("20$2-$1-01");
688 if ( $self->payname eq '' ) {
689 $self->payname( $self->first. " ". $self->getfield('last') );
691 $self->payname =~ /^([\w \,\.\-\']+)$/
692 or return "Illegal billing name: ". $self->payname;
696 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
699 $self->otaker(getotaker);
701 warn "AFTER: \n". $self->_dump;
708 Returns all packages (see L<FS::cust_pkg>) for this customer.
714 if ( $self->{'_pkgnum'} ) {
715 values %{ $self->{'_pkgnum'}->cache };
717 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
721 =item ncancelled_pkgs
723 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
727 sub ncancelled_pkgs {
729 if ( $self->{'_pkgnum'} ) {
730 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
732 @{ [ # force list context
733 qsearch( 'cust_pkg', {
734 'custnum' => $self->custnum,
737 qsearch( 'cust_pkg', {
738 'custnum' => $self->custnum,
747 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
753 grep { $_->susp } $self->ncancelled_pkgs;
756 =item unflagged_suspended_pkgs
758 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
759 customer (thouse packages without the `manual_flag' set).
763 sub unflagged_suspended_pkgs {
765 return $self->suspended_pkgs
766 unless dbdef->table('cust_pkg')->column('manual_flag');
767 grep { ! $_->manual_flag } $self->suspended_pkgs;
770 =item unsuspended_pkgs
772 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
777 sub unsuspended_pkgs {
779 grep { ! $_->susp } $self->ncancelled_pkgs;
784 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
785 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
786 on success or a list of errors.
792 grep { $_->unsuspend } $self->suspended_pkgs;
797 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
798 Always returns a list: an empty list on success or a list of errors.
804 grep { $_->suspend } $self->unsuspended_pkgs;
809 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
810 Always returns a list: an empty list on success or a list of errors.
816 grep { $_->cancel } $self->ncancelled_pkgs;
821 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
822 conjunction with the collect method.
824 Options are passed as name-value pairs.
826 The only currently available option is `time', which bills the customer as if
827 it were that time. It is specified as a UNIX timestamp; see
828 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
829 functions. For example:
833 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
835 If there is an error, returns the error, otherwise returns false.
840 my( $self, %options ) = @_;
841 my $time = $options{'time'} || time;
846 local $SIG{HUP} = 'IGNORE';
847 local $SIG{INT} = 'IGNORE';
848 local $SIG{QUIT} = 'IGNORE';
849 local $SIG{TERM} = 'IGNORE';
850 local $SIG{TSTP} = 'IGNORE';
851 local $SIG{PIPE} = 'IGNORE';
853 my $oldAutoCommit = $FS::UID::AutoCommit;
854 local $FS::UID::AutoCommit = 0;
857 # find the packages which are due for billing, find out how much they are
858 # & generate invoice database.
860 my( $total_setup, $total_recur ) = ( 0, 0 );
861 my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
862 my @cust_bill_pkg = ();
864 foreach my $cust_pkg (
865 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
868 #NO!! next if $cust_pkg->cancel;
869 next if $cust_pkg->getfield('cancel');
871 #? to avoid use of uninitialized value errors... ?
872 $cust_pkg->setfield('bill', '')
873 unless defined($cust_pkg->bill);
875 my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
877 #so we don't modify cust_pkg record unnecessarily
878 my $cust_pkg_mod_flag = 0;
879 my %hash = $cust_pkg->hash;
880 my $old_cust_pkg = new FS::cust_pkg \%hash;
884 unless ( $cust_pkg->setup ) {
885 my $setup_prog = $part_pkg->getfield('setup');
886 $setup_prog =~ /^(.*)$/ or do {
887 $dbh->rollback if $oldAutoCommit;
888 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
894 ##$cpt->permit(); #what is necessary?
895 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
896 #$setup = $cpt->reval($setup_prog);
897 $setup = eval $setup_prog;
898 unless ( defined($setup) ) {
899 $dbh->rollback if $oldAutoCommit;
900 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
901 "(expression $setup_prog): $@";
903 $cust_pkg->setfield('setup',$time);
904 $cust_pkg_mod_flag=1;
910 if ( $part_pkg->getfield('freq') > 0 &&
911 ! $cust_pkg->getfield('susp') &&
912 ( $cust_pkg->getfield('bill') || 0 ) < $time
914 my $recur_prog = $part_pkg->getfield('recur');
915 $recur_prog =~ /^(.*)$/ or do {
916 $dbh->rollback if $oldAutoCommit;
917 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
922 # shared with $recur_prog
923 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
926 ##$cpt->permit(); #what is necessary?
927 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
928 #$recur = $cpt->reval($recur_prog);
929 $recur = eval $recur_prog;
930 unless ( defined($recur) ) {
931 $dbh->rollback if $oldAutoCommit;
932 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
933 "(expression $recur_prog): $@";
935 #change this bit to use Date::Manip? CAREFUL with timezones (see
936 # mailing list archive)
937 my ($sec,$min,$hour,$mday,$mon,$year) =
938 (localtime($sdate) )[0,1,2,3,4,5];
940 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
941 # only for figuring next bill date, nothing else, so, reset $sdate again
943 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
945 $mon += $part_pkg->getfield('freq');
946 until ( $mon < 12 ) { $mon -= 12; $year++; }
947 $cust_pkg->setfield('bill',
948 timelocal($sec,$min,$hour,$mday,$mon,$year));
949 $cust_pkg_mod_flag = 1;
952 warn "\$setup is undefined" unless defined($setup);
953 warn "\$recur is undefined" unless defined($recur);
954 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
956 if ( $cust_pkg_mod_flag ) {
957 $error=$cust_pkg->replace($old_cust_pkg);
958 if ( $error ) { #just in case
959 $dbh->rollback if $oldAutoCommit;
960 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
962 $setup = sprintf( "%.2f", $setup );
963 $recur = sprintf( "%.2f", $recur );
965 $dbh->rollback if $oldAutoCommit;
966 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
969 $dbh->rollback if $oldAutoCommit;
970 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
972 if ( $setup > 0 || $recur > 0 ) {
973 my $cust_bill_pkg = new FS::cust_bill_pkg ({
974 'pkgnum' => $cust_pkg->pkgnum,
978 'edate' => $cust_pkg->bill,
980 push @cust_bill_pkg, $cust_bill_pkg;
981 $total_setup += $setup;
982 $total_recur += $recur;
983 $taxable_setup += $setup
984 unless $part_pkg->dbdef_table->column('setuptax')
985 && $part_pkg->setuptax =~ /^Y$/i;
986 $taxable_recur += $recur
987 unless $part_pkg->dbdef_table->column('recurtax')
988 && $part_pkg->recurtax =~ /^Y$/i;
994 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
995 my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
997 unless ( @cust_bill_pkg ) {
998 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1002 unless ( $self->tax =~ /Y/i
1003 || $self->payby eq 'COMP'
1004 || $taxable_charged == 0 ) {
1005 my $cust_main_county = qsearchs('cust_main_county',{
1006 'state' => $self->state,
1007 'county' => $self->county,
1008 'country' => $self->country,
1009 } ) or die "fatal: can't find tax rate for state/county/country ".
1010 $self->state. "/". $self->county. "/". $self->country. "\n";
1011 my $tax = sprintf( "%.2f",
1012 $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1016 $charged = sprintf( "%.2f", $charged+$tax );
1018 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1025 push @cust_bill_pkg, $cust_bill_pkg;
1029 my $cust_bill = new FS::cust_bill ( {
1030 'custnum' => $self->custnum,
1032 'charged' => $charged,
1034 $error = $cust_bill->insert;
1036 $dbh->rollback if $oldAutoCommit;
1037 return "can't create invoice for customer #". $self->custnum. ": $error";
1040 my $invnum = $cust_bill->invnum;
1042 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1044 $cust_bill_pkg->invnum($invnum);
1045 $error = $cust_bill_pkg->insert;
1047 $dbh->rollback if $oldAutoCommit;
1048 return "can't create invoice line item for customer #". $self->custnum.
1053 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1057 =item collect OPTIONS
1059 (Attempt to) collect money for this customer's outstanding invoices (see
1060 L<FS::cust_bill>). Usually used after the bill method.
1062 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1063 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1065 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1066 and the invoice events web interface.
1068 If there is an error, returns the error, otherwise returns false.
1070 Options are passed as name-value pairs.
1072 Currently available options are:
1074 invoice_time - Use this time when deciding when to print invoices and
1075 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>
1076 for conversion functions.
1078 batch_card - This option is deprecated. See the invoice events web interface
1079 to control whether cards are batched or run against a realtime gateway.
1081 report_badcard - This option is deprecated.
1083 force_print - This option is deprecated; see the invoice events web interface.
1088 my( $self, %options ) = @_;
1089 my $invoice_time = $options{'invoice_time'} || time;
1092 local $SIG{HUP} = 'IGNORE';
1093 local $SIG{INT} = 'IGNORE';
1094 local $SIG{QUIT} = 'IGNORE';
1095 local $SIG{TERM} = 'IGNORE';
1096 local $SIG{TSTP} = 'IGNORE';
1097 local $SIG{PIPE} = 'IGNORE';
1099 my $oldAutoCommit = $FS::UID::AutoCommit;
1100 local $FS::UID::AutoCommit = 0;
1103 my $balance = $self->balance;
1104 warn "collect: balance $balance" if $Debug;
1105 unless ( $balance > 0 ) { #redundant?????
1106 $dbh->rollback if $oldAutoCommit; #hmm
1110 foreach my $cust_bill (
1111 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1114 #this has to be before next's
1115 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1119 $balance = sprintf( "%.2f", $balance - $amount );
1121 next unless $cust_bill->owed > 0;
1123 # don't try to charge for the same invoice if it's already in a batch
1124 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1126 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1128 next unless $amount > 0;
1130 foreach my $part_bill_event (
1131 sort { $a->seconds <=> $b->seconds
1132 || $a->weight <=> $b->weight
1133 || $a->eventpart <=> $b->eventpart }
1134 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1135 && ! qsearchs( 'cust_bill_event', {
1136 'invnum' => $cust_bill->invnum,
1137 'eventpart' => $_->eventpart } )
1139 qsearch('part_bill_event', { 'payby' => $self->payby,
1140 'disabled' => '', } )
1143 my $cust_main = $self; #for callback
1144 my $error = eval $part_bill_event->eventcode;
1148 warn "Error running invoice event (". $part_bill_event->eventcode.
1153 #add cust_bill_event
1154 my $cust_bill_event = new FS::cust_bill_event {
1155 'invnum' => $cust_bill->invnum,
1156 'eventpart' => $part_bill_event->eventpart,
1157 '_date' => $invoice_time,
1159 $cust_bill_event->insert;
1161 #$dbh->rollback if $oldAutoCommit;
1162 #return "error: $error";
1164 # gah, even with transactions.
1165 $dbh->commit if $oldAutoCommit; #well.
1166 my $e = 'WARNING: Event run but database not updated - '.
1167 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1168 ', eventpart '. $part_bill_event->eventpart.
1180 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1187 Returns the total owed for this customer on all invoices
1188 (see L<FS::cust_bill/owed>).
1194 $self->total_owed_date(2145859200); #12/31/2037
1197 =item total_owed_date TIME
1199 Returns the total owed for this customer on all invoices with date earlier than
1200 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1201 see L<Time::Local> and L<Date::Parse> for conversion functions.
1205 sub total_owed_date {
1209 foreach my $cust_bill (
1210 grep { $_->_date <= $time }
1211 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1213 $total_bill += $cust_bill->owed;
1215 sprintf( "%.2f", $total_bill );
1220 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1221 to outstanding invoice balances in chronological order and returns the value
1222 of any remaining unapplied credits available for refund
1223 (see L<FS::cust_refund>).
1230 return 0 unless $self->total_credited;
1232 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1233 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1235 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1236 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1240 foreach my $cust_bill ( @invoices ) {
1243 if ( !defined($credit) || $credit->credited == 0) {
1244 $credit = pop @credits or last;
1247 if ($cust_bill->owed >= $credit->credited) {
1248 $amount=$credit->credited;
1250 $amount=$cust_bill->owed;
1253 my $cust_credit_bill = new FS::cust_credit_bill ( {
1254 'crednum' => $credit->crednum,
1255 'invnum' => $cust_bill->invnum,
1256 'amount' => $amount,
1258 my $error = $cust_credit_bill->insert;
1259 die $error if $error;
1261 redo if ($cust_bill->owed > 0);
1265 return $self->total_credited;
1268 =item apply_payments
1270 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1271 to outstanding invoice balances in chronological order.
1273 #and returns the value of any remaining unapplied payments.
1277 sub apply_payments {
1282 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1283 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1285 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1286 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1290 foreach my $cust_bill ( @invoices ) {
1293 if ( !defined($payment) || $payment->unapplied == 0 ) {
1294 $payment = pop @payments or last;
1297 if ( $cust_bill->owed >= $payment->unapplied ) {
1298 $amount = $payment->unapplied;
1300 $amount = $cust_bill->owed;
1303 my $cust_bill_pay = new FS::cust_bill_pay ( {
1304 'paynum' => $payment->paynum,
1305 'invnum' => $cust_bill->invnum,
1306 'amount' => $amount,
1308 my $error = $cust_bill_pay->insert;
1309 die $error if $error;
1311 redo if ( $cust_bill->owed > 0);
1315 return $self->total_unapplied_payments;
1318 =item total_credited
1320 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1321 customer. See L<FS::cust_credit/credited>.
1325 sub total_credited {
1327 my $total_credit = 0;
1328 foreach my $cust_credit ( qsearch('cust_credit', {
1329 'custnum' => $self->custnum,
1331 $total_credit += $cust_credit->credited;
1333 sprintf( "%.2f", $total_credit );
1336 =item total_unapplied_payments
1338 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1339 See L<FS::cust_pay/unapplied>.
1343 sub total_unapplied_payments {
1345 my $total_unapplied = 0;
1346 foreach my $cust_pay ( qsearch('cust_pay', {
1347 'custnum' => $self->custnum,
1349 $total_unapplied += $cust_pay->unapplied;
1351 sprintf( "%.2f", $total_unapplied );
1356 Returns the balance for this customer (total_owed minus total_credited
1357 minus total_unapplied_payments).
1364 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1368 =item balance_date TIME
1370 Returns the balance for this customer, only considering invoices with date
1371 earlier than TIME (total_owed_date minus total_credited minus
1372 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1373 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1382 $self->total_owed_date($time)
1383 - $self->total_credited
1384 - $self->total_unapplied_payments
1388 =item invoicing_list [ ARRAYREF ]
1390 If an arguement is given, sets these email addresses as invoice recipients
1391 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1392 (except as warnings), so use check_invoicing_list first.
1394 Returns a list of email addresses (with svcnum entries expanded).
1396 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1397 check it without disturbing anything by passing nothing.
1399 This interface may change in the future.
1403 sub invoicing_list {
1404 my( $self, $arrayref ) = @_;
1406 my @cust_main_invoice;
1407 if ( $self->custnum ) {
1408 @cust_main_invoice =
1409 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1411 @cust_main_invoice = ();
1413 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1414 #warn $cust_main_invoice->destnum;
1415 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1416 #warn $cust_main_invoice->destnum;
1417 my $error = $cust_main_invoice->delete;
1418 warn $error if $error;
1421 if ( $self->custnum ) {
1422 @cust_main_invoice =
1423 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1425 @cust_main_invoice = ();
1427 my %seen = map { $_->address => 1 } @cust_main_invoice;
1428 foreach my $address ( @{$arrayref} ) {
1429 #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1430 next if exists $seen{$address} && $seen{$address};
1431 $seen{$address} = 1;
1432 my $cust_main_invoice = new FS::cust_main_invoice ( {
1433 'custnum' => $self->custnum,
1436 my $error = $cust_main_invoice->insert;
1437 warn $error if $error;
1440 if ( $self->custnum ) {
1442 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1448 =item check_invoicing_list ARRAYREF
1450 Checks these arguements as valid input for the invoicing_list method. If there
1451 is an error, returns the error, otherwise returns false.
1455 sub check_invoicing_list {
1456 my( $self, $arrayref ) = @_;
1457 foreach my $address ( @{$arrayref} ) {
1458 my $cust_main_invoice = new FS::cust_main_invoice ( {
1459 'custnum' => $self->custnum,
1462 my $error = $self->custnum
1463 ? $cust_main_invoice->check
1464 : $cust_main_invoice->checkdest
1466 return $error if $error;
1471 =item default_invoicing_list
1473 Sets the invoicing list to all accounts associated with this customer.
1477 sub default_invoicing_list {
1480 foreach my $cust_pkg ( $self->all_pkgs ) {
1481 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1483 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1484 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1486 push @list, map { $_->email } @svc_acct;
1488 $self->invoicing_list(\@list);
1491 =item invoicing_list_addpost
1493 Adds postal invoicing to this customer. If this customer is already configured
1494 to receive postal invoices, does nothing.
1498 sub invoicing_list_addpost {
1500 return if grep { $_ eq 'POST' } $self->invoicing_list;
1501 my @invoicing_list = $self->invoicing_list;
1502 push @invoicing_list, 'POST';
1503 $self->invoicing_list(\@invoicing_list);
1506 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1508 Returns an array of customers referred by this customer (referral_custnum set
1509 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1510 customers referred by customers referred by this customer and so on, inclusive.
1511 The default behavior is DEPTH 1 (no recursion).
1515 sub referral_cust_main {
1517 my $depth = @_ ? shift : 1;
1518 my $exclude = @_ ? shift : {};
1521 map { $exclude->{$_->custnum}++; $_; }
1522 grep { ! $exclude->{ $_->custnum } }
1523 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1527 map { $_->referral_cust_main($depth-1, $exclude) }
1534 =item referral_cust_main_ncancelled
1536 Same as referral_cust_main, except only returns customers with uncancelled
1541 sub referral_cust_main_ncancelled {
1543 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1546 =item referral_cust_pkg [ DEPTH ]
1548 Like referral_cust_main, except returns a flat list of all unsuspended (and
1549 uncancelled) packages for each customer. The number of items in this list may
1550 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1554 sub referral_cust_pkg {
1556 my $depth = @_ ? shift : 1;
1558 map { $_->unsuspended_pkgs }
1559 grep { $_->unsuspended_pkgs }
1560 $self->referral_cust_main($depth);
1563 =item credit AMOUNT, REASON
1565 Applies a credit to this customer. If there is an error, returns the error,
1566 otherwise returns false.
1571 my( $self, $amount, $reason ) = @_;
1572 my $cust_credit = new FS::cust_credit {
1573 'custnum' => $self->custnum,
1574 'amount' => $amount,
1575 'reason' => $reason,
1577 $cust_credit->insert;
1580 =item charge AMOUNT PKG COMMENT
1582 Creates a one-time charge for this customer. If there is an error, returns
1583 the error, otherwise returns false.
1588 my ( $self, $amount, $pkg, $comment ) = @_;
1590 my $part_pkg = new FS::part_pkg ( {
1591 'pkg' => $pkg || 'One-time charge',
1592 'comment' => $comment || '$'. sprintf("%.2f".$amount),
1609 =item check_and_rebuild_fuzzyfiles
1613 sub check_and_rebuild_fuzzyfiles {
1614 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1615 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1616 or &rebuild_fuzzyfiles;
1619 =item rebuild_fuzzyfiles
1623 sub rebuild_fuzzyfiles {
1625 use Fcntl qw(:flock);
1627 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1631 open(LASTLOCK,">>$dir/cust_main.last")
1632 or die "can't open $dir/cust_main.last: $!";
1633 flock(LASTLOCK,LOCK_EX)
1634 or die "can't lock $dir/cust_main.last: $!";
1636 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1638 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1639 if defined dbdef->table('cust_main')->column('ship_last');
1641 open (LASTCACHE,">$dir/cust_main.last.tmp")
1642 or die "can't open $dir/cust_main.last.tmp: $!";
1643 print LASTCACHE join("\n", @all_last), "\n";
1644 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1646 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1651 open(COMPANYLOCK,">>$dir/cust_main.company")
1652 or die "can't open $dir/cust_main.company: $!";
1653 flock(COMPANYLOCK,LOCK_EX)
1654 or die "can't lock $dir/cust_main.company: $!";
1656 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1658 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1659 if defined dbdef->table('cust_main')->column('ship_last');
1661 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1662 or die "can't open $dir/cust_main.company.tmp: $!";
1663 print COMPANYCACHE join("\n", @all_company), "\n";
1664 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1666 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1676 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1677 open(LASTCACHE,"<$dir/cust_main.last")
1678 or die "can't open $dir/cust_main.last: $!";
1679 my @array = map { chomp; $_; } <LASTCACHE>;
1689 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1690 open(COMPANYCACHE,"<$dir/cust_main.company")
1691 or die "can't open $dir/cust_main.last: $!";
1692 my @array = map { chomp; $_; } <COMPANYCACHE>;
1697 =item append_fuzzyfiles LASTNAME COMPANY
1701 sub append_fuzzyfiles {
1702 my( $last, $company ) = @_;
1704 &check_and_rebuild_fuzzyfiles;
1706 use Fcntl qw(:flock);
1708 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1712 open(LAST,">>$dir/cust_main.last")
1713 or die "can't open $dir/cust_main.last: $!";
1715 or die "can't lock $dir/cust_main.last: $!";
1717 print LAST "$last\n";
1720 or die "can't unlock $dir/cust_main.last: $!";
1726 open(COMPANY,">>$dir/cust_main.company")
1727 or die "can't open $dir/cust_main.company: $!";
1728 flock(COMPANY,LOCK_EX)
1729 or die "can't lock $dir/cust_main.company: $!";
1731 print COMPANY "$company\n";
1733 flock(COMPANY,LOCK_UN)
1734 or die "can't unlock $dir/cust_main.company: $!";
1748 The delete method should possibly take an FS::cust_main object reference
1749 instead of a scalar customer number.
1751 Bill and collect options should probably be passed as references instead of a
1754 There should probably be a configuration file with a list of allowed credit
1757 No multiple currency support (probably a larger project than just this module).
1761 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1762 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1763 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.