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;##
911 foreach my $cust_pkg (
912 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
915 #NO!! next if $cust_pkg->cancel;
916 next if $cust_pkg->getfield('cancel');
918 #? to avoid use of uninitialized value errors... ?
919 $cust_pkg->setfield('bill', '')
920 unless defined($cust_pkg->bill);
922 my $part_pkg = $cust_pkg->part_pkg;
924 #so we don't modify cust_pkg record unnecessarily
925 my $cust_pkg_mod_flag = 0;
926 my %hash = $cust_pkg->hash;
927 my $old_cust_pkg = new FS::cust_pkg \%hash;
931 unless ( $cust_pkg->setup ) {
932 my $setup_prog = $part_pkg->getfield('setup');
933 $setup_prog =~ /^(.*)$/ or do {
934 $dbh->rollback if $oldAutoCommit;
935 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
941 ##$cpt->permit(); #what is necessary?
942 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
943 #$setup = $cpt->reval($setup_prog);
944 $setup = eval $setup_prog;
945 unless ( defined($setup) ) {
946 $dbh->rollback if $oldAutoCommit;
947 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
948 "(expression $setup_prog): $@";
950 $cust_pkg->setfield('setup',$time);
951 $cust_pkg_mod_flag=1;
957 if ( $part_pkg->getfield('freq') > 0 &&
958 ! $cust_pkg->getfield('susp') &&
959 ( $cust_pkg->getfield('bill') || 0 ) < $time
961 my $recur_prog = $part_pkg->getfield('recur');
962 $recur_prog =~ /^(.*)$/ or do {
963 $dbh->rollback if $oldAutoCommit;
964 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
969 # shared with $recur_prog
970 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
973 ##$cpt->permit(); #what is necessary?
974 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
975 #$recur = $cpt->reval($recur_prog);
976 $recur = eval $recur_prog;
977 unless ( defined($recur) ) {
978 $dbh->rollback if $oldAutoCommit;
979 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
980 "(expression $recur_prog): $@";
982 #change this bit to use Date::Manip? CAREFUL with timezones (see
983 # mailing list archive)
984 my ($sec,$min,$hour,$mday,$mon,$year) =
985 (localtime($sdate) )[0,1,2,3,4,5];
987 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
988 # only for figuring next bill date, nothing else, so, reset $sdate again
990 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
992 $mon += $part_pkg->freq;
993 until ( $mon < 12 ) { $mon -= 12; $year++; }
994 $cust_pkg->setfield('bill',
995 timelocal($sec,$min,$hour,$mday,$mon,$year));
996 $cust_pkg_mod_flag = 1;
999 warn "\$setup is undefined" unless defined($setup);
1000 warn "\$recur is undefined" unless defined($recur);
1001 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1003 my $taxable_charged = 0;
1004 if ( $cust_pkg_mod_flag ) {
1005 $error=$cust_pkg->replace($old_cust_pkg);
1006 if ( $error ) { #just in case
1007 $dbh->rollback if $oldAutoCommit;
1008 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1010 $setup = sprintf( "%.2f", $setup );
1011 $recur = sprintf( "%.2f", $recur );
1013 $dbh->rollback if $oldAutoCommit;
1014 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1017 $dbh->rollback if $oldAutoCommit;
1018 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1020 if ( $setup > 0 || $recur > 0 ) {
1021 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1022 'pkgnum' => $cust_pkg->pkgnum,
1026 'edate' => $cust_pkg->bill,
1028 push @cust_bill_pkg, $cust_bill_pkg;
1029 $total_setup += $setup;
1030 $total_recur += $recur;
1031 $taxable_charged += $setup
1032 unless $part_pkg->setuptax =~ /^Y$/i;
1033 $taxable_charged += $recur
1034 unless $part_pkg->recurtax =~ /^Y$/i;
1036 unless ( $self->tax =~ /Y/i
1037 || $self->payby eq 'COMP'
1038 || $taxable_charged == 0 ) {
1040 my $cust_main_county =
1041 qsearchs('cust_main_county',{
1042 'state' => $self->state,
1043 'county' => $self->county,
1044 'country' => $self->country,
1045 'taxclass' => $part_pkg->taxclass,
1047 or qsearchs('cust_main_county',{
1048 'state' => $self->state,
1049 'county' => $self->county,
1050 'country' => $self->country,
1054 $dbh->rollback if $oldAutoCommit;
1056 "fatal: can't find tax rate for state/county/country/taxclass ".
1057 join('/', ( map $self->$_(), qw(state county country) ),
1058 $part_pkg->taxclass ). "\n";
1061 if ( $cust_main_county->exempt_amount ) {
1062 my ($mon,$year) = (localtime($sdate) )[4,5];
1064 my $freq = $part_pkg->freq || 1;
1065 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1066 foreach my $which_month ( 1 .. $freq ) {
1068 'custnum' => $self->custnum,
1069 'taxnum' => $cust_main_county->taxnum,
1070 'year' => 1900+$year,
1073 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1074 until ( $mon < 13 ) { $mon -= 12; $year++; }
1075 my $cust_tax_exempt =
1076 qsearchs('cust_tax_exempt', \%hash)
1077 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1078 my $remaining_exemption = sprintf("%.2f",
1079 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1080 if ( $remaining_exemption > 0 ) {
1081 my $addl = $remaining_exemption > $taxable_per_month
1082 ? $taxable_per_month
1083 : $remaining_exemption;
1084 $taxable_charged -= $addl;
1085 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1086 $cust_tax_exempt->hash,
1087 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1089 $error = $new_cust_tax_exempt->exemptnum
1090 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1091 : $new_cust_tax_exempt->insert;
1093 $dbh->rollback if $oldAutoCommit;
1094 return "fatal: can't update cust_tax_exempt: $error";
1097 } # if $remaining_exemption > 0
1099 } #foreach $which_month
1101 } #if $cust_main_county->exempt_amount
1103 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1104 $tax += $taxable_charged * $cust_main_county->tax / 100
1106 } #unless $self->tax =~ /Y/i
1107 # || $self->payby eq 'COMP'
1108 # || $taxable_charged == 0
1110 } #if $setup > 0 || $recur > 0
1112 } #if $cust_pkg_mod_flag
1114 } #foreach my $cust_pkg
1116 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1117 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1119 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1120 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1124 # unless ( $self->tax =~ /Y/i
1125 # || $self->payby eq 'COMP'
1126 # || $taxable_charged == 0 ) {
1127 # my $cust_main_county = qsearchs('cust_main_county',{
1128 # 'state' => $self->state,
1129 # 'county' => $self->county,
1130 # 'country' => $self->country,
1131 # } ) or die "fatal: can't find tax rate for state/county/country ".
1132 # $self->state. "/". $self->county. "/". $self->country. "\n";
1133 # my $tax = sprintf( "%.2f",
1134 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1137 $tax = sprintf("%.2f", $tax);
1139 $charged = sprintf( "%.2f", $charged+$tax );
1141 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1148 push @cust_bill_pkg, $cust_bill_pkg;
1152 my $cust_bill = new FS::cust_bill ( {
1153 'custnum' => $self->custnum,
1155 'charged' => $charged,
1157 $error = $cust_bill->insert;
1159 $dbh->rollback if $oldAutoCommit;
1160 return "can't create invoice for customer #". $self->custnum. ": $error";
1163 my $invnum = $cust_bill->invnum;
1165 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1167 $cust_bill_pkg->invnum($invnum);
1168 $error = $cust_bill_pkg->insert;
1170 $dbh->rollback if $oldAutoCommit;
1171 return "can't create invoice line item for customer #". $self->custnum.
1176 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1180 =item collect OPTIONS
1182 (Attempt to) collect money for this customer's outstanding invoices (see
1183 L<FS::cust_bill>). Usually used after the bill method.
1185 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1186 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1188 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1189 and the invoice events web interface.
1191 If there is an error, returns the error, otherwise returns false.
1193 Options are passed as name-value pairs.
1195 Currently available options are:
1197 invoice_time - Use this time when deciding when to print invoices and
1198 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>
1199 for conversion functions.
1201 retry_card - Retry cards even when not scheduled by invoice events.
1203 batch_card - This option is deprecated. See the invoice events web interface
1204 to control whether cards are batched or run against a realtime gateway.
1206 report_badcard - This option is deprecated.
1208 force_print - This option is deprecated; see the invoice events web interface.
1213 my( $self, %options ) = @_;
1214 my $invoice_time = $options{'invoice_time'} || time;
1217 local $SIG{HUP} = 'IGNORE';
1218 local $SIG{INT} = 'IGNORE';
1219 local $SIG{QUIT} = 'IGNORE';
1220 local $SIG{TERM} = 'IGNORE';
1221 local $SIG{TSTP} = 'IGNORE';
1222 local $SIG{PIPE} = 'IGNORE';
1224 my $oldAutoCommit = $FS::UID::AutoCommit;
1225 local $FS::UID::AutoCommit = 0;
1228 my $balance = $self->balance;
1229 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1230 unless ( $balance > 0 ) { #redundant?????
1231 $dbh->rollback if $oldAutoCommit; #hmm
1235 if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1236 #false laziness w/replace
1237 foreach my $cust_bill_event (
1239 #$_->part_bill_event->plan eq 'realtime-card'
1240 $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1241 && $_->status eq 'done'
1244 map { $_->cust_bill_event }
1245 grep { $_->cust_bill_event }
1246 $self->open_cust_bill
1248 my $error = $cust_bill_event->retry;
1250 $dbh->rollback if $oldAutoCommit;
1251 return "error scheduling invoice events for retry: $error";
1257 foreach my $cust_bill ( $self->cust_bill ) {
1259 #this has to be before next's
1260 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1264 $balance = sprintf( "%.2f", $balance - $amount );
1266 next unless $cust_bill->owed > 0;
1268 # don't try to charge for the same invoice if it's already in a batch
1269 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1271 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1273 next unless $amount > 0;
1276 foreach my $part_bill_event (
1277 sort { $a->seconds <=> $b->seconds
1278 || $a->weight <=> $b->weight
1279 || $a->eventpart <=> $b->eventpart }
1280 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1281 && ! qsearchs( 'cust_bill_event', {
1282 'invnum' => $cust_bill->invnum,
1283 'eventpart' => $_->eventpart,
1287 qsearch('part_bill_event', { 'payby' => $self->payby,
1288 'disabled' => '', } )
1291 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1293 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1295 my $cust_main = $self; #for callback
1296 my $error = eval $part_bill_event->eventcode;
1299 my $statustext = '';
1303 } elsif ( $error ) {
1305 $statustext = $error;
1310 #add cust_bill_event
1311 my $cust_bill_event = new FS::cust_bill_event {
1312 'invnum' => $cust_bill->invnum,
1313 'eventpart' => $part_bill_event->eventpart,
1314 '_date' => $invoice_time,
1315 'status' => $status,
1316 'statustext' => $statustext,
1318 $error = $cust_bill_event->insert;
1320 #$dbh->rollback if $oldAutoCommit;
1321 #return "error: $error";
1323 # gah, even with transactions.
1324 $dbh->commit if $oldAutoCommit; #well.
1325 my $e = 'WARNING: Event run but database not updated - '.
1326 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1327 ', eventpart '. $part_bill_event->eventpart.
1338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1345 Returns the total owed for this customer on all invoices
1346 (see L<FS::cust_bill/owed>).
1352 $self->total_owed_date(2145859200); #12/31/2037
1355 =item total_owed_date TIME
1357 Returns the total owed for this customer on all invoices with date earlier than
1358 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1359 see L<Time::Local> and L<Date::Parse> for conversion functions.
1363 sub total_owed_date {
1367 foreach my $cust_bill (
1368 grep { $_->_date <= $time }
1369 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1371 $total_bill += $cust_bill->owed;
1373 sprintf( "%.2f", $total_bill );
1378 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1379 to outstanding invoice balances in chronological order and returns the value
1380 of any remaining unapplied credits available for refund
1381 (see L<FS::cust_refund>).
1388 return 0 unless $self->total_credited;
1390 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1391 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1393 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1394 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1398 foreach my $cust_bill ( @invoices ) {
1401 if ( !defined($credit) || $credit->credited == 0) {
1402 $credit = pop @credits or last;
1405 if ($cust_bill->owed >= $credit->credited) {
1406 $amount=$credit->credited;
1408 $amount=$cust_bill->owed;
1411 my $cust_credit_bill = new FS::cust_credit_bill ( {
1412 'crednum' => $credit->crednum,
1413 'invnum' => $cust_bill->invnum,
1414 'amount' => $amount,
1416 my $error = $cust_credit_bill->insert;
1417 die $error if $error;
1419 redo if ($cust_bill->owed > 0);
1423 return $self->total_credited;
1426 =item apply_payments
1428 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1429 to outstanding invoice balances in chronological order.
1431 #and returns the value of any remaining unapplied payments.
1435 sub apply_payments {
1440 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1441 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1443 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1444 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1448 foreach my $cust_bill ( @invoices ) {
1451 if ( !defined($payment) || $payment->unapplied == 0 ) {
1452 $payment = pop @payments or last;
1455 if ( $cust_bill->owed >= $payment->unapplied ) {
1456 $amount = $payment->unapplied;
1458 $amount = $cust_bill->owed;
1461 my $cust_bill_pay = new FS::cust_bill_pay ( {
1462 'paynum' => $payment->paynum,
1463 'invnum' => $cust_bill->invnum,
1464 'amount' => $amount,
1466 my $error = $cust_bill_pay->insert;
1467 die $error if $error;
1469 redo if ( $cust_bill->owed > 0);
1473 return $self->total_unapplied_payments;
1476 =item total_credited
1478 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1479 customer. See L<FS::cust_credit/credited>.
1483 sub total_credited {
1485 my $total_credit = 0;
1486 foreach my $cust_credit ( qsearch('cust_credit', {
1487 'custnum' => $self->custnum,
1489 $total_credit += $cust_credit->credited;
1491 sprintf( "%.2f", $total_credit );
1494 =item total_unapplied_payments
1496 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1497 See L<FS::cust_pay/unapplied>.
1501 sub total_unapplied_payments {
1503 my $total_unapplied = 0;
1504 foreach my $cust_pay ( qsearch('cust_pay', {
1505 'custnum' => $self->custnum,
1507 $total_unapplied += $cust_pay->unapplied;
1509 sprintf( "%.2f", $total_unapplied );
1514 Returns the balance for this customer (total_owed minus total_credited
1515 minus total_unapplied_payments).
1522 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1526 =item balance_date TIME
1528 Returns the balance for this customer, only considering invoices with date
1529 earlier than TIME (total_owed_date minus total_credited minus
1530 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
1531 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
1540 $self->total_owed_date($time)
1541 - $self->total_credited
1542 - $self->total_unapplied_payments
1546 =item invoicing_list [ ARRAYREF ]
1548 If an arguement is given, sets these email addresses as invoice recipients
1549 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
1550 (except as warnings), so use check_invoicing_list first.
1552 Returns a list of email addresses (with svcnum entries expanded).
1554 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
1555 check it without disturbing anything by passing nothing.
1557 This interface may change in the future.
1561 sub invoicing_list {
1562 my( $self, $arrayref ) = @_;
1564 my @cust_main_invoice;
1565 if ( $self->custnum ) {
1566 @cust_main_invoice =
1567 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1569 @cust_main_invoice = ();
1571 foreach my $cust_main_invoice ( @cust_main_invoice ) {
1572 #warn $cust_main_invoice->destnum;
1573 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1574 #warn $cust_main_invoice->destnum;
1575 my $error = $cust_main_invoice->delete;
1576 warn $error if $error;
1579 if ( $self->custnum ) {
1580 @cust_main_invoice =
1581 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1583 @cust_main_invoice = ();
1585 my %seen = map { $_->address => 1 } @cust_main_invoice;
1586 foreach my $address ( @{$arrayref} ) {
1587 next if exists $seen{$address} && $seen{$address};
1588 $seen{$address} = 1;
1589 my $cust_main_invoice = new FS::cust_main_invoice ( {
1590 'custnum' => $self->custnum,
1593 my $error = $cust_main_invoice->insert;
1594 warn $error if $error;
1597 if ( $self->custnum ) {
1599 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1605 =item check_invoicing_list ARRAYREF
1607 Checks these arguements as valid input for the invoicing_list method. If there
1608 is an error, returns the error, otherwise returns false.
1612 sub check_invoicing_list {
1613 my( $self, $arrayref ) = @_;
1614 foreach my $address ( @{$arrayref} ) {
1615 my $cust_main_invoice = new FS::cust_main_invoice ( {
1616 'custnum' => $self->custnum,
1619 my $error = $self->custnum
1620 ? $cust_main_invoice->check
1621 : $cust_main_invoice->checkdest
1623 return $error if $error;
1628 =item set_default_invoicing_list
1630 Sets the invoicing list to all accounts associated with this customer,
1631 overwriting any previous invoicing list.
1635 sub set_default_invoicing_list {
1637 $self->invoicing_list($self->all_emails);
1642 Returns the email addresses of all accounts provisioned for this customer.
1649 foreach my $cust_pkg ( $self->all_pkgs ) {
1650 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1652 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1653 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1655 $list{$_}=1 foreach map { $_->email } @svc_acct;
1660 =item invoicing_list_addpost
1662 Adds postal invoicing to this customer. If this customer is already configured
1663 to receive postal invoices, does nothing.
1667 sub invoicing_list_addpost {
1669 return if grep { $_ eq 'POST' } $self->invoicing_list;
1670 my @invoicing_list = $self->invoicing_list;
1671 push @invoicing_list, 'POST';
1672 $self->invoicing_list(\@invoicing_list);
1675 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1677 Returns an array of customers referred by this customer (referral_custnum set
1678 to this custnum). If DEPTH is given, recurses up to the given depth, returning
1679 customers referred by customers referred by this customer and so on, inclusive.
1680 The default behavior is DEPTH 1 (no recursion).
1684 sub referral_cust_main {
1686 my $depth = @_ ? shift : 1;
1687 my $exclude = @_ ? shift : {};
1690 map { $exclude->{$_->custnum}++; $_; }
1691 grep { ! $exclude->{ $_->custnum } }
1692 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1696 map { $_->referral_cust_main($depth-1, $exclude) }
1703 =item referral_cust_main_ncancelled
1705 Same as referral_cust_main, except only returns customers with uncancelled
1710 sub referral_cust_main_ncancelled {
1712 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1715 =item referral_cust_pkg [ DEPTH ]
1717 Like referral_cust_main, except returns a flat list of all unsuspended (and
1718 uncancelled) packages for each customer. The number of items in this list may
1719 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1723 sub referral_cust_pkg {
1725 my $depth = @_ ? shift : 1;
1727 map { $_->unsuspended_pkgs }
1728 grep { $_->unsuspended_pkgs }
1729 $self->referral_cust_main($depth);
1732 =item credit AMOUNT, REASON
1734 Applies a credit to this customer. If there is an error, returns the error,
1735 otherwise returns false.
1740 my( $self, $amount, $reason ) = @_;
1741 my $cust_credit = new FS::cust_credit {
1742 'custnum' => $self->custnum,
1743 'amount' => $amount,
1744 'reason' => $reason,
1746 $cust_credit->insert;
1749 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1751 Creates a one-time charge for this customer. If there is an error, returns
1752 the error, otherwise returns false.
1757 my ( $self, $amount ) = ( shift, shift );
1758 my $pkg = @_ ? shift : 'One-time charge';
1759 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
1760 my $taxclass = @_ ? shift : '';
1762 local $SIG{HUP} = 'IGNORE';
1763 local $SIG{INT} = 'IGNORE';
1764 local $SIG{QUIT} = 'IGNORE';
1765 local $SIG{TERM} = 'IGNORE';
1766 local $SIG{TSTP} = 'IGNORE';
1767 local $SIG{PIPE} = 'IGNORE';
1769 my $oldAutoCommit = $FS::UID::AutoCommit;
1770 local $FS::UID::AutoCommit = 0;
1773 my $part_pkg = new FS::part_pkg ( {
1775 'comment' => $comment,
1780 'taxclass' => $taxclass,
1783 my $error = $part_pkg->insert;
1785 $dbh->rollback if $oldAutoCommit;
1789 my $pkgpart = $part_pkg->pkgpart;
1790 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1791 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1792 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1793 $error = $type_pkgs->insert;
1795 $dbh->rollback if $oldAutoCommit;
1800 my $cust_pkg = new FS::cust_pkg ( {
1801 'custnum' => $self->custnum,
1802 'pkgpart' => $pkgpart,
1805 $error = $cust_pkg->insert;
1807 $dbh->rollback if $oldAutoCommit;
1811 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1818 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1824 sort { $a->_date <=> $b->_date }
1825 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1828 =item open_cust_bill
1830 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1835 sub open_cust_bill {
1837 grep { $_->owed > 0 } $self->cust_bill;
1846 =item check_and_rebuild_fuzzyfiles
1850 sub check_and_rebuild_fuzzyfiles {
1851 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1852 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1853 or &rebuild_fuzzyfiles;
1856 =item rebuild_fuzzyfiles
1860 sub rebuild_fuzzyfiles {
1862 use Fcntl qw(:flock);
1864 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1868 open(LASTLOCK,">>$dir/cust_main.last")
1869 or die "can't open $dir/cust_main.last: $!";
1870 flock(LASTLOCK,LOCK_EX)
1871 or die "can't lock $dir/cust_main.last: $!";
1873 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1875 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1876 if defined dbdef->table('cust_main')->column('ship_last');
1878 open (LASTCACHE,">$dir/cust_main.last.tmp")
1879 or die "can't open $dir/cust_main.last.tmp: $!";
1880 print LASTCACHE join("\n", @all_last), "\n";
1881 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1883 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1888 open(COMPANYLOCK,">>$dir/cust_main.company")
1889 or die "can't open $dir/cust_main.company: $!";
1890 flock(COMPANYLOCK,LOCK_EX)
1891 or die "can't lock $dir/cust_main.company: $!";
1893 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1895 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1896 if defined dbdef->table('cust_main')->column('ship_last');
1898 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1899 or die "can't open $dir/cust_main.company.tmp: $!";
1900 print COMPANYCACHE join("\n", @all_company), "\n";
1901 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1903 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1913 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1914 open(LASTCACHE,"<$dir/cust_main.last")
1915 or die "can't open $dir/cust_main.last: $!";
1916 my @array = map { chomp; $_; } <LASTCACHE>;
1926 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1927 open(COMPANYCACHE,"<$dir/cust_main.company")
1928 or die "can't open $dir/cust_main.last: $!";
1929 my @array = map { chomp; $_; } <COMPANYCACHE>;
1934 =item append_fuzzyfiles LASTNAME COMPANY
1938 sub append_fuzzyfiles {
1939 my( $last, $company ) = @_;
1941 &check_and_rebuild_fuzzyfiles;
1943 use Fcntl qw(:flock);
1945 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1949 open(LAST,">>$dir/cust_main.last")
1950 or die "can't open $dir/cust_main.last: $!";
1952 or die "can't lock $dir/cust_main.last: $!";
1954 print LAST "$last\n";
1957 or die "can't unlock $dir/cust_main.last: $!";
1963 open(COMPANY,">>$dir/cust_main.company")
1964 or die "can't open $dir/cust_main.company: $!";
1965 flock(COMPANY,LOCK_EX)
1966 or die "can't lock $dir/cust_main.company: $!";
1968 print COMPANY "$company\n";
1970 flock(COMPANY,LOCK_UN)
1971 or die "can't unlock $dir/cust_main.company: $!";
1985 #warn join('-',keys %$param);
1986 my $fh = $param->{filehandle};
1987 my $agentnum = $param->{agentnum};
1988 my $refnum = $param->{refnum};
1989 my $pkgpart = $param->{pkgpart};
1990 my @fields = @{$param->{fields}};
1992 eval "use Date::Parse;";
1994 eval "use Text::CSV_XS;";
1997 my $csv = new Text::CSV_XS;
2004 local $SIG{HUP} = 'IGNORE';
2005 local $SIG{INT} = 'IGNORE';
2006 local $SIG{QUIT} = 'IGNORE';
2007 local $SIG{TERM} = 'IGNORE';
2008 local $SIG{TSTP} = 'IGNORE';
2009 local $SIG{PIPE} = 'IGNORE';
2011 my $oldAutoCommit = $FS::UID::AutoCommit;
2012 local $FS::UID::AutoCommit = 0;
2015 #while ( $columns = $csv->getline($fh) ) {
2017 while ( defined($line=<$fh>) ) {
2019 $csv->parse($line) or do {
2020 $dbh->rollback if $oldAutoCommit;
2021 return "can't parse: ". $csv->error_input();
2024 my @columns = $csv->fields();
2025 #warn join('-',@columns);
2028 agentnum => $agentnum,
2030 country => 'US', #default
2031 payby => 'BILL', #default
2032 paydate => '12/2037', #default
2034 my $billtime = time;
2035 my %cust_pkg = ( pkgpart => $pkgpart );
2036 foreach my $field ( @fields ) {
2037 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2038 #$cust_pkg{$1} = str2time( shift @$columns );
2039 if ( $1 eq 'setup' ) {
2040 $billtime = str2time(shift @columns);
2042 $cust_pkg{$1} = str2time( shift @columns );
2045 #$cust_main{$field} = shift @$columns;
2046 $cust_main{$field} = shift @columns;
2050 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2051 my $cust_main = new FS::cust_main ( \%cust_main );
2053 tie my %hash, 'Tie::RefHash'; #this part is important
2054 $hash{$cust_pkg} = [] if $pkgpart;
2055 my $error = $cust_main->insert( \%hash );
2058 $dbh->rollback if $oldAutoCommit;
2059 return "can't insert customer for $line: $error";
2062 #false laziness w/bill.cgi
2063 $error = $cust_main->bill( 'time' => $billtime );
2065 $dbh->rollback if $oldAutoCommit;
2066 return "can't bill customer for $line: $error";
2069 $cust_main->apply_payments;
2070 $cust_main->apply_credits;
2072 $error = $cust_main->collect();
2074 $dbh->rollback if $oldAutoCommit;
2075 return "can't collect customer for $line: $error";
2081 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2083 return "Empty file!" unless $imported;
2095 #warn join('-',keys %$param);
2096 my $fh = $param->{filehandle};
2097 my @fields = @{$param->{fields}};
2099 eval "use Date::Parse;";
2101 eval "use Text::CSV_XS;";
2104 my $csv = new Text::CSV_XS;
2111 local $SIG{HUP} = 'IGNORE';
2112 local $SIG{INT} = 'IGNORE';
2113 local $SIG{QUIT} = 'IGNORE';
2114 local $SIG{TERM} = 'IGNORE';
2115 local $SIG{TSTP} = 'IGNORE';
2116 local $SIG{PIPE} = 'IGNORE';
2118 my $oldAutoCommit = $FS::UID::AutoCommit;
2119 local $FS::UID::AutoCommit = 0;
2122 #while ( $columns = $csv->getline($fh) ) {
2124 while ( defined($line=<$fh>) ) {
2126 $csv->parse($line) or do {
2127 $dbh->rollback if $oldAutoCommit;
2128 return "can't parse: ". $csv->error_input();
2131 my @columns = $csv->fields();
2132 #warn join('-',@columns);
2135 foreach my $field ( @fields ) {
2136 $row{$field} = shift @columns;
2139 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2140 unless ( $cust_main ) {
2141 $dbh->rollback if $oldAutoCommit;
2142 return "unknown custnum $row{'custnum'}";
2145 if ( $row{'amount'} > 0 ) {
2146 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2148 $dbh->rollback if $oldAutoCommit;
2152 } elsif ( $row{'amount'} < 0 ) {
2153 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2156 $dbh->rollback if $oldAutoCommit;
2166 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2168 return "Empty file!" unless $imported;
2180 The delete method should possibly take an FS::cust_main object reference
2181 instead of a scalar customer number.
2183 Bill and collect options should probably be passed as references instead of a
2186 There should probably be a configuration file with a list of allowed credit
2189 No multiple currency support (probably a larger project than just this module).
2193 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2194 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2195 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.