4 use vars qw( @ISA $conf $Debug $import );
5 use vars qw( $realtime_bop_decline_quiet ); #ugh
9 eval "use Time::Local;";
10 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
11 if $] < 5.006 && !defined($Time::Local::VERSION);
12 eval "use Time::Local qw(timelocal timelocal_nocheck);";
16 use Business::CreditCard;
17 use FS::UID qw( getotaker dbh );
18 use FS::Record qw( qsearchs qsearch dbdef );
19 use FS::Misc qw( send_email );
22 use FS::cust_bill_pkg;
25 use FS::part_referral;
26 use FS::cust_main_county;
28 use FS::cust_main_invoice;
29 use FS::cust_credit_bill;
30 use FS::cust_bill_pay;
31 use FS::prepay_credit;
34 use FS::part_bill_event;
35 use FS::cust_bill_event;
36 use FS::cust_tax_exempt;
38 use FS::Msgcat qw(gettext);
40 @ISA = qw( FS::Record );
42 $realtime_bop_decline_quiet = 0;
49 #ask FS::UID to run this stuff for us later
50 #$FS::UID::callback{'FS::cust_main'} = sub {
51 install_callback FS::UID sub {
53 #yes, need it for stuff below (prolly should be cached)
58 my ( $hashref, $cache ) = @_;
59 if ( exists $hashref->{'pkgnum'} ) {
60 # #@{ $self->{'_pkgnum'} } = ();
61 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
62 $self->{'_pkgnum'} = $subcache;
63 #push @{ $self->{'_pkgnum'} },
64 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
70 FS::cust_main - Object methods for cust_main records
76 $record = new FS::cust_main \%hash;
77 $record = new FS::cust_main { 'column' => 'value' };
79 $error = $record->insert;
81 $error = $new_record->replace($old_record);
83 $error = $record->delete;
85 $error = $record->check;
87 @cust_pkg = $record->all_pkgs;
89 @cust_pkg = $record->ncancelled_pkgs;
91 @cust_pkg = $record->suspended_pkgs;
93 $error = $record->bill;
94 $error = $record->bill %options;
95 $error = $record->bill 'time' => $time;
97 $error = $record->collect;
98 $error = $record->collect %options;
99 $error = $record->collect 'invoice_time' => $time,
100 'batch_card' => 'yes',
101 'report_badcard' => 'yes',
106 An FS::cust_main object represents a customer. FS::cust_main inherits from
107 FS::Record. The following fields are currently supported:
111 =item custnum - primary key (assigned automatically for new customers)
113 =item agentnum - agent (see L<FS::agent>)
115 =item refnum - Advertising source (see L<FS::part_referral>)
121 =item ss - social security number (optional)
123 =item company - (optional)
127 =item address2 - (optional)
131 =item county - (optional, see L<FS::cust_main_county>)
133 =item state - (see L<FS::cust_main_county>)
137 =item country - (see L<FS::cust_main_county>)
139 =item daytime - phone (optional)
141 =item night - phone (optional)
143 =item fax - phone (optional)
145 =item ship_first - name
147 =item ship_last - name
149 =item ship_company - (optional)
153 =item ship_address2 - (optional)
157 =item ship_county - (optional, see L<FS::cust_main_county>)
159 =item ship_state - (see L<FS::cust_main_county>)
163 =item ship_country - (see L<FS::cust_main_county>)
165 =item ship_daytime - phone (optional)
167 =item ship_night - phone (optional)
169 =item ship_fax - phone (optional)
171 =item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
173 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
175 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
177 =item payname - name on card or billing name
179 =item tax - tax exempt, empty or `Y'
181 =item otaker - order taker (assigned automatically, see L<FS::UID>)
183 =item comments - comments (optional)
185 =item referral_custnum - referring customer number
195 Creates a new customer. To add the customer to the database, see L<"insert">.
197 Note that this stores the hash reference, not a distinct copy of the hash it
198 points to. You can ask the object for a copy with the I<hash> method.
202 sub table { 'cust_main'; }
204 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
206 Adds this customer to the database. If there is an error, returns the error,
207 otherwise returns false.
209 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
210 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
211 are inserted atomicly, or the transaction is rolled back. Passing an empty
212 hash reference is equivalent to not supplying this parameter. There should be
213 a better explanation of this, but until then, here's an example:
216 tie %hash, 'Tie::RefHash'; #this part is important
218 $cust_pkg => [ $svc_acct ],
221 $cust_main->insert( \%hash );
223 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
224 be set as the invoicing list (see L<"invoicing_list">). Errors return as
225 expected and rollback the entire transaction; it is not necessary to call
226 check_invoicing_list first. The invoicing_list is set after the records in the
227 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
228 invoicing_list destination to the newly-created svc_acct. Here's an example:
230 $cust_main->insert( {}, [ $email, 'POST' ] );
232 Currently available options are: I<noexport>
234 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
235 (You can schedule them later with the B<reexport> method.)
241 my $cust_pkgs = @_ ? shift : {};
242 my $invoicing_list = @_ ? shift : '';
245 local $SIG{HUP} = 'IGNORE';
246 local $SIG{INT} = 'IGNORE';
247 local $SIG{QUIT} = 'IGNORE';
248 local $SIG{TERM} = 'IGNORE';
249 local $SIG{TSTP} = 'IGNORE';
250 local $SIG{PIPE} = 'IGNORE';
252 my $oldAutoCommit = $FS::UID::AutoCommit;
253 local $FS::UID::AutoCommit = 0;
258 if ( $self->payby eq 'PREPAY' ) {
259 $self->payby('BILL');
260 my $prepay_credit = qsearchs(
262 { 'identifier' => $self->payinfo },
266 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
267 unless $prepay_credit;
268 $amount = $prepay_credit->amount;
269 $seconds = $prepay_credit->seconds;
270 my $error = $prepay_credit->delete;
272 $dbh->rollback if $oldAutoCommit;
273 return "removing prepay_credit (transaction rolled back): $error";
277 my $error = $self->SUPER::insert;
279 $dbh->rollback if $oldAutoCommit;
280 #return "inserting cust_main record (transaction rolled back): $error";
285 if ( $invoicing_list ) {
286 $error = $self->check_invoicing_list( $invoicing_list );
288 $dbh->rollback if $oldAutoCommit;
289 return "checking invoicing_list (transaction rolled back): $error";
291 $self->invoicing_list( $invoicing_list );
295 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
296 $error = $self->order_pkgs($cust_pkgs, \$seconds);
298 $dbh->rollback if $oldAutoCommit;
303 $dbh->rollback if $oldAutoCommit;
304 return "No svc_acct record to apply pre-paid time";
308 my $cust_credit = new FS::cust_credit {
309 'custnum' => $self->custnum,
312 $error = $cust_credit->insert;
314 $dbh->rollback if $oldAutoCommit;
315 return "inserting credit (transaction rolled back): $error";
319 $error = $self->queue_fuzzyfiles_update;
321 $dbh->rollback if $oldAutoCommit;
322 return "updating fuzzy search cache: $error";
325 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
332 document me. like ->insert(%cust_pkg) on an existing record
338 my $cust_pkgs = shift;
341 local $SIG{HUP} = 'IGNORE';
342 local $SIG{INT} = 'IGNORE';
343 local $SIG{QUIT} = 'IGNORE';
344 local $SIG{TERM} = 'IGNORE';
345 local $SIG{TSTP} = 'IGNORE';
346 local $SIG{PIPE} = 'IGNORE';
348 my $oldAutoCommit = $FS::UID::AutoCommit;
349 local $FS::UID::AutoCommit = 0;
352 foreach my $cust_pkg ( keys %$cust_pkgs ) {
353 $cust_pkg->custnum( $self->custnum );
354 my $error = $cust_pkg->insert;
356 $dbh->rollback if $oldAutoCommit;
357 return "inserting cust_pkg (transaction rolled back): $error";
359 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
360 $svc_something->pkgnum( $cust_pkg->pkgnum );
361 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
362 $svc_something->seconds( $svc_something->seconds + $$seconds );
365 $error = $svc_something->insert;
367 $dbh->rollback if $oldAutoCommit;
368 #return "inserting svc_ (transaction rolled back): $error";
374 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
380 document me. Re-schedules all exports by calling the B<reexport> method
381 of all associated packages (see L<FS::cust_pkg>). If there is an error,
382 returns the error; otherwise returns false.
389 local $SIG{HUP} = 'IGNORE';
390 local $SIG{INT} = 'IGNORE';
391 local $SIG{QUIT} = 'IGNORE';
392 local $SIG{TERM} = 'IGNORE';
393 local $SIG{TSTP} = 'IGNORE';
394 local $SIG{PIPE} = 'IGNORE';
396 my $oldAutoCommit = $FS::UID::AutoCommit;
397 local $FS::UID::AutoCommit = 0;
400 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
401 my $error = $cust_pkg->reexport;
403 $dbh->rollback if $oldAutoCommit;
408 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
413 =item delete NEW_CUSTNUM
415 This deletes the customer. If there is an error, returns the error, otherwise
418 This will completely remove all traces of the customer record. This is not
419 what you want when a customer cancels service; for that, cancel all of the
420 customer's packages (see L</cancel>).
422 If the customer has any uncancelled packages, you need to pass a new (valid)
423 customer number for those packages to be transferred to. Cancelled packages
424 will be deleted. Did I mention that this is NOT what you want when a customer
425 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
427 You can't delete a customer with invoices (see L<FS::cust_bill>),
428 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
429 refunds (see L<FS::cust_refund>).
436 local $SIG{HUP} = 'IGNORE';
437 local $SIG{INT} = 'IGNORE';
438 local $SIG{QUIT} = 'IGNORE';
439 local $SIG{TERM} = 'IGNORE';
440 local $SIG{TSTP} = 'IGNORE';
441 local $SIG{PIPE} = 'IGNORE';
443 my $oldAutoCommit = $FS::UID::AutoCommit;
444 local $FS::UID::AutoCommit = 0;
447 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
448 $dbh->rollback if $oldAutoCommit;
449 return "Can't delete a customer with invoices";
451 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
452 $dbh->rollback if $oldAutoCommit;
453 return "Can't delete a customer with credits";
455 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
456 $dbh->rollback if $oldAutoCommit;
457 return "Can't delete a customer with payments";
459 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
460 $dbh->rollback if $oldAutoCommit;
461 return "Can't delete a customer with refunds";
464 my @cust_pkg = $self->ncancelled_pkgs;
466 my $new_custnum = shift;
467 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
468 $dbh->rollback if $oldAutoCommit;
469 return "Invalid new customer number: $new_custnum";
471 foreach my $cust_pkg ( @cust_pkg ) {
472 my %hash = $cust_pkg->hash;
473 $hash{'custnum'} = $new_custnum;
474 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
475 my $error = $new_cust_pkg->replace($cust_pkg);
477 $dbh->rollback if $oldAutoCommit;
482 my @cancelled_cust_pkg = $self->all_pkgs;
483 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
484 my $error = $cust_pkg->delete;
486 $dbh->rollback if $oldAutoCommit;
491 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
492 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
494 my $error = $cust_main_invoice->delete;
496 $dbh->rollback if $oldAutoCommit;
501 my $error = $self->SUPER::delete;
503 $dbh->rollback if $oldAutoCommit;
507 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
512 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
514 Replaces the OLD_RECORD with this one in the database. If there is an error,
515 returns the error, otherwise returns false.
517 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
518 be set as the invoicing list (see L<"invoicing_list">). Errors return as
519 expected and rollback the entire transaction; it is not necessary to call
520 check_invoicing_list first. Here's an example:
522 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
531 local $SIG{HUP} = 'IGNORE';
532 local $SIG{INT} = 'IGNORE';
533 local $SIG{QUIT} = 'IGNORE';
534 local $SIG{TERM} = 'IGNORE';
535 local $SIG{TSTP} = 'IGNORE';
536 local $SIG{PIPE} = 'IGNORE';
538 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
539 && $conf->config('users-allow_comp') ) {
540 return "You are not permitted to create complimentary accounts."
541 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
544 my $oldAutoCommit = $FS::UID::AutoCommit;
545 local $FS::UID::AutoCommit = 0;
548 my $error = $self->SUPER::replace($old);
551 $dbh->rollback if $oldAutoCommit;
555 if ( @param ) { # INVOICING_LIST_ARYREF
556 my $invoicing_list = shift @param;
557 $error = $self->check_invoicing_list( $invoicing_list );
559 $dbh->rollback if $oldAutoCommit;
562 $self->invoicing_list( $invoicing_list );
565 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
566 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
567 # card/check/lec info has changed, want to retry realtime_ invoice events
568 my $error = $self->retry_realtime;
570 $dbh->rollback if $oldAutoCommit;
575 $error = $self->queue_fuzzyfiles_update;
577 $dbh->rollback if $oldAutoCommit;
578 return "updating fuzzy search cache: $error";
581 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
586 =item queue_fuzzyfiles_update
588 Used by insert & replace to update the fuzzy search cache
592 sub queue_fuzzyfiles_update {
595 local $SIG{HUP} = 'IGNORE';
596 local $SIG{INT} = 'IGNORE';
597 local $SIG{QUIT} = 'IGNORE';
598 local $SIG{TERM} = 'IGNORE';
599 local $SIG{TSTP} = 'IGNORE';
600 local $SIG{PIPE} = 'IGNORE';
602 my $oldAutoCommit = $FS::UID::AutoCommit;
603 local $FS::UID::AutoCommit = 0;
606 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
607 my $error = $queue->insert($self->getfield('last'), $self->company);
609 $dbh->rollback if $oldAutoCommit;
610 return "queueing job (transaction rolled back): $error";
613 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
614 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
615 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
617 $dbh->rollback if $oldAutoCommit;
618 return "queueing job (transaction rolled back): $error";
622 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
629 Checks all fields to make sure this is a valid customer record. If there is
630 an error, returns the error, otherwise returns false. Called by the insert
638 #warn "BEFORE: \n". $self->_dump;
641 $self->ut_numbern('custnum')
642 || $self->ut_number('agentnum')
643 || $self->ut_number('refnum')
644 || $self->ut_name('last')
645 || $self->ut_name('first')
646 || $self->ut_textn('company')
647 || $self->ut_text('address1')
648 || $self->ut_textn('address2')
649 || $self->ut_text('city')
650 || $self->ut_textn('county')
651 || $self->ut_textn('state')
652 || $self->ut_country('country')
653 || $self->ut_anything('comments')
654 || $self->ut_numbern('referral_custnum')
656 #barf. need message catalogs. i18n. etc.
657 $error .= "Please select an advertising source."
658 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
659 return $error if $error;
661 return "Unknown agent"
662 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
664 return "Unknown refnum"
665 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
667 return "Unknown referring custnum ". $self->referral_custnum
668 unless ! $self->referral_custnum
669 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
671 if ( $self->ss eq '' ) {
676 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
677 or return "Illegal social security number: ". $self->ss;
678 $self->ss("$1-$2-$3");
682 # bad idea to disable, causes billing to fail because of no tax rates later
683 # unless ( $import ) {
684 unless ( qsearch('cust_main_county', {
685 'country' => $self->country,
688 return "Unknown state/county/country: ".
689 $self->state. "/". $self->county. "/". $self->country
690 unless qsearch('cust_main_county',{
691 'state' => $self->state,
692 'county' => $self->county,
693 'country' => $self->country,
699 $self->ut_phonen('daytime', $self->country)
700 || $self->ut_phonen('night', $self->country)
701 || $self->ut_phonen('fax', $self->country)
702 || $self->ut_zip('zip', $self->country)
704 return $error if $error;
707 last first company address1 address2 city county state zip
708 country daytime night fax
711 if ( defined $self->dbdef_table->column('ship_last') ) {
712 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
714 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
718 $self->ut_name('ship_last')
719 || $self->ut_name('ship_first')
720 || $self->ut_textn('ship_company')
721 || $self->ut_text('ship_address1')
722 || $self->ut_textn('ship_address2')
723 || $self->ut_text('ship_city')
724 || $self->ut_textn('ship_county')
725 || $self->ut_textn('ship_state')
726 || $self->ut_country('ship_country')
728 return $error if $error;
730 #false laziness with above
731 unless ( qsearchs('cust_main_county', {
732 'country' => $self->ship_country,
735 return "Unknown ship_state/ship_county/ship_country: ".
736 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
737 unless qsearchs('cust_main_county',{
738 'state' => $self->ship_state,
739 'county' => $self->ship_county,
740 'country' => $self->ship_country,
746 $self->ut_phonen('ship_daytime', $self->ship_country)
747 || $self->ut_phonen('ship_night', $self->ship_country)
748 || $self->ut_phonen('ship_fax', $self->ship_country)
749 || $self->ut_zip('ship_zip', $self->ship_country)
751 return $error if $error;
753 } else { # ship_ info eq billing info, so don't store dup info in database
754 $self->setfield("ship_$_", '')
755 foreach qw( last first company address1 address2 city county state zip
756 country daytime night fax );
760 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
761 or return "Illegal payby: ". $self->payby;
764 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
766 my $payinfo = $self->payinfo;
768 $payinfo =~ /^(\d{13,16})$/
769 or return gettext('invalid_card'); # . ": ". $self->payinfo;
771 $self->payinfo($payinfo);
773 or return gettext('invalid_card'); # . ": ". $self->payinfo;
774 return gettext('unknown_card_type')
775 if cardtype($self->payinfo) eq "Unknown";
777 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
779 my $payinfo = $self->payinfo;
780 $payinfo =~ s/[^\d\@]//g;
781 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
783 $self->payinfo($payinfo);
785 } elsif ( $self->payby eq 'LECB' ) {
787 my $payinfo = $self->payinfo;
789 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
791 $self->payinfo($payinfo);
793 } elsif ( $self->payby eq 'BILL' ) {
795 $error = $self->ut_textn('payinfo');
796 return "Illegal P.O. number: ". $self->payinfo if $error;
798 } elsif ( $self->payby eq 'COMP' ) {
800 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
801 return "You are not permitted to create complimentary accounts."
802 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
805 $error = $self->ut_textn('payinfo');
806 return "Illegal comp account issuer: ". $self->payinfo if $error;
808 } elsif ( $self->payby eq 'PREPAY' ) {
810 my $payinfo = $self->payinfo;
811 $payinfo =~ s/\W//g; #anything else would just confuse things
812 $self->payinfo($payinfo);
813 $error = $self->ut_alpha('payinfo');
814 return "Illegal prepayment identifier: ". $self->payinfo if $error;
815 return "Unknown prepayment identifier"
816 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
820 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
821 return "Expriation date required"
822 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
826 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
827 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
828 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
829 ( $m, $y ) = ( $3, "20$2" );
831 return "Illegal expiration date: ". $self->paydate;
833 $self->paydate("$y-$m-01");
834 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
835 return gettext('expired_card')
836 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
839 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
840 ( ! $conf->exists('require_cardname')
841 || $self->payby !~ /^(CARD|DCRD)$/ )
843 $self->payname( $self->first. " ". $self->getfield('last') );
845 $self->payname =~ /^([\w \,\.\-\']+)$/
846 or return gettext('illegal_name'). " payname: ". $self->payname;
850 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
853 $self->otaker(getotaker);
855 #warn "AFTER: \n". $self->_dump;
862 Returns all packages (see L<FS::cust_pkg>) for this customer.
868 if ( $self->{'_pkgnum'} ) {
869 values %{ $self->{'_pkgnum'}->cache };
871 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
875 =item ncancelled_pkgs
877 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
881 sub ncancelled_pkgs {
883 if ( $self->{'_pkgnum'} ) {
884 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
886 @{ [ # force list context
887 qsearch( 'cust_pkg', {
888 'custnum' => $self->custnum,
891 qsearch( 'cust_pkg', {
892 'custnum' => $self->custnum,
901 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
907 grep { $_->susp } $self->ncancelled_pkgs;
910 =item unflagged_suspended_pkgs
912 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
913 customer (thouse packages without the `manual_flag' set).
917 sub unflagged_suspended_pkgs {
919 return $self->suspended_pkgs
920 unless dbdef->table('cust_pkg')->column('manual_flag');
921 grep { ! $_->manual_flag } $self->suspended_pkgs;
924 =item unsuspended_pkgs
926 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
931 sub unsuspended_pkgs {
933 grep { ! $_->susp } $self->ncancelled_pkgs;
938 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
939 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
940 on success or a list of errors.
946 grep { $_->unsuspend } $self->suspended_pkgs;
951 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
952 Always returns a list: an empty list on success or a list of errors.
958 grep { $_->suspend } $self->unsuspended_pkgs;
961 =item cancel [ OPTION => VALUE ... ]
963 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
965 Available options are: I<quiet>
967 I<quiet> can be set true to supress email cancellation notices.
969 Always returns a list: an empty list on success or a list of errors.
975 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
980 Returns the agent (see L<FS::agent>) for this customer.
986 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
991 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
992 conjunction with the collect method.
994 Options are passed as name-value pairs.
996 Currently available options are:
998 resetup - if set true, re-charges setup fees.
1000 time - bills the customer as if it were that time. Specified as a UNIX
1001 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1002 L<Date::Parse> for conversion functions. For example:
1006 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1009 If there is an error, returns the error, otherwise returns false.
1014 my( $self, %options ) = @_;
1015 my $time = $options{'time'} || time;
1020 local $SIG{HUP} = 'IGNORE';
1021 local $SIG{INT} = 'IGNORE';
1022 local $SIG{QUIT} = 'IGNORE';
1023 local $SIG{TERM} = 'IGNORE';
1024 local $SIG{TSTP} = 'IGNORE';
1025 local $SIG{PIPE} = 'IGNORE';
1027 my $oldAutoCommit = $FS::UID::AutoCommit;
1028 local $FS::UID::AutoCommit = 0;
1031 # find the packages which are due for billing, find out how much they are
1032 # & generate invoice database.
1034 my( $total_setup, $total_recur ) = ( 0, 0 );
1035 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1036 my @cust_bill_pkg = ();
1038 #my $taxable_charged = 0;##
1043 foreach my $cust_pkg (
1044 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1047 #NO!! next if $cust_pkg->cancel;
1048 next if $cust_pkg->getfield('cancel');
1050 #? to avoid use of uninitialized value errors... ?
1051 $cust_pkg->setfield('bill', '')
1052 unless defined($cust_pkg->bill);
1054 my $part_pkg = $cust_pkg->part_pkg;
1056 #so we don't modify cust_pkg record unnecessarily
1057 my $cust_pkg_mod_flag = 0;
1058 my %hash = $cust_pkg->hash;
1059 my $old_cust_pkg = new FS::cust_pkg \%hash;
1065 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1066 my $setup_prog = $part_pkg->getfield('setup');
1067 $setup_prog =~ /^(.*)$/ or do {
1068 $dbh->rollback if $oldAutoCommit;
1069 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1073 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1075 #my $cpt = new Safe;
1076 ##$cpt->permit(); #what is necessary?
1077 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1078 #$setup = $cpt->reval($setup_prog);
1079 $setup = eval $setup_prog;
1080 unless ( defined($setup) ) {
1081 $dbh->rollback if $oldAutoCommit;
1082 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1083 "(expression $setup_prog): $@";
1085 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1086 $cust_pkg_mod_flag=1;
1092 if ( $part_pkg->getfield('freq') ne '0' &&
1093 ! $cust_pkg->getfield('susp') &&
1094 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1096 my $recur_prog = $part_pkg->getfield('recur');
1097 $recur_prog =~ /^(.*)$/ or do {
1098 $dbh->rollback if $oldAutoCommit;
1099 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1103 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1105 # shared with $recur_prog
1106 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1108 #my $cpt = new Safe;
1109 ##$cpt->permit(); #what is necessary?
1110 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1111 #$recur = $cpt->reval($recur_prog);
1112 $recur = eval $recur_prog;
1113 unless ( defined($recur) ) {
1114 $dbh->rollback if $oldAutoCommit;
1115 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1116 "(expression $recur_prog): $@";
1118 #change this bit to use Date::Manip? CAREFUL with timezones (see
1119 # mailing list archive)
1120 my ($sec,$min,$hour,$mday,$mon,$year) =
1121 (localtime($sdate) )[0,1,2,3,4,5];
1123 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1124 # only for figuring next bill date, nothing else, so, reset $sdate again
1126 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1127 $cust_pkg->last_bill($sdate)
1128 if $cust_pkg->dbdef_table->column('last_bill');
1130 if ( $part_pkg->freq =~ /^\d+$/ ) {
1131 $mon += $part_pkg->freq;
1132 until ( $mon < 12 ) { $mon -= 12; $year++; }
1133 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1135 $mday += $weeks * 7;
1136 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1140 $dbh->rollback if $oldAutoCommit;
1141 return "unparsable frequency: ". $part_pkg->freq;
1143 $cust_pkg->setfield('bill',
1144 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1145 $cust_pkg_mod_flag = 1;
1148 warn "\$setup is undefined" unless defined($setup);
1149 warn "\$recur is undefined" unless defined($recur);
1150 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1152 if ( $cust_pkg_mod_flag ) {
1153 $error=$cust_pkg->replace($old_cust_pkg);
1154 if ( $error ) { #just in case
1155 $dbh->rollback if $oldAutoCommit;
1156 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1158 $setup = sprintf( "%.2f", $setup );
1159 $recur = sprintf( "%.2f", $recur );
1161 $dbh->rollback if $oldAutoCommit;
1162 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1165 $dbh->rollback if $oldAutoCommit;
1166 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1168 if ( $setup > 0 || $recur > 0 ) {
1169 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1170 'pkgnum' => $cust_pkg->pkgnum,
1174 'edate' => $cust_pkg->bill,
1175 'details' => \@details,
1177 push @cust_bill_pkg, $cust_bill_pkg;
1178 $total_setup += $setup;
1179 $total_recur += $recur;
1181 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1183 my @taxes = qsearch( 'cust_main_county', {
1184 'state' => $self->state,
1185 'county' => $self->county,
1186 'country' => $self->country,
1187 'taxclass' => $part_pkg->taxclass,
1190 @taxes = qsearch( 'cust_main_county', {
1191 'state' => $self->state,
1192 'county' => $self->county,
1193 'country' => $self->country,
1198 # maybe eliminate this entirely, along with all the 0% records
1200 $dbh->rollback if $oldAutoCommit;
1202 "fatal: can't find tax rate for state/county/country/taxclass ".
1203 join('/', ( map $self->$_(), qw(state county country) ),
1204 $part_pkg->taxclass ). "\n";
1207 foreach my $tax ( @taxes ) {
1209 my $taxable_charged = 0;
1210 $taxable_charged += $setup
1211 unless $part_pkg->setuptax =~ /^Y$/i
1212 || $tax->setuptax =~ /^Y$/i;
1213 $taxable_charged += $recur
1214 unless $part_pkg->recurtax =~ /^Y$/i
1215 || $tax->recurtax =~ /^Y$/i;
1216 next unless $taxable_charged;
1218 if ( $tax->exempt_amount > 0 ) {
1219 my ($mon,$year) = (localtime($sdate) )[4,5];
1221 my $freq = $part_pkg->freq || 1;
1222 if ( $freq !~ /(\d+)$/ ) {
1223 $dbh->rollback if $oldAutoCommit;
1224 return "daily/weekly package definitions not (yet?)".
1225 " compatible with monthly tax exemptions";
1227 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1228 foreach my $which_month ( 1 .. $freq ) {
1230 'custnum' => $self->custnum,
1231 'taxnum' => $tax->taxnum,
1232 'year' => 1900+$year,
1235 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1236 until ( $mon < 13 ) { $mon -= 12; $year++; }
1237 my $cust_tax_exempt =
1238 qsearchs('cust_tax_exempt', \%hash)
1239 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1240 my $remaining_exemption = sprintf("%.2f",
1241 $tax->exempt_amount - $cust_tax_exempt->amount );
1242 if ( $remaining_exemption > 0 ) {
1243 my $addl = $remaining_exemption > $taxable_per_month
1244 ? $taxable_per_month
1245 : $remaining_exemption;
1246 $taxable_charged -= $addl;
1247 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1248 $cust_tax_exempt->hash,
1250 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1252 $error = $new_cust_tax_exempt->exemptnum
1253 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1254 : $new_cust_tax_exempt->insert;
1256 $dbh->rollback if $oldAutoCommit;
1257 return "fatal: can't update cust_tax_exempt: $error";
1260 } # if $remaining_exemption > 0
1262 } #foreach $which_month
1264 } #if $tax->exempt_amount
1266 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1268 #$tax += $taxable_charged * $cust_main_county->tax / 100
1269 $tax{ $tax->taxname || 'Tax' } +=
1270 $taxable_charged * $tax->tax / 100
1272 } #foreach my $tax ( @taxes )
1274 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1276 } #if $setup > 0 || $recur > 0
1278 } #if $cust_pkg_mod_flag
1280 } #foreach my $cust_pkg
1282 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1283 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1285 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1286 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1290 # unless ( $self->tax =~ /Y/i
1291 # || $self->payby eq 'COMP'
1292 # || $taxable_charged == 0 ) {
1293 # my $cust_main_county = qsearchs('cust_main_county',{
1294 # 'state' => $self->state,
1295 # 'county' => $self->county,
1296 # 'country' => $self->country,
1297 # } ) or die "fatal: can't find tax rate for state/county/country ".
1298 # $self->state. "/". $self->county. "/". $self->country. "\n";
1299 # my $tax = sprintf( "%.2f",
1300 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1303 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1305 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1306 my $tax = sprintf("%.2f", $tax{$taxname} );
1307 $charged = sprintf( "%.2f", $charged+$tax );
1309 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1315 'itemdesc' => $taxname,
1317 push @cust_bill_pkg, $cust_bill_pkg;
1320 } else { #1.4 schema
1323 foreach ( values %tax ) { $tax += $_ };
1324 $tax = sprintf("%.2f", $tax);
1326 $charged = sprintf( "%.2f", $charged+$tax );
1328 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1335 push @cust_bill_pkg, $cust_bill_pkg;
1340 my $cust_bill = new FS::cust_bill ( {
1341 'custnum' => $self->custnum,
1343 'charged' => $charged,
1345 $error = $cust_bill->insert;
1347 $dbh->rollback if $oldAutoCommit;
1348 return "can't create invoice for customer #". $self->custnum. ": $error";
1351 my $invnum = $cust_bill->invnum;
1353 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1355 $cust_bill_pkg->invnum($invnum);
1356 $error = $cust_bill_pkg->insert;
1358 $dbh->rollback if $oldAutoCommit;
1359 return "can't create invoice line item for customer #". $self->custnum.
1364 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1368 =item collect OPTIONS
1370 (Attempt to) collect money for this customer's outstanding invoices (see
1371 L<FS::cust_bill>). Usually used after the bill method.
1373 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1374 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1375 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1377 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1378 and the invoice events web interface.
1380 If there is an error, returns the error, otherwise returns false.
1382 Options are passed as name-value pairs.
1384 Currently available options are:
1386 invoice_time - Use this time when deciding when to print invoices and
1387 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>
1388 for conversion functions.
1390 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1393 retry_card - Deprecated alias for 'retry'
1395 batch_card - This option is deprecated. See the invoice events web interface
1396 to control whether cards are batched or run against a realtime gateway.
1398 report_badcard - This option is deprecated.
1400 force_print - This option is deprecated; see the invoice events web interface.
1402 quiet - set true to surpress email card/ACH decline notices.
1407 my( $self, %options ) = @_;
1408 my $invoice_time = $options{'invoice_time'} || time;
1411 local $SIG{HUP} = 'IGNORE';
1412 local $SIG{INT} = 'IGNORE';
1413 local $SIG{QUIT} = 'IGNORE';
1414 local $SIG{TERM} = 'IGNORE';
1415 local $SIG{TSTP} = 'IGNORE';
1416 local $SIG{PIPE} = 'IGNORE';
1418 my $oldAutoCommit = $FS::UID::AutoCommit;
1419 local $FS::UID::AutoCommit = 0;
1422 my $balance = $self->balance;
1423 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1424 unless ( $balance > 0 ) { #redundant?????
1425 $dbh->rollback if $oldAutoCommit; #hmm
1429 if ( exists($options{'retry_card'}) ) {
1430 carp 'retry_card option passed to collect is deprecated; use retry';
1431 $options{'retry'} ||= $options{'retry_card'};
1433 if ( exists($options{'retry'}) && $options{'retry'} ) {
1434 my $error = $self->retry_realtime;
1436 $dbh->rollback if $oldAutoCommit;
1441 foreach my $cust_bill ( $self->cust_bill ) {
1443 #this has to be before next's
1444 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1448 $balance = sprintf( "%.2f", $balance - $amount );
1450 next unless $cust_bill->owed > 0;
1452 # don't try to charge for the same invoice if it's already in a batch
1453 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1455 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1457 next unless $amount > 0;
1460 foreach my $part_bill_event (
1461 sort { $a->seconds <=> $b->seconds
1462 || $a->weight <=> $b->weight
1463 || $a->eventpart <=> $b->eventpart }
1464 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1465 && ! qsearchs( 'cust_bill_event', {
1466 'invnum' => $cust_bill->invnum,
1467 'eventpart' => $_->eventpart,
1471 qsearch('part_bill_event', { 'payby' => $self->payby,
1472 'disabled' => '', } )
1475 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1477 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1479 my $cust_main = $self; #for callback
1483 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1484 $error = eval $part_bill_event->eventcode;
1488 my $statustext = '';
1492 } elsif ( $error ) {
1494 $statustext = $error;
1499 #add cust_bill_event
1500 my $cust_bill_event = new FS::cust_bill_event {
1501 'invnum' => $cust_bill->invnum,
1502 'eventpart' => $part_bill_event->eventpart,
1503 #'_date' => $invoice_time,
1505 'status' => $status,
1506 'statustext' => $statustext,
1508 $error = $cust_bill_event->insert;
1510 #$dbh->rollback if $oldAutoCommit;
1511 #return "error: $error";
1513 # gah, even with transactions.
1514 $dbh->commit if $oldAutoCommit; #well.
1515 my $e = 'WARNING: Event run but database not updated - '.
1516 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1517 ', eventpart '. $part_bill_event->eventpart.
1528 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1533 =item retry_realtime
1535 Schedules realtime credit card / electronic check / LEC billing events for
1536 for retry. Useful if card information has changed or manual retry is desired.
1537 The 'collect' method must be called to actually retry the transaction.
1539 Implementation details: For each of this customer's open invoices, changes
1540 the status of the first "done" (with statustext error) realtime processing
1545 sub retry_realtime {
1548 local $SIG{HUP} = 'IGNORE';
1549 local $SIG{INT} = 'IGNORE';
1550 local $SIG{QUIT} = 'IGNORE';
1551 local $SIG{TERM} = 'IGNORE';
1552 local $SIG{TSTP} = 'IGNORE';
1553 local $SIG{PIPE} = 'IGNORE';
1555 my $oldAutoCommit = $FS::UID::AutoCommit;
1556 local $FS::UID::AutoCommit = 0;
1559 foreach my $cust_bill (
1560 grep { $_->cust_bill_event }
1561 $self->open_cust_bill
1563 my @cust_bill_event =
1564 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1566 #$_->part_bill_event->plan eq 'realtime-card'
1567 $_->part_bill_event->eventcode =~
1568 /\$cust_bill\->realtime_(card|ach|lec)/
1569 && $_->status eq 'done'
1572 $cust_bill->cust_bill_event;
1573 next unless @cust_bill_event;
1574 my $error = $cust_bill_event[0]->retry;
1576 $dbh->rollback if $oldAutoCommit;
1577 return "error scheduling invoice event for retry: $error";
1582 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1587 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1589 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1590 via a Business::OnlinePayment realtime gateway. See
1591 L<http://420.am/business-onlinepayment> for supported gateways.
1593 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1595 Available options are: I<description>, I<invnum>, I<quiet>
1597 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1598 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1599 if set, will override the value from the customer record.
1601 I<description> is a free-text field passed to the gateway. It defaults to
1602 "Internet services".
1604 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1605 specified invoice. If you don't specify an I<invnum> you might want to
1606 call the B<apply_payments> method.
1608 I<quiet> can be set true to surpress email decline notices.
1610 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1615 my( $self, $method, $amount, %options ) = @_;
1617 warn "$self $method $amount\n";
1618 warn " $_ => $options{$_}\n" foreach keys %options;
1621 $options{'description'} ||= 'Internet services';
1624 die "Real-time processing not enabled\n"
1625 unless $conf->exists('business-onlinepayment');
1626 eval "use Business::OnlinePayment";
1630 $self->set( $_ => $options{$_} )
1631 foreach grep { exists($options{$_}) }
1632 qw( payname address1 address2 city state zip payinfo paydate );
1635 my $bop_config = 'business-onlinepayment';
1636 $bop_config .= '-ach'
1637 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1638 my ( $processor, $login, $password, $action, @bop_options ) =
1639 $conf->config($bop_config);
1640 $action ||= 'normal authorization';
1641 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1645 my $address = $self->address1;
1646 $address .= ", ". $self->address2 if $self->address2;
1648 my($payname, $payfirst, $paylast);
1649 if ( $self->payname && $method ne 'ECHECK' ) {
1650 $payname = $self->payname;
1651 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1652 or return "Illegal payname $payname";
1653 ($payfirst, $paylast) = ($1, $2);
1655 $payfirst = $self->getfield('first');
1656 $paylast = $self->getfield('last');
1657 $payname = "$payfirst $paylast";
1660 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1661 if ( $conf->exists('emailinvoiceauto')
1662 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1663 push @invoicing_list, $self->all_emails;
1665 my $email = $invoicing_list[0];
1668 if ( $method eq 'CC' ) {
1669 $content{card_number} = $self->payinfo;
1670 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1671 $content{expiration} = "$2/$1";
1672 if ( qsearch('cust_pay', { 'custnum' => $self->custnum,
1674 'payinfo' => $self->payinfo, } )
1676 $content{recurring_billing} = 'YES';
1678 } elsif ( $method eq 'ECHECK' ) {
1679 my($account_number,$routing_code) = $self->payinfo;
1680 ( $content{account_number}, $content{routing_code} ) =
1681 split('@', $self->payinfo);
1682 $content{bank_name} = $self->payname;
1683 $content{account_type} = 'CHECKING';
1684 $content{account_name} = $payname;
1685 $content{customer_org} = $self->company ? 'B' : 'I';
1686 $content{customer_ssn} = $self->ss;
1687 } elsif ( $method eq 'LEC' ) {
1688 $content{phone} = $self->payinfo;
1693 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1696 new Business::OnlinePayment( $processor, @bop_options );
1697 $transaction->content(
1700 'password' => $password,
1701 'action' => $action1,
1702 'description' => $options{'description'},
1703 'amount' => $amount,
1704 'invoice_number' => $options{'invnum'},
1705 'customer_id' => $self->custnum,
1706 'last_name' => $paylast,
1707 'first_name' => $payfirst,
1709 'address' => $address,
1710 'city' => $self->city,
1711 'state' => $self->state,
1712 'zip' => $self->zip,
1713 'country' => $self->country,
1714 'referer' => 'http://cleanwhisker.420.am/',
1716 'phone' => $self->daytime || $self->night,
1719 $transaction->submit();
1721 if ( $transaction->is_success() && $action2 ) {
1722 my $auth = $transaction->authorization;
1723 my $ordernum = $transaction->can('order_number')
1724 ? $transaction->order_number
1728 new Business::OnlinePayment( $processor, @bop_options );
1735 password => $password,
1736 order_number => $ordernum,
1738 authorization => $auth,
1739 description => $options{'description'},
1742 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1743 transaction_sequence_num local_transaction_date
1744 local_transaction_time AVS_result_code )) {
1745 $capture{$field} = $transaction->$field() if $transaction->can($field);
1748 $capture->content( %capture );
1752 unless ( $capture->is_success ) {
1753 my $e = "Authorization sucessful but capture failed, custnum #".
1754 $self->custnum. ': '. $capture->result_code.
1755 ": ". $capture->error_message;
1763 if ( $transaction->is_success() ) {
1765 my %method2payby = (
1771 my $cust_pay = new FS::cust_pay ( {
1772 'custnum' => $self->custnum,
1773 'invnum' => $options{'invnum'},
1776 'payby' => $method2payby{$method},
1777 'payinfo' => $self->payinfo,
1778 'paybatch' => "$processor:". $transaction->authorization,
1780 my $error = $cust_pay->insert;
1782 # gah, even with transactions.
1783 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1784 'error applying payment, invnum #' . $self->invnum.
1785 " ($processor): $error";
1794 my $perror = "$processor error: ". $transaction->error_message;
1796 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1797 && $conf->exists('emaildecline')
1798 && grep { $_ ne 'POST' } $self->invoicing_list
1799 && ! grep { $_ eq $transaction->error_message }
1800 $conf->config('emaildecline-exclude')
1802 my @templ = $conf->config('declinetemplate');
1803 my $template = new Text::Template (
1805 SOURCE => [ map "$_\n", @templ ],
1806 ) or return "($perror) can't create template: $Text::Template::ERROR";
1807 $template->compile()
1808 or return "($perror) can't compile template: $Text::Template::ERROR";
1810 my $templ_hash = { error => $transaction->error_message };
1812 my $error = send_email(
1813 'from' => $conf->config('invoice_from'),
1814 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1815 'subject' => 'Your payment could not be processed',
1816 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1819 $perror .= " (also received error sending decline notification: $error)"
1831 Returns the total owed for this customer on all invoices
1832 (see L<FS::cust_bill/owed>).
1838 $self->total_owed_date(2145859200); #12/31/2037
1841 =item total_owed_date TIME
1843 Returns the total owed for this customer on all invoices with date earlier than
1844 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1845 see L<Time::Local> and L<Date::Parse> for conversion functions.
1849 sub total_owed_date {
1853 foreach my $cust_bill (
1854 grep { $_->_date <= $time }
1855 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1857 $total_bill += $cust_bill->owed;
1859 sprintf( "%.2f", $total_bill );
1864 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1865 to outstanding invoice balances in chronological order and returns the value
1866 of any remaining unapplied credits available for refund
1867 (see L<FS::cust_refund>).
1874 return 0 unless $self->total_credited;
1876 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1877 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1879 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1880 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1884 foreach my $cust_bill ( @invoices ) {
1887 if ( !defined($credit) || $credit->credited == 0) {
1888 $credit = pop @credits or last;
1891 if ($cust_bill->owed >= $credit->credited) {
1892 $amount=$credit->credited;
1894 $amount=$cust_bill->owed;
1897 my $cust_credit_bill = new FS::cust_credit_bill ( {
1898 'crednum' => $credit->crednum,
1899 'invnum' => $cust_bill->invnum,
1900 'amount' => $amount,
1902 my $error = $cust_credit_bill->insert;
1903 die $error if $error;
1905 redo if ($cust_bill->owed > 0);
1909 return $self->total_credited;
1912 =item apply_payments
1914 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1915 to outstanding invoice balances in chronological order.
1917 #and returns the value of any remaining unapplied payments.
1921 sub apply_payments {
1926 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1927 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1929 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1930 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1934 foreach my $cust_bill ( @invoices ) {
1937 if ( !defined($payment) || $payment->unapplied == 0 ) {
1938 $payment = pop @payments or last;
1941 if ( $cust_bill->owed >= $payment->unapplied ) {
1942 $amount = $payment->unapplied;
1944 $amount = $cust_bill->owed;
1947 my $cust_bill_pay = new FS::cust_bill_pay ( {
1948 'paynum' => $payment->paynum,
1949 'invnum' => $cust_bill->invnum,
1950 'amount' => $amount,
1952 my $error = $cust_bill_pay->insert;
1953 die $error if $error;
1955 redo if ( $cust_bill->owed > 0);
1959 return $self->total_unapplied_payments;
1962 =item total_credited
1964 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1965 customer. See L<FS::cust_credit/credited>.
1969 sub total_credited {
1971 my $total_credit = 0;
1972 foreach my $cust_credit ( qsearch('cust_credit', {
1973 'custnum' => $self->custnum,
1975 $total_credit += $cust_credit->credited;
1977 sprintf( "%.2f", $total_credit );
1980 =item total_unapplied_payments
1982 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1983 See L<FS::cust_pay/unapplied>.
1987 sub total_unapplied_payments {
1989 my $total_unapplied = 0;
1990 foreach my $cust_pay ( qsearch('cust_pay', {
1991 'custnum' => $self->custnum,
1993 $total_unapplied += $cust_pay->unapplied;
1995 sprintf( "%.2f", $total_unapplied );
2000 Returns the balance for this customer (total_owed minus total_credited
2001 minus total_unapplied_payments).
2008 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2012 =item balance_date TIME
2014 Returns the balance for this customer, only considering invoices with date
2015 earlier than TIME (total_owed_date minus total_credited minus
2016 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2017 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2026 $self->total_owed_date($time)
2027 - $self->total_credited
2028 - $self->total_unapplied_payments
2032 =item invoicing_list [ ARRAYREF ]
2034 If an arguement is given, sets these email addresses as invoice recipients
2035 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2036 (except as warnings), so use check_invoicing_list first.
2038 Returns a list of email addresses (with svcnum entries expanded).
2040 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2041 check it without disturbing anything by passing nothing.
2043 This interface may change in the future.
2047 sub invoicing_list {
2048 my( $self, $arrayref ) = @_;
2050 my @cust_main_invoice;
2051 if ( $self->custnum ) {
2052 @cust_main_invoice =
2053 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2055 @cust_main_invoice = ();
2057 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2058 #warn $cust_main_invoice->destnum;
2059 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2060 #warn $cust_main_invoice->destnum;
2061 my $error = $cust_main_invoice->delete;
2062 warn $error if $error;
2065 if ( $self->custnum ) {
2066 @cust_main_invoice =
2067 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2069 @cust_main_invoice = ();
2071 my %seen = map { $_->address => 1 } @cust_main_invoice;
2072 foreach my $address ( @{$arrayref} ) {
2073 next if exists $seen{$address} && $seen{$address};
2074 $seen{$address} = 1;
2075 my $cust_main_invoice = new FS::cust_main_invoice ( {
2076 'custnum' => $self->custnum,
2079 my $error = $cust_main_invoice->insert;
2080 warn $error if $error;
2083 if ( $self->custnum ) {
2085 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2091 =item check_invoicing_list ARRAYREF
2093 Checks these arguements as valid input for the invoicing_list method. If there
2094 is an error, returns the error, otherwise returns false.
2098 sub check_invoicing_list {
2099 my( $self, $arrayref ) = @_;
2100 foreach my $address ( @{$arrayref} ) {
2101 my $cust_main_invoice = new FS::cust_main_invoice ( {
2102 'custnum' => $self->custnum,
2105 my $error = $self->custnum
2106 ? $cust_main_invoice->check
2107 : $cust_main_invoice->checkdest
2109 return $error if $error;
2114 =item set_default_invoicing_list
2116 Sets the invoicing list to all accounts associated with this customer,
2117 overwriting any previous invoicing list.
2121 sub set_default_invoicing_list {
2123 $self->invoicing_list($self->all_emails);
2128 Returns the email addresses of all accounts provisioned for this customer.
2135 foreach my $cust_pkg ( $self->all_pkgs ) {
2136 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2138 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2139 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2141 $list{$_}=1 foreach map { $_->email } @svc_acct;
2146 =item invoicing_list_addpost
2148 Adds postal invoicing to this customer. If this customer is already configured
2149 to receive postal invoices, does nothing.
2153 sub invoicing_list_addpost {
2155 return if grep { $_ eq 'POST' } $self->invoicing_list;
2156 my @invoicing_list = $self->invoicing_list;
2157 push @invoicing_list, 'POST';
2158 $self->invoicing_list(\@invoicing_list);
2161 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2163 Returns an array of customers referred by this customer (referral_custnum set
2164 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2165 customers referred by customers referred by this customer and so on, inclusive.
2166 The default behavior is DEPTH 1 (no recursion).
2170 sub referral_cust_main {
2172 my $depth = @_ ? shift : 1;
2173 my $exclude = @_ ? shift : {};
2176 map { $exclude->{$_->custnum}++; $_; }
2177 grep { ! $exclude->{ $_->custnum } }
2178 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2182 map { $_->referral_cust_main($depth-1, $exclude) }
2189 =item referral_cust_main_ncancelled
2191 Same as referral_cust_main, except only returns customers with uncancelled
2196 sub referral_cust_main_ncancelled {
2198 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2201 =item referral_cust_pkg [ DEPTH ]
2203 Like referral_cust_main, except returns a flat list of all unsuspended (and
2204 uncancelled) packages for each customer. The number of items in this list may
2205 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2209 sub referral_cust_pkg {
2211 my $depth = @_ ? shift : 1;
2213 map { $_->unsuspended_pkgs }
2214 grep { $_->unsuspended_pkgs }
2215 $self->referral_cust_main($depth);
2218 =item credit AMOUNT, REASON
2220 Applies a credit to this customer. If there is an error, returns the error,
2221 otherwise returns false.
2226 my( $self, $amount, $reason ) = @_;
2227 my $cust_credit = new FS::cust_credit {
2228 'custnum' => $self->custnum,
2229 'amount' => $amount,
2230 'reason' => $reason,
2232 $cust_credit->insert;
2235 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2237 Creates a one-time charge for this customer. If there is an error, returns
2238 the error, otherwise returns false.
2243 my ( $self, $amount ) = ( shift, shift );
2244 my $pkg = @_ ? shift : 'One-time charge';
2245 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2246 my $taxclass = @_ ? shift : '';
2248 local $SIG{HUP} = 'IGNORE';
2249 local $SIG{INT} = 'IGNORE';
2250 local $SIG{QUIT} = 'IGNORE';
2251 local $SIG{TERM} = 'IGNORE';
2252 local $SIG{TSTP} = 'IGNORE';
2253 local $SIG{PIPE} = 'IGNORE';
2255 my $oldAutoCommit = $FS::UID::AutoCommit;
2256 local $FS::UID::AutoCommit = 0;
2259 my $part_pkg = new FS::part_pkg ( {
2261 'comment' => $comment,
2266 'taxclass' => $taxclass,
2269 my $error = $part_pkg->insert;
2271 $dbh->rollback if $oldAutoCommit;
2275 my $pkgpart = $part_pkg->pkgpart;
2276 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2277 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2278 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2279 $error = $type_pkgs->insert;
2281 $dbh->rollback if $oldAutoCommit;
2286 my $cust_pkg = new FS::cust_pkg ( {
2287 'custnum' => $self->custnum,
2288 'pkgpart' => $pkgpart,
2291 $error = $cust_pkg->insert;
2293 $dbh->rollback if $oldAutoCommit;
2297 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2304 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2310 sort { $a->_date <=> $b->_date }
2311 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2314 =item open_cust_bill
2316 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2321 sub open_cust_bill {
2323 grep { $_->owed > 0 } $self->cust_bill;
2332 =item check_and_rebuild_fuzzyfiles
2336 sub check_and_rebuild_fuzzyfiles {
2337 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2338 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2339 or &rebuild_fuzzyfiles;
2342 =item rebuild_fuzzyfiles
2346 sub rebuild_fuzzyfiles {
2348 use Fcntl qw(:flock);
2350 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2354 open(LASTLOCK,">>$dir/cust_main.last")
2355 or die "can't open $dir/cust_main.last: $!";
2356 flock(LASTLOCK,LOCK_EX)
2357 or die "can't lock $dir/cust_main.last: $!";
2359 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2361 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2362 if defined dbdef->table('cust_main')->column('ship_last');
2364 open (LASTCACHE,">$dir/cust_main.last.tmp")
2365 or die "can't open $dir/cust_main.last.tmp: $!";
2366 print LASTCACHE join("\n", @all_last), "\n";
2367 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2369 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2374 open(COMPANYLOCK,">>$dir/cust_main.company")
2375 or die "can't open $dir/cust_main.company: $!";
2376 flock(COMPANYLOCK,LOCK_EX)
2377 or die "can't lock $dir/cust_main.company: $!";
2379 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2381 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2382 if defined dbdef->table('cust_main')->column('ship_last');
2384 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2385 or die "can't open $dir/cust_main.company.tmp: $!";
2386 print COMPANYCACHE join("\n", @all_company), "\n";
2387 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2389 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2399 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2400 open(LASTCACHE,"<$dir/cust_main.last")
2401 or die "can't open $dir/cust_main.last: $!";
2402 my @array = map { chomp; $_; } <LASTCACHE>;
2412 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2413 open(COMPANYCACHE,"<$dir/cust_main.company")
2414 or die "can't open $dir/cust_main.last: $!";
2415 my @array = map { chomp; $_; } <COMPANYCACHE>;
2420 =item append_fuzzyfiles LASTNAME COMPANY
2424 sub append_fuzzyfiles {
2425 my( $last, $company ) = @_;
2427 &check_and_rebuild_fuzzyfiles;
2429 use Fcntl qw(:flock);
2431 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2435 open(LAST,">>$dir/cust_main.last")
2436 or die "can't open $dir/cust_main.last: $!";
2438 or die "can't lock $dir/cust_main.last: $!";
2440 print LAST "$last\n";
2443 or die "can't unlock $dir/cust_main.last: $!";
2449 open(COMPANY,">>$dir/cust_main.company")
2450 or die "can't open $dir/cust_main.company: $!";
2451 flock(COMPANY,LOCK_EX)
2452 or die "can't lock $dir/cust_main.company: $!";
2454 print COMPANY "$company\n";
2456 flock(COMPANY,LOCK_UN)
2457 or die "can't unlock $dir/cust_main.company: $!";
2471 #warn join('-',keys %$param);
2472 my $fh = $param->{filehandle};
2473 my $agentnum = $param->{agentnum};
2474 my $refnum = $param->{refnum};
2475 my $pkgpart = $param->{pkgpart};
2476 my @fields = @{$param->{fields}};
2478 eval "use Date::Parse;";
2480 eval "use Text::CSV_XS;";
2483 my $csv = new Text::CSV_XS;
2490 local $SIG{HUP} = 'IGNORE';
2491 local $SIG{INT} = 'IGNORE';
2492 local $SIG{QUIT} = 'IGNORE';
2493 local $SIG{TERM} = 'IGNORE';
2494 local $SIG{TSTP} = 'IGNORE';
2495 local $SIG{PIPE} = 'IGNORE';
2497 my $oldAutoCommit = $FS::UID::AutoCommit;
2498 local $FS::UID::AutoCommit = 0;
2501 #while ( $columns = $csv->getline($fh) ) {
2503 while ( defined($line=<$fh>) ) {
2505 $csv->parse($line) or do {
2506 $dbh->rollback if $oldAutoCommit;
2507 return "can't parse: ". $csv->error_input();
2510 my @columns = $csv->fields();
2511 #warn join('-',@columns);
2514 agentnum => $agentnum,
2516 country => 'US', #default
2517 payby => 'BILL', #default
2518 paydate => '12/2037', #default
2520 my $billtime = time;
2521 my %cust_pkg = ( pkgpart => $pkgpart );
2522 foreach my $field ( @fields ) {
2523 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2524 #$cust_pkg{$1} = str2time( shift @$columns );
2525 if ( $1 eq 'setup' ) {
2526 $billtime = str2time(shift @columns);
2528 $cust_pkg{$1} = str2time( shift @columns );
2531 #$cust_main{$field} = shift @$columns;
2532 $cust_main{$field} = shift @columns;
2536 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2537 my $cust_main = new FS::cust_main ( \%cust_main );
2539 tie my %hash, 'Tie::RefHash'; #this part is important
2540 $hash{$cust_pkg} = [] if $pkgpart;
2541 my $error = $cust_main->insert( \%hash );
2544 $dbh->rollback if $oldAutoCommit;
2545 return "can't insert customer for $line: $error";
2548 #false laziness w/bill.cgi
2549 $error = $cust_main->bill( 'time' => $billtime );
2551 $dbh->rollback if $oldAutoCommit;
2552 return "can't bill customer for $line: $error";
2555 $cust_main->apply_payments;
2556 $cust_main->apply_credits;
2558 $error = $cust_main->collect();
2560 $dbh->rollback if $oldAutoCommit;
2561 return "can't collect customer for $line: $error";
2567 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2569 return "Empty file!" unless $imported;
2581 #warn join('-',keys %$param);
2582 my $fh = $param->{filehandle};
2583 my @fields = @{$param->{fields}};
2585 eval "use Date::Parse;";
2587 eval "use Text::CSV_XS;";
2590 my $csv = new Text::CSV_XS;
2597 local $SIG{HUP} = 'IGNORE';
2598 local $SIG{INT} = 'IGNORE';
2599 local $SIG{QUIT} = 'IGNORE';
2600 local $SIG{TERM} = 'IGNORE';
2601 local $SIG{TSTP} = 'IGNORE';
2602 local $SIG{PIPE} = 'IGNORE';
2604 my $oldAutoCommit = $FS::UID::AutoCommit;
2605 local $FS::UID::AutoCommit = 0;
2608 #while ( $columns = $csv->getline($fh) ) {
2610 while ( defined($line=<$fh>) ) {
2612 $csv->parse($line) or do {
2613 $dbh->rollback if $oldAutoCommit;
2614 return "can't parse: ". $csv->error_input();
2617 my @columns = $csv->fields();
2618 #warn join('-',@columns);
2621 foreach my $field ( @fields ) {
2622 $row{$field} = shift @columns;
2625 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2626 unless ( $cust_main ) {
2627 $dbh->rollback if $oldAutoCommit;
2628 return "unknown custnum $row{'custnum'}";
2631 if ( $row{'amount'} > 0 ) {
2632 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2634 $dbh->rollback if $oldAutoCommit;
2638 } elsif ( $row{'amount'} < 0 ) {
2639 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2642 $dbh->rollback if $oldAutoCommit;
2652 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2654 return "Empty file!" unless $imported;
2666 The delete method should possibly take an FS::cust_main object reference
2667 instead of a scalar customer number.
2669 Bill and collect options should probably be passed as references instead of a
2672 There should probably be a configuration file with a list of allowed credit
2675 No multiple currency support (probably a larger project than just this module).
2679 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2680 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2681 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.