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;
29 use FS::cust_tax_exempt;
31 use FS::Msgcat qw(gettext);
33 @ISA = qw( FS::Record );
40 #ask FS::UID to run this stuff for us later
41 $FS::UID::callback{'FS::cust_main'} = sub {
43 #yes, need it for stuff below (prolly should be cached)
48 my ( $hashref, $cache ) = @_;
49 if ( exists $hashref->{'pkgnum'} ) {
50 # #@{ $self->{'_pkgnum'} } = ();
51 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
52 $self->{'_pkgnum'} = $subcache;
53 #push @{ $self->{'_pkgnum'} },
54 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
60 FS::cust_main - Object methods for cust_main records
66 $record = new FS::cust_main \%hash;
67 $record = new FS::cust_main { 'column' => 'value' };
69 $error = $record->insert;
71 $error = $new_record->replace($old_record);
73 $error = $record->delete;
75 $error = $record->check;
77 @cust_pkg = $record->all_pkgs;
79 @cust_pkg = $record->ncancelled_pkgs;
81 @cust_pkg = $record->suspended_pkgs;
83 $error = $record->bill;
84 $error = $record->bill %options;
85 $error = $record->bill 'time' => $time;
87 $error = $record->collect;
88 $error = $record->collect %options;
89 $error = $record->collect 'invoice_time' => $time,
90 'batch_card' => 'yes',
91 'report_badcard' => 'yes',
96 An FS::cust_main object represents a customer. FS::cust_main inherits from
97 FS::Record. The following fields are currently supported:
101 =item custnum - primary key (assigned automatically for new customers)
103 =item agentnum - agent (see L<FS::agent>)
105 =item refnum - Advertising source (see L<FS::part_referral>)
111 =item ss - social security number (optional)
113 =item company - (optional)
117 =item address2 - (optional)
121 =item county - (optional, see L<FS::cust_main_county>)
123 =item state - (see L<FS::cust_main_county>)
127 =item country - (see L<FS::cust_main_county>)
129 =item daytime - phone (optional)
131 =item night - phone (optional)
133 =item fax - phone (optional)
135 =item ship_first - name
137 =item ship_last - name
139 =item ship_company - (optional)
143 =item ship_address2 - (optional)
147 =item ship_county - (optional, see L<FS::cust_main_county>)
149 =item ship_state - (see L<FS::cust_main_county>)
153 =item ship_country - (see L<FS::cust_main_county>)
155 =item ship_daytime - phone (optional)
157 =item ship_night - phone (optional)
159 =item ship_fax - phone (optional)
161 =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)
163 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
165 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
167 =item payname - name on card or billing name
169 =item tax - tax exempt, empty or `Y'
171 =item otaker - order taker (assigned automatically, see L<FS::UID>)
173 =item comments - comments (optional)
183 Creates a new customer. To add the customer to the database, see L<"insert">.
185 Note that this stores the hash reference, not a distinct copy of the hash it
186 points to. You can ask the object for a copy with the I<hash> method.
190 sub table { 'cust_main'; }
192 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
194 Adds this customer to the database. If there is an error, returns the error,
195 otherwise returns false.
197 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
198 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
199 are inserted atomicly, or the transaction is rolled back. Passing an empty
200 hash reference is equivalent to not supplying this parameter. There should be
201 a better explanation of this, but until then, here's an example:
204 tie %hash, 'Tie::RefHash'; #this part is important
206 $cust_pkg => [ $svc_acct ],
209 $cust_main->insert( \%hash );
211 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
212 be set as the invoicing list (see L<"invoicing_list">). Errors return as
213 expected and rollback the entire transaction; it is not necessary to call
214 check_invoicing_list first. The invoicing_list is set after the records in the
215 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
216 invoicing_list destination to the newly-created svc_acct. Here's an example:
218 $cust_main->insert( {}, [ $email, 'POST' ] );
224 my $cust_pkgs = @_ ? shift : {};
225 my $invoicing_list = @_ ? shift : '';
227 local $SIG{HUP} = 'IGNORE';
228 local $SIG{INT} = 'IGNORE';
229 local $SIG{QUIT} = 'IGNORE';
230 local $SIG{TERM} = 'IGNORE';
231 local $SIG{TSTP} = 'IGNORE';
232 local $SIG{PIPE} = 'IGNORE';
234 my $oldAutoCommit = $FS::UID::AutoCommit;
235 local $FS::UID::AutoCommit = 0;
240 if ( $self->payby eq 'PREPAY' ) {
241 $self->payby('BILL');
242 my $prepay_credit = qsearchs(
244 { 'identifier' => $self->payinfo },
248 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
249 unless $prepay_credit;
250 $amount = $prepay_credit->amount;
251 $seconds = $prepay_credit->seconds;
252 my $error = $prepay_credit->delete;
254 $dbh->rollback if $oldAutoCommit;
255 return "removing prepay_credit (transaction rolled back): $error";
259 my $error = $self->SUPER::insert;
261 $dbh->rollback if $oldAutoCommit;
262 #return "inserting cust_main record (transaction rolled back): $error";
267 if ( $invoicing_list ) {
268 $error = $self->check_invoicing_list( $invoicing_list );
270 $dbh->rollback if $oldAutoCommit;
271 return "checking invoicing_list (transaction rolled back): $error";
273 $self->invoicing_list( $invoicing_list );
277 foreach my $cust_pkg ( keys %$cust_pkgs ) {
278 $cust_pkg->custnum( $self->custnum );
279 $error = $cust_pkg->insert;
281 $dbh->rollback if $oldAutoCommit;
282 return "inserting cust_pkg (transaction rolled back): $error";
284 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
285 $svc_something->pkgnum( $cust_pkg->pkgnum );
286 if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
287 $svc_something->seconds( $svc_something->seconds + $seconds );
290 $error = $svc_something->insert;
292 $dbh->rollback if $oldAutoCommit;
293 #return "inserting svc_ (transaction rolled back): $error";
300 $dbh->rollback if $oldAutoCommit;
301 return "No svc_acct record to apply pre-paid time";
305 my $cust_credit = new FS::cust_credit {
306 'custnum' => $self->custnum,
309 $error = $cust_credit->insert;
311 $dbh->rollback if $oldAutoCommit;
312 return "inserting credit (transaction rolled back): $error";
316 #false laziness with sub replace
317 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
318 $error = $queue->insert($self->getfield('last'), $self->company);
320 $dbh->rollback if $oldAutoCommit;
321 return "queueing job (transaction rolled back): $error";
324 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
325 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
326 $error = $queue->insert($self->getfield('last'), $self->company);
328 $dbh->rollback if $oldAutoCommit;
329 return "queueing job (transaction rolled back): $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<FS::cust_pkg/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 my $oldAutoCommit = $FS::UID::AutoCommit;
465 local $FS::UID::AutoCommit = 0;
468 my $error = $self->SUPER::replace($old);
471 $dbh->rollback if $oldAutoCommit;
475 if ( @param ) { # INVOICING_LIST_ARYREF
476 my $invoicing_list = shift @param;
477 $error = $self->check_invoicing_list( $invoicing_list );
479 $dbh->rollback if $oldAutoCommit;
482 $self->invoicing_list( $invoicing_list );
485 if ( $self->payby eq 'CARD' &&
486 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
487 # card info has changed, want to retry realtime_card invoice events
488 #false laziness w/collect
489 foreach my $cust_bill_event (
491 #$_->part_bill_event->plan eq 'realtime-card'
492 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
493 && $_->status eq 'done'
496 map { $_->cust_bill_event }
497 grep { $_->cust_bill_event }
498 $self->open_cust_bill
501 my $error = $cust_bill_event->retry;
503 $dbh->rollback if $oldAutoCommit;
504 return "error scheduling invoice events for retry: $error";
511 #false laziness with sub insert
512 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
513 $error = $queue->insert($self->getfield('last'), $self->company);
515 $dbh->rollback if $oldAutoCommit;
516 return "queueing job (transaction rolled back): $error";
519 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
520 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
521 $error = $queue->insert($self->getfield('last'), $self->company);
523 $dbh->rollback if $oldAutoCommit;
524 return "queueing job (transaction rolled back): $error";
529 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
536 Checks all fields to make sure this is a valid customer record. If there is
537 an error, returns the error, otherwise returns false. Called by the insert
545 #warn "BEFORE: \n". $self->_dump;
548 $self->ut_numbern('custnum')
549 || $self->ut_number('agentnum')
550 || $self->ut_number('refnum')
551 || $self->ut_name('last')
552 || $self->ut_name('first')
553 || $self->ut_textn('company')
554 || $self->ut_text('address1')
555 || $self->ut_textn('address2')
556 || $self->ut_text('city')
557 || $self->ut_textn('county')
558 || $self->ut_textn('state')
559 || $self->ut_country('country')
560 || $self->ut_anything('comments')
561 || $self->ut_numbern('referral_custnum')
563 #barf. need message catalogs. i18n. etc.
564 $error .= "Please select a advertising source."
565 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
566 return $error if $error;
568 return "Unknown agent"
569 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
571 return "Unknown refnum"
572 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
574 return "Unknown referring custnum ". $self->referral_custnum
575 unless ! $self->referral_custnum
576 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
578 if ( $self->ss eq '' ) {
583 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
584 or return "Illegal social security number: ". $self->ss;
585 $self->ss("$1-$2-$3");
589 # bad idea to disable, causes billing to fail because of no tax rates later
590 # unless ( $import ) {
591 unless ( qsearchs('cust_main_county', {
592 'country' => $self->country,
595 return "Unknown state/county/country: ".
596 $self->state. "/". $self->county. "/". $self->country
597 unless qsearchs('cust_main_county',{
598 'state' => $self->state,
599 'county' => $self->county,
600 'country' => $self->country,
606 $self->ut_phonen('daytime', $self->country)
607 || $self->ut_phonen('night', $self->country)
608 || $self->ut_phonen('fax', $self->country)
609 || $self->ut_zip('zip', $self->country)
611 return $error if $error;
614 last first company address1 address2 city county state zip
615 country daytime night fax
618 if ( defined $self->dbdef_table->column('ship_last') ) {
619 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
621 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
625 $self->ut_name('ship_last')
626 || $self->ut_name('ship_first')
627 || $self->ut_textn('ship_company')
628 || $self->ut_text('ship_address1')
629 || $self->ut_textn('ship_address2')
630 || $self->ut_text('ship_city')
631 || $self->ut_textn('ship_county')
632 || $self->ut_textn('ship_state')
633 || $self->ut_country('ship_country')
635 return $error if $error;
637 #false laziness with above
638 unless ( qsearchs('cust_main_county', {
639 'country' => $self->ship_country,
642 return "Unknown ship_state/ship_county/ship_country: ".
643 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
644 unless qsearchs('cust_main_county',{
645 'state' => $self->ship_state,
646 'county' => $self->ship_county,
647 'country' => $self->ship_country,
653 $self->ut_phonen('ship_daytime', $self->ship_country)
654 || $self->ut_phonen('ship_night', $self->ship_country)
655 || $self->ut_phonen('ship_fax', $self->ship_country)
656 || $self->ut_zip('ship_zip', $self->ship_country)
658 return $error if $error;
660 } else { # ship_ info eq billing info, so don't store dup info in database
661 $self->setfield("ship_$_", '')
662 foreach qw( last first company address1 address2 city county state zip
663 country daytime night fax );
667 $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
668 or return "Illegal payby: ". $self->payby;
671 if ( $self->payby eq 'CARD' ) {
673 my $payinfo = $self->payinfo;
675 $payinfo =~ /^(\d{13,16})$/
676 or return gettext('invalid_card'); # . ": ". $self->payinfo;
678 $self->payinfo($payinfo);
680 or return gettext('invalid_card'); # . ": ". $self->payinfo;
681 return gettext('unknown_card_type')
682 if cardtype($self->payinfo) eq "Unknown";
684 } elsif ( $self->payby eq 'BILL' ) {
686 $error = $self->ut_textn('payinfo');
687 return "Illegal P.O. number: ". $self->payinfo if $error;
689 } elsif ( $self->payby eq 'COMP' ) {
691 $error = $self->ut_textn('payinfo');
692 return "Illegal comp account issuer: ". $self->payinfo if $error;
694 } elsif ( $self->payby eq 'PREPAY' ) {
696 my $payinfo = $self->payinfo;
697 $payinfo =~ s/\W//g; #anything else would just confuse things
698 $self->payinfo($payinfo);
699 $error = $self->ut_alpha('payinfo');
700 return "Illegal prepayment identifier: ". $self->payinfo if $error;
701 return "Unknown prepayment identifier"
702 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
706 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
707 return "Expriation date required"
708 unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
711 $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
712 or return "Illegal expiration date: ". $self->paydate;
713 my $y = length($2) == 4 ? $2 : "20$2";
714 $self->paydate("$y-$1-01");
715 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
716 return gettext('expired_card')
717 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
720 if ( $self->payname eq '' &&
721 ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
722 $self->payname( $self->first. " ". $self->getfield('last') );
724 $self->payname =~ /^([\w \,\.\-\']+)$/
725 or return gettext('illegal_name'). " payname: ". $self->payname;
729 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
732 $self->otaker(getotaker);
734 #warn "AFTER: \n". $self->_dump;
741 Returns all packages (see L<FS::cust_pkg>) for this customer.
747 if ( $self->{'_pkgnum'} ) {
748 values %{ $self->{'_pkgnum'}->cache };
750 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
754 =item ncancelled_pkgs
756 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
760 sub ncancelled_pkgs {
762 if ( $self->{'_pkgnum'} ) {
763 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
765 @{ [ # force list context
766 qsearch( 'cust_pkg', {
767 'custnum' => $self->custnum,
770 qsearch( 'cust_pkg', {
771 'custnum' => $self->custnum,
780 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
786 grep { $_->susp } $self->ncancelled_pkgs;
789 =item unflagged_suspended_pkgs
791 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
792 customer (thouse packages without the `manual_flag' set).
796 sub unflagged_suspended_pkgs {
798 return $self->suspended_pkgs
799 unless dbdef->table('cust_pkg')->column('manual_flag');
800 grep { ! $_->manual_flag } $self->suspended_pkgs;
803 =item unsuspended_pkgs
805 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
810 sub unsuspended_pkgs {
812 grep { ! $_->susp } $self->ncancelled_pkgs;
817 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
818 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
819 on success or a list of errors.
825 grep { $_->unsuspend } $self->suspended_pkgs;
830 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
831 Always returns a list: an empty list on success or a list of errors.
837 grep { $_->suspend } $self->unsuspended_pkgs;
842 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
843 Always returns a list: an empty list on success or a list of errors.
849 grep { $_->cancel } $self->ncancelled_pkgs;
854 Returns the agent (see L<FS::agent>) for this customer.
860 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
865 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
866 conjunction with the collect method.
868 Options are passed as name-value pairs.
870 The only currently available option is `time', which bills the customer as if
871 it were that time. It is specified as a UNIX timestamp; see
872 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
873 functions. For example:
877 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
879 If there is an error, returns the error, otherwise returns false.
884 my( $self, %options ) = @_;
885 my $time = $options{'time'} || time;
890 local $SIG{HUP} = 'IGNORE';
891 local $SIG{INT} = 'IGNORE';
892 local $SIG{QUIT} = 'IGNORE';
893 local $SIG{TERM} = 'IGNORE';
894 local $SIG{TSTP} = 'IGNORE';
895 local $SIG{PIPE} = 'IGNORE';
897 my $oldAutoCommit = $FS::UID::AutoCommit;
898 local $FS::UID::AutoCommit = 0;
901 # find the packages which are due for billing, find out how much they are
902 # & generate invoice database.
904 my( $total_setup, $total_recur ) = ( 0, 0 );
905 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
906 my @cust_bill_pkg = ();
908 #my $taxable_charged = 0;##
913 foreach my $cust_pkg (
914 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
917 #NO!! next if $cust_pkg->cancel;
918 next if $cust_pkg->getfield('cancel');
920 #? to avoid use of uninitialized value errors... ?
921 $cust_pkg->setfield('bill', '')
922 unless defined($cust_pkg->bill);
924 my $part_pkg = $cust_pkg->part_pkg;
926 #so we don't modify cust_pkg record unnecessarily
927 my $cust_pkg_mod_flag = 0;
928 my %hash = $cust_pkg->hash;
929 my $old_cust_pkg = new FS::cust_pkg \%hash;
933 unless ( $cust_pkg->setup ) {
934 my $setup_prog = $part_pkg->getfield('setup');
935 $setup_prog =~ /^(.*)$/ or do {
936 $dbh->rollback if $oldAutoCommit;
937 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
943 ##$cpt->permit(); #what is necessary?
944 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
945 #$setup = $cpt->reval($setup_prog);
946 $setup = eval $setup_prog;
947 unless ( defined($setup) ) {
948 $dbh->rollback if $oldAutoCommit;
949 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
950 "(expression $setup_prog): $@";
952 $cust_pkg->setfield('setup',$time);
953 $cust_pkg_mod_flag=1;
959 if ( $part_pkg->getfield('freq') > 0 &&
960 ! $cust_pkg->getfield('susp') &&
961 ( $cust_pkg->getfield('bill') || 0 ) < $time
963 my $recur_prog = $part_pkg->getfield('recur');
964 $recur_prog =~ /^(.*)$/ or do {
965 $dbh->rollback if $oldAutoCommit;
966 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
971 # shared with $recur_prog
972 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
975 ##$cpt->permit(); #what is necessary?
976 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
977 #$recur = $cpt->reval($recur_prog);
978 $recur = eval $recur_prog;
979 unless ( defined($recur) ) {
980 $dbh->rollback if $oldAutoCommit;
981 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
982 "(expression $recur_prog): $@";
984 #change this bit to use Date::Manip? CAREFUL with timezones (see
985 # mailing list archive)
986 my ($sec,$min,$hour,$mday,$mon,$year) =
987 (localtime($sdate) )[0,1,2,3,4,5];
989 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
990 # only for figuring next bill date, nothing else, so, reset $sdate again
992 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
994 $mon += $part_pkg->freq;
995 until ( $mon < 12 ) { $mon -= 12; $year++; }
996 $cust_pkg->setfield('bill',
997 timelocal($sec,$min,$hour,$mday,$mon,$year));
998 $cust_pkg_mod_flag = 1;
1001 warn "\$setup is undefined" unless defined($setup);
1002 warn "\$recur is undefined" unless defined($recur);
1003 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1005 my $taxable_charged = 0;
1006 if ( $cust_pkg_mod_flag ) {
1007 $error=$cust_pkg->replace($old_cust_pkg);
1008 if ( $error ) { #just in case
1009 $dbh->rollback if $oldAutoCommit;
1010 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1012 $setup = sprintf( "%.2f", $setup );
1013 $recur = sprintf( "%.2f", $recur );
1015 $dbh->rollback if $oldAutoCommit;
1016 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1019 $dbh->rollback if $oldAutoCommit;
1020 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1022 if ( $setup > 0 || $recur > 0 ) {
1023 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1024 'pkgnum' => $cust_pkg->pkgnum,
1028 'edate' => $cust_pkg->bill,
1030 push @cust_bill_pkg, $cust_bill_pkg;
1031 $total_setup += $setup;
1032 $total_recur += $recur;
1033 $taxable_charged += $setup
1034 unless $part_pkg->setuptax =~ /^Y$/i;
1035 $taxable_charged += $recur
1036 unless $part_pkg->recurtax =~ /^Y$/i;
1038 unless ( $self->tax =~ /Y/i
1039 || $self->payby eq 'COMP'
1040 || $taxable_charged == 0 ) {
1042 my $cust_main_county =
1043 qsearchs('cust_main_county',{
1044 'state' => $self->state,
1045 'county' => $self->county,
1046 'country' => $self->country,
1047 'taxclass' => $part_pkg->taxclass,
1049 or qsearchs('cust_main_county',{
1050 'state' => $self->state,
1051 'county' => $self->county,
1052 'country' => $self->country,
1056 $dbh->rollback if $oldAutoCommit;
1058 "fatal: can't find tax rate for state/county/country/taxclass ".
1059 join('/', ( map $self->$_(), qw(state county country) ),
1060 $part_pkg->taxclass ). "\n";
1063 if ( $cust_main_county->exempt_amount ) {
1064 my ($mon,$year) = (localtime($sdate) )[4,5];
1066 my $freq = $part_pkg->freq || 1;
1067 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1068 foreach my $which_month ( 1 .. $freq ) {
1070 'custnum' => $self->custnum,
1071 'taxnum' => $cust_main_county->taxnum,
1072 'year' => 1900+$year,
1075 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1076 until ( $mon < 13 ) { $mon -= 12; $year++; }
1077 my $cust_tax_exempt =
1078 qsearchs('cust_tax_exempt', \%hash)
1079 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1080 my $remaining_exemption = sprintf("%.2f",
1081 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1082 if ( $remaining_exemption > 0 ) {
1083 my $addl = $remaining_exemption > $taxable_per_month
1084 ? $taxable_per_month
1085 : $remaining_exemption;
1086 $taxable_charged -= $addl;
1087 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1088 $cust_tax_exempt->hash,
1089 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1091 $error = $new_cust_tax_exempt->exemptnum
1092 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1093 : $new_cust_tax_exempt->insert;
1095 $dbh->rollback if $oldAutoCommit;
1096 return "fatal: can't update cust_tax_exempt: $error";
1099 } # if $remaining_exemption > 0
1101 } #foreach $which_month
1103 } #if $cust_main_county->exempt_amount
1105 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1107 #$tax += $taxable_charged * $cust_main_county->tax / 100
1108 $tax{ $cust_main_county->taxname || 'Tax' } +=
1109 $taxable_charged * $cust_main_county->tax / 100
1111 } #unless $self->tax =~ /Y/i
1112 # || $self->payby eq 'COMP'
1113 # || $taxable_charged == 0
1115 } #if $setup > 0 || $recur > 0
1117 } #if $cust_pkg_mod_flag
1119 } #foreach my $cust_pkg
1121 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1122 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1124 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1125 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1129 # unless ( $self->tax =~ /Y/i
1130 # || $self->payby eq 'COMP'
1131 # || $taxable_charged == 0 ) {
1132 # my $cust_main_county = qsearchs('cust_main_county',{
1133 # 'state' => $self->state,
1134 # 'county' => $self->county,
1135 # 'country' => $self->country,
1136 # } ) or die "fatal: can't find tax rate for state/county/country ".
1137 # $self->state. "/". $self->county. "/". $self->country. "\n";
1138 # my $tax = sprintf( "%.2f",
1139 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1142 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1143 my $tax = sprintf("%.2f", $tax{$taxname} );
1144 $charged = sprintf( "%.2f", $charged+$tax );
1146 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1152 'itemdesc' => $taxname,
1154 push @cust_bill_pkg, $cust_bill_pkg;
1158 my $cust_bill = new FS::cust_bill ( {
1159 'custnum' => $self->custnum,
1161 'charged' => $charged,
1163 $error = $cust_bill->insert;
1165 $dbh->rollback if $oldAutoCommit;
1166 return "can't create invoice for customer #". $self->custnum. ": $error";
1169 my $invnum = $cust_bill->invnum;
1171 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1173 $cust_bill_pkg->invnum($invnum);
1174 $error = $cust_bill_pkg->insert;
1176 $dbh->rollback if $oldAutoCommit;
1177 return "can't create invoice line item for customer #". $self->custnum.
1182 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1186 =item collect OPTIONS
1188 (Attempt to) collect money for this customer's outstanding invoices (see
1189 L<FS::cust_bill>). Usually used after the bill method.
1191 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1192 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1194 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1195 and the invoice events web interface.
1197 If there is an error, returns the error, otherwise returns false.
1199 Options are passed as name-value pairs.
1201 Currently available options are:
1203 invoice_time - Use this time when deciding when to print invoices and
1204 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>
1205 for conversion functions.
1207 retry_card - Retry cards even when not scheduled by invoice events.
1209 batch_card - This option is deprecated. See the invoice events web interface
1210 to control whether cards are batched or run against a realtime gateway.
1212 report_badcard - This option is deprecated.
1214 force_print - This option is deprecated; see the invoice events web interface.
1219 my( $self, %options ) = @_;
1220 my $invoice_time = $options{'invoice_time'} || time;
1223 local $SIG{HUP} = 'IGNORE';
1224 local $SIG{INT} = 'IGNORE';
1225 local $SIG{QUIT} = 'IGNORE';
1226 local $SIG{TERM} = 'IGNORE';
1227 local $SIG{TSTP} = 'IGNORE';
1228 local $SIG{PIPE} = 'IGNORE';
1230 my $oldAutoCommit = $FS::UID::AutoCommit;
1231 local $FS::UID::AutoCommit = 0;
1234 my $balance = $self->balance;
1235 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1236 unless ( $balance > 0 ) { #redundant?????
1237 $dbh->rollback if $oldAutoCommit; #hmm
1241 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1242 #false laziness w/replace
1243 foreach my $cust_bill_event (
1245 #$_->part_bill_event->plan eq 'realtime-card'
1246 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1247 && $_->status eq 'done'
1250 map { $_->cust_bill_event }
1251 grep { $_->cust_bill_event }
1252 $self->open_cust_bill
1254 my $error = $cust_bill_event->retry;
1256 $dbh->rollback if $oldAutoCommit;
1257 return "error scheduling invoice events for retry: $error";
1263 foreach my $cust_bill ( $self->cust_bill ) {
1265 #this has to be before next's
1266 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1270 $balance = sprintf( "%.2f", $balance - $amount );
1272 next unless $cust_bill->owed > 0;
1274 # don't try to charge for the same invoice if it's already in a batch
1275 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1277 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1279 next unless $amount > 0;
1282 foreach my $part_bill_event (
1283 sort { $a->seconds <=> $b->seconds
1284 || $a->weight <=> $b->weight
1285 || $a->eventpart <=> $b->eventpart }
1286 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1287 && ! qsearchs( 'cust_bill_event', {
1288 'invnum' => $cust_bill->invnum,
1289 'eventpart' => $_->eventpart,
1293 qsearch('part_bill_event', { 'payby' => $self->payby,
1294 'disabled' => '', } )
1297 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1299 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1301 my $cust_main = $self; #for callback
1302 my $error = eval $part_bill_event->eventcode;
1305 my $statustext = '';
1309 } elsif ( $error ) {
1311 $statustext = $error;
1316 #add cust_bill_event
1317 my $cust_bill_event = new FS::cust_bill_event {
1318 'invnum' => $cust_bill->invnum,
1319 'eventpart' => $part_bill_event->eventpart,
1320 '_date' => $invoice_time,
1321 'status' => $status,
1322 'statustext' => $statustext,
1324 $error = $cust_bill_event->insert;
1326 #$dbh->rollback if $oldAutoCommit;
1327 #return "error: $error";
1329 # gah, even with transactions.
1330 $dbh->commit if $oldAutoCommit; #well.
1331 my $e = 'WARNING: Event run but database not updated - '.
1332 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1333 ', eventpart '. $part_bill_event->eventpart.
1344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1351 Returns the total owed for this customer on all invoices
1352 (see L<FS::cust_bill/owed>).
1358 $self->total_owed_date(2145859200); #12/31/2037
1361 =item total_owed_date TIME
1363 Returns the total owed for this customer on all invoices with date earlier than
1364 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1365 see L<Time::Local> and L<Date::Parse> for conversion functions.
1369 sub total_owed_date {
1373 foreach my $cust_bill (
1374 grep { $_->_date <= $time }
1375 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1377 $total_bill += $cust_bill->owed;
1379 sprintf( "%.2f", $total_bill );
1384 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1385 to outstanding invoice balances in chronological order and returns the value
1386 of any remaining unapplied credits available for refund
1387 (see L<FS::cust_refund>).
1394 return 0 unless $self->total_credited;
1396 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1397 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1399 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1400 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1404 foreach my $cust_bill ( @invoices ) {
1407 if ( !defined($credit) || $credit->credited == 0) {
1408 $credit = pop @credits or last;
1411 if ($cust_bill->owed >= $credit->credited) {
1412 $amount=$credit->credited;
1414 $amount=$cust_bill->owed;
1417 my $cust_credit_bill = new FS::cust_credit_bill ( {
1418 'crednum' => $credit->crednum,
1419 'invnum' => $cust_bill->invnum,
1420 'amount' => $amount,
1422 my $error = $cust_credit_bill->insert;
1423 die $error if $error;
1425 redo if ($cust_bill->owed > 0);
1429 return $self->total_credited;
1432 =item apply_payments
1434 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1435 to outstanding invoice balances in chronological order.
1437 #and returns the value of any remaining unapplied payments.
1441 sub apply_payments {
1446 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1447 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1449 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1450 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1454 foreach my $cust_bill ( @invoices ) {
1457 if ( !defined($payment) || $payment->unapplied == 0 ) {
1458 $payment = pop @payments or last;
1461 if ( $cust_bill->owed >= $payment->unapplied ) {
1462 $amount = $payment->unapplied;
1464 $amount = $cust_bill->owed;
1467 my $cust_bill_pay = new FS::cust_bill_pay ( {
1468 'paynum' => $payment->paynum,
1469 'invnum' => $cust_bill->invnum,
1470 'amount' => $amount,
1472 my $error = $cust_bill_pay->insert;
1473 die $error if $error;
1475 redo if ( $cust_bill->owed > 0);
1479 return $self->total_unapplied_payments;
1482 =item total_credited
1484 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1485 customer. See L<FS::cust_credit/credited>.
1489 sub total_credited {
1491 my $total_credit = 0;
1492 foreach my $cust_credit ( qsearch('cust_credit', {
1493 'custnum' => $self->custnum,
1495 $total_credit += $cust_credit->credited;
1497 sprintf( "%.2f", $total_credit );
1500 =item total_unapplied_payments
1502 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1503 See L<FS::cust_pay/unapplied>.
1507 sub total_unapplied_payments {
1509 my $total_unapplied = 0;
1510 foreach my $cust_pay ( qsearch('cust_pay', {
1511 'custnum' => $self->custnum,
1513 $total_unapplied += $cust_pay->unapplied;
1515 sprintf( "%.2f", $total_unapplied );
1520 Returns the balance for this customer (total_owed minus total_credited
1521 minus total_unapplied_payments).
1528 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1532 =item balance_date TIME
1534 Returns the balance for this customer, only considering invoices with date
1535 earlier than TIME (total_owed_date minus total_credited minus
1536 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1537 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1546 $self->total_owed_date($time)
1547 - $self->total_credited
1548 - $self->total_unapplied_payments
1552 =item invoicing_list [ ARRAYREF ]
1554 If an arguement is given, sets these email addresses as invoice recipients
1555 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1556 (except as warnings), so use check_invoicing_list first.
1558 Returns a list of email addresses (with svcnum entries expanded).
1560 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1561 check it without disturbing anything by passing nothing.
1563 This interface may change in the future.
1567 sub invoicing_list {
1568 my( $self, $arrayref ) = @_;
1570 my @cust_main_invoice;
1571 if ( $self->custnum ) {
1572 @cust_main_invoice =
1573 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1575 @cust_main_invoice = ();
1577 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1578 #warn $cust_main_invoice->destnum;
1579 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1580 #warn $cust_main_invoice->destnum;
1581 my $error = $cust_main_invoice->delete;
1582 warn $error if $error;
1585 if ( $self->custnum ) {
1586 @cust_main_invoice =
1587 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1589 @cust_main_invoice = ();
1591 my %seen = map { $_->address => 1 } @cust_main_invoice;
1592 foreach my $address ( @{$arrayref} ) {
1593 next if exists $seen{$address} && $seen{$address};
1594 $seen{$address} = 1;
1595 my $cust_main_invoice = new FS::cust_main_invoice ( {
1596 'custnum' => $self->custnum,
1599 my $error = $cust_main_invoice->insert;
1600 warn $error if $error;
1603 if ( $self->custnum ) {
1605 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1611 =item check_invoicing_list ARRAYREF
1613 Checks these arguements as valid input for the invoicing_list method. If there
1614 is an error, returns the error, otherwise returns false.
1618 sub check_invoicing_list {
1619 my( $self, $arrayref ) = @_;
1620 foreach my $address ( @{$arrayref} ) {
1621 my $cust_main_invoice = new FS::cust_main_invoice ( {
1622 'custnum' => $self->custnum,
1625 my $error = $self->custnum
1626 ? $cust_main_invoice->check
1627 : $cust_main_invoice->checkdest
1629 return $error if $error;
1634 =item set_default_invoicing_list
1636 Sets the invoicing list to all accounts associated with this customer,
1637 overwriting any previous invoicing list.
1641 sub set_default_invoicing_list {
1643 $self->invoicing_list($self->all_emails);
1648 Returns the email addresses of all accounts provisioned for this customer.
1655 foreach my $cust_pkg ( $self->all_pkgs ) {
1656 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1658 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1659 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1661 $list{$_}=1 foreach map { $_->email } @svc_acct;
1666 =item invoicing_list_addpost
1668 Adds postal invoicing to this customer. If this customer is already configured
1669 to receive postal invoices, does nothing.
1673 sub invoicing_list_addpost {
1675 return if grep { $_ eq 'POST' } $self->invoicing_list;
1676 my @invoicing_list = $self->invoicing_list;
1677 push @invoicing_list, 'POST';
1678 $self->invoicing_list(\@invoicing_list);
1681 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1683 Returns an array of customers referred by this customer (referral_custnum set
1684 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1685 customers referred by customers referred by this customer and so on, inclusive.
1686 The default behavior is DEPTH 1 (no recursion).
1690 sub referral_cust_main {
1692 my $depth = @_ ? shift : 1;
1693 my $exclude = @_ ? shift : {};
1696 map { $exclude->{$_->custnum}++; $_; }
1697 grep { ! $exclude->{ $_->custnum } }
1698 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1702 map { $_->referral_cust_main($depth-1, $exclude) }
1709 =item referral_cust_main_ncancelled
1711 Same as referral_cust_main, except only returns customers with uncancelled
1716 sub referral_cust_main_ncancelled {
1718 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1721 =item referral_cust_pkg [ DEPTH ]
1723 Like referral_cust_main, except returns a flat list of all unsuspended (and
1724 uncancelled) packages for each customer. The number of items in this list may
1725 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1729 sub referral_cust_pkg {
1731 my $depth = @_ ? shift : 1;
1733 map { $_->unsuspended_pkgs }
1734 grep { $_->unsuspended_pkgs }
1735 $self->referral_cust_main($depth);
1738 =item credit AMOUNT, REASON
1740 Applies a credit to this customer. If there is an error, returns the error,
1741 otherwise returns false.
1746 my( $self, $amount, $reason ) = @_;
1747 my $cust_credit = new FS::cust_credit {
1748 'custnum' => $self->custnum,
1749 'amount' => $amount,
1750 'reason' => $reason,
1752 $cust_credit->insert;
1755 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1757 Creates a one-time charge for this customer. If there is an error, returns
1758 the error, otherwise returns false.
1763 my ( $self, $amount ) = ( shift, shift );
1764 my $pkg = @_ ? shift : 'One-time charge';
1765 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1766 my $taxclass = @_ ? shift : '';
1768 local $SIG{HUP} = 'IGNORE';
1769 local $SIG{INT} = 'IGNORE';
1770 local $SIG{QUIT} = 'IGNORE';
1771 local $SIG{TERM} = 'IGNORE';
1772 local $SIG{TSTP} = 'IGNORE';
1773 local $SIG{PIPE} = 'IGNORE';
1775 my $oldAutoCommit = $FS::UID::AutoCommit;
1776 local $FS::UID::AutoCommit = 0;
1779 my $part_pkg = new FS::part_pkg ( {
1781 'comment' => $comment,
1786 'taxclass' => $taxclass,
1789 my $error = $part_pkg->insert;
1791 $dbh->rollback if $oldAutoCommit;
1795 my $pkgpart = $part_pkg->pkgpart;
1796 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1797 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1798 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1799 $error = $type_pkgs->insert;
1801 $dbh->rollback if $oldAutoCommit;
1806 my $cust_pkg = new FS::cust_pkg ( {
1807 'custnum' => $self->custnum,
1808 'pkgpart' => $pkgpart,
1811 $error = $cust_pkg->insert;
1813 $dbh->rollback if $oldAutoCommit;
1817 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1824 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1830 sort { $a->_date <=> $b->_date }
1831 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1834 =item open_cust_bill
1836 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1841 sub open_cust_bill {
1843 grep { $_->owed > 0 } $self->cust_bill;
1852 =item check_and_rebuild_fuzzyfiles
1856 sub check_and_rebuild_fuzzyfiles {
1857 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1858 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1859 or &rebuild_fuzzyfiles;
1862 =item rebuild_fuzzyfiles
1866 sub rebuild_fuzzyfiles {
1868 use Fcntl qw(:flock);
1870 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1874 open(LASTLOCK,">>$dir/cust_main.last")
1875 or die "can't open $dir/cust_main.last: $!";
1876 flock(LASTLOCK,LOCK_EX)
1877 or die "can't lock $dir/cust_main.last: $!";
1879 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1881 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1882 if defined dbdef->table('cust_main')->column('ship_last');
1884 open (LASTCACHE,">$dir/cust_main.last.tmp")
1885 or die "can't open $dir/cust_main.last.tmp: $!";
1886 print LASTCACHE join("\n", @all_last), "\n";
1887 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1889 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1894 open(COMPANYLOCK,">>$dir/cust_main.company")
1895 or die "can't open $dir/cust_main.company: $!";
1896 flock(COMPANYLOCK,LOCK_EX)
1897 or die "can't lock $dir/cust_main.company: $!";
1899 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1901 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1902 if defined dbdef->table('cust_main')->column('ship_last');
1904 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1905 or die "can't open $dir/cust_main.company.tmp: $!";
1906 print COMPANYCACHE join("\n", @all_company), "\n";
1907 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1909 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1919 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1920 open(LASTCACHE,"<$dir/cust_main.last")
1921 or die "can't open $dir/cust_main.last: $!";
1922 my @array = map { chomp; $_; } <LASTCACHE>;
1932 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1933 open(COMPANYCACHE,"<$dir/cust_main.company")
1934 or die "can't open $dir/cust_main.last: $!";
1935 my @array = map { chomp; $_; } <COMPANYCACHE>;
1940 =item append_fuzzyfiles LASTNAME COMPANY
1944 sub append_fuzzyfiles {
1945 my( $last, $company ) = @_;
1947 &check_and_rebuild_fuzzyfiles;
1949 use Fcntl qw(:flock);
1951 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1955 open(LAST,">>$dir/cust_main.last")
1956 or die "can't open $dir/cust_main.last: $!";
1958 or die "can't lock $dir/cust_main.last: $!";
1960 print LAST "$last\n";
1963 or die "can't unlock $dir/cust_main.last: $!";
1969 open(COMPANY,">>$dir/cust_main.company")
1970 or die "can't open $dir/cust_main.company: $!";
1971 flock(COMPANY,LOCK_EX)
1972 or die "can't lock $dir/cust_main.company: $!";
1974 print COMPANY "$company\n";
1976 flock(COMPANY,LOCK_UN)
1977 or die "can't unlock $dir/cust_main.company: $!";
1991 #warn join('-',keys %$param);
1992 my $fh = $param->{filehandle};
1993 my $agentnum = $param->{agentnum};
1994 my $refnum = $param->{refnum};
1995 my $pkgpart = $param->{pkgpart};
1996 my @fields = @{$param->{fields}};
1998 eval "use Date::Parse;";
2000 eval "use Text::CSV_XS;";
2003 my $csv = new Text::CSV_XS;
2010 local $SIG{HUP} = 'IGNORE';
2011 local $SIG{INT} = 'IGNORE';
2012 local $SIG{QUIT} = 'IGNORE';
2013 local $SIG{TERM} = 'IGNORE';
2014 local $SIG{TSTP} = 'IGNORE';
2015 local $SIG{PIPE} = 'IGNORE';
2017 my $oldAutoCommit = $FS::UID::AutoCommit;
2018 local $FS::UID::AutoCommit = 0;
2021 #while ( $columns = $csv->getline($fh) ) {
2023 while ( defined($line=<$fh>) ) {
2025 $csv->parse($line) or do {
2026 $dbh->rollback if $oldAutoCommit;
2027 return "can't parse: ". $csv->error_input();
2030 my @columns = $csv->fields();
2031 #warn join('-',@columns);
2034 agentnum => $agentnum,
2036 country => 'US', #default
2037 payby => 'BILL', #default
2038 paydate => '12/2037', #default
2040 my $billtime = time;
2041 my %cust_pkg = ( pkgpart => $pkgpart );
2042 foreach my $field ( @fields ) {
2043 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2044 #$cust_pkg{$1} = str2time( shift @$columns );
2045 if ( $1 eq 'setup' ) {
2046 $billtime = str2time(shift @columns);
2048 $cust_pkg{$1} = str2time( shift @columns );
2051 #$cust_main{$field} = shift @$columns;
2052 $cust_main{$field} = shift @columns;
2056 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2057 my $cust_main = new FS::cust_main ( \%cust_main );
2059 tie my %hash, 'Tie::RefHash'; #this part is important
2060 $hash{$cust_pkg} = [] if $pkgpart;
2061 my $error = $cust_main->insert( \%hash );
2064 $dbh->rollback if $oldAutoCommit;
2065 return "can't insert customer for $line: $error";
2068 #false laziness w/bill.cgi
2069 $error = $cust_main->bill( 'time' => $billtime );
2071 $dbh->rollback if $oldAutoCommit;
2072 return "can't bill customer for $line: $error";
2075 $cust_main->apply_payments;
2076 $cust_main->apply_credits;
2078 $error = $cust_main->collect();
2080 $dbh->rollback if $oldAutoCommit;
2081 return "can't collect customer for $line: $error";
2087 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2089 return "Empty file!" unless $imported;
2101 #warn join('-',keys %$param);
2102 my $fh = $param->{filehandle};
2103 my @fields = @{$param->{fields}};
2105 eval "use Date::Parse;";
2107 eval "use Text::CSV_XS;";
2110 my $csv = new Text::CSV_XS;
2117 local $SIG{HUP} = 'IGNORE';
2118 local $SIG{INT} = 'IGNORE';
2119 local $SIG{QUIT} = 'IGNORE';
2120 local $SIG{TERM} = 'IGNORE';
2121 local $SIG{TSTP} = 'IGNORE';
2122 local $SIG{PIPE} = 'IGNORE';
2124 my $oldAutoCommit = $FS::UID::AutoCommit;
2125 local $FS::UID::AutoCommit = 0;
2128 #while ( $columns = $csv->getline($fh) ) {
2130 while ( defined($line=<$fh>) ) {
2132 $csv->parse($line) or do {
2133 $dbh->rollback if $oldAutoCommit;
2134 return "can't parse: ". $csv->error_input();
2137 my @columns = $csv->fields();
2138 #warn join('-',@columns);
2141 foreach my $field ( @fields ) {
2142 $row{$field} = shift @columns;
2145 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2146 unless ( $cust_main ) {
2147 $dbh->rollback if $oldAutoCommit;
2148 return "unknown custnum $row{'custnum'}";
2151 if ( $row{'amount'} > 0 ) {
2152 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2154 $dbh->rollback if $oldAutoCommit;
2158 } elsif ( $row{'amount'} < 0 ) {
2159 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2162 $dbh->rollback if $oldAutoCommit;
2172 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2174 return "Empty file!" unless $imported;
2186 The delete method should possibly take an FS::cust_main object reference
2187 instead of a scalar customer number.
2189 Bill and collect options should probably be passed as references instead of a
2192 There should probably be a configuration file with a list of allowed credit
2195 No multiple currency support (probably a larger project than just this module).
2199 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2200 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2201 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.