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 paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
177 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
179 =item payname - name on card or billing name
181 =item tax - tax exempt, empty or `Y'
183 =item otaker - order taker (assigned automatically, see L<FS::UID>)
185 =item comments - comments (optional)
187 =item referral_custnum - referring customer number
197 Creates a new customer. To add the customer to the database, see L<"insert">.
199 Note that this stores the hash reference, not a distinct copy of the hash it
200 points to. You can ask the object for a copy with the I<hash> method.
204 sub table { 'cust_main'; }
206 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
208 Adds this customer to the database. If there is an error, returns the error,
209 otherwise returns false.
211 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
212 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
213 are inserted atomicly, or the transaction is rolled back. Passing an empty
214 hash reference is equivalent to not supplying this parameter. There should be
215 a better explanation of this, but until then, here's an example:
218 tie %hash, 'Tie::RefHash'; #this part is important
220 $cust_pkg => [ $svc_acct ],
223 $cust_main->insert( \%hash );
225 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
226 be set as the invoicing list (see L<"invoicing_list">). Errors return as
227 expected and rollback the entire transaction; it is not necessary to call
228 check_invoicing_list first. The invoicing_list is set after the records in the
229 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
230 invoicing_list destination to the newly-created svc_acct. Here's an example:
232 $cust_main->insert( {}, [ $email, 'POST' ] );
234 Currently available options are: I<noexport>
236 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
237 (You can schedule them later with the B<reexport> method.)
243 my $cust_pkgs = @_ ? shift : {};
244 my $invoicing_list = @_ ? shift : '';
247 local $SIG{HUP} = 'IGNORE';
248 local $SIG{INT} = 'IGNORE';
249 local $SIG{QUIT} = 'IGNORE';
250 local $SIG{TERM} = 'IGNORE';
251 local $SIG{TSTP} = 'IGNORE';
252 local $SIG{PIPE} = 'IGNORE';
254 my $oldAutoCommit = $FS::UID::AutoCommit;
255 local $FS::UID::AutoCommit = 0;
260 if ( $self->payby eq 'PREPAY' ) {
261 $self->payby('BILL');
262 my $prepay_credit = qsearchs(
264 { 'identifier' => $self->payinfo },
268 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
269 unless $prepay_credit;
270 $amount = $prepay_credit->amount;
271 $seconds = $prepay_credit->seconds;
272 my $error = $prepay_credit->delete;
274 $dbh->rollback if $oldAutoCommit;
275 return "removing prepay_credit (transaction rolled back): $error";
279 my $error = $self->SUPER::insert;
281 $dbh->rollback if $oldAutoCommit;
282 #return "inserting cust_main record (transaction rolled back): $error";
287 if ( $invoicing_list ) {
288 $error = $self->check_invoicing_list( $invoicing_list );
290 $dbh->rollback if $oldAutoCommit;
291 return "checking invoicing_list (transaction rolled back): $error";
293 $self->invoicing_list( $invoicing_list );
297 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
298 $error = $self->order_pkgs($cust_pkgs, \$seconds);
300 $dbh->rollback if $oldAutoCommit;
305 $dbh->rollback if $oldAutoCommit;
306 return "No svc_acct record to apply pre-paid time";
310 my $cust_credit = new FS::cust_credit {
311 'custnum' => $self->custnum,
314 $error = $cust_credit->insert;
316 $dbh->rollback if $oldAutoCommit;
317 return "inserting credit (transaction rolled back): $error";
321 $error = $self->queue_fuzzyfiles_update;
323 $dbh->rollback if $oldAutoCommit;
324 return "updating fuzzy search cache: $error";
327 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
334 document me. like ->insert(%cust_pkg) on an existing record
340 my $cust_pkgs = shift;
343 local $SIG{HUP} = 'IGNORE';
344 local $SIG{INT} = 'IGNORE';
345 local $SIG{QUIT} = 'IGNORE';
346 local $SIG{TERM} = 'IGNORE';
347 local $SIG{TSTP} = 'IGNORE';
348 local $SIG{PIPE} = 'IGNORE';
350 my $oldAutoCommit = $FS::UID::AutoCommit;
351 local $FS::UID::AutoCommit = 0;
354 foreach my $cust_pkg ( keys %$cust_pkgs ) {
355 $cust_pkg->custnum( $self->custnum );
356 my $error = $cust_pkg->insert;
358 $dbh->rollback if $oldAutoCommit;
359 return "inserting cust_pkg (transaction rolled back): $error";
361 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
362 $svc_something->pkgnum( $cust_pkg->pkgnum );
363 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
364 $svc_something->seconds( $svc_something->seconds + $$seconds );
367 $error = $svc_something->insert;
369 $dbh->rollback if $oldAutoCommit;
370 #return "inserting svc_ (transaction rolled back): $error";
376 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
382 document me. Re-schedules all exports by calling the B<reexport> method
383 of all associated packages (see L<FS::cust_pkg>). If there is an error,
384 returns the error; otherwise returns false.
391 local $SIG{HUP} = 'IGNORE';
392 local $SIG{INT} = 'IGNORE';
393 local $SIG{QUIT} = 'IGNORE';
394 local $SIG{TERM} = 'IGNORE';
395 local $SIG{TSTP} = 'IGNORE';
396 local $SIG{PIPE} = 'IGNORE';
398 my $oldAutoCommit = $FS::UID::AutoCommit;
399 local $FS::UID::AutoCommit = 0;
402 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
403 my $error = $cust_pkg->reexport;
405 $dbh->rollback if $oldAutoCommit;
410 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
415 =item delete NEW_CUSTNUM
417 This deletes the customer. If there is an error, returns the error, otherwise
420 This will completely remove all traces of the customer record. This is not
421 what you want when a customer cancels service; for that, cancel all of the
422 customer's packages (see L</cancel>).
424 If the customer has any uncancelled packages, you need to pass a new (valid)
425 customer number for those packages to be transferred to. Cancelled packages
426 will be deleted. Did I mention that this is NOT what you want when a customer
427 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
429 You can't delete a customer with invoices (see L<FS::cust_bill>),
430 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
431 refunds (see L<FS::cust_refund>).
438 local $SIG{HUP} = 'IGNORE';
439 local $SIG{INT} = 'IGNORE';
440 local $SIG{QUIT} = 'IGNORE';
441 local $SIG{TERM} = 'IGNORE';
442 local $SIG{TSTP} = 'IGNORE';
443 local $SIG{PIPE} = 'IGNORE';
445 my $oldAutoCommit = $FS::UID::AutoCommit;
446 local $FS::UID::AutoCommit = 0;
449 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
450 $dbh->rollback if $oldAutoCommit;
451 return "Can't delete a customer with invoices";
453 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
454 $dbh->rollback if $oldAutoCommit;
455 return "Can't delete a customer with credits";
457 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
458 $dbh->rollback if $oldAutoCommit;
459 return "Can't delete a customer with payments";
461 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
462 $dbh->rollback if $oldAutoCommit;
463 return "Can't delete a customer with refunds";
466 my @cust_pkg = $self->ncancelled_pkgs;
468 my $new_custnum = shift;
469 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
470 $dbh->rollback if $oldAutoCommit;
471 return "Invalid new customer number: $new_custnum";
473 foreach my $cust_pkg ( @cust_pkg ) {
474 my %hash = $cust_pkg->hash;
475 $hash{'custnum'} = $new_custnum;
476 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
477 my $error = $new_cust_pkg->replace($cust_pkg);
479 $dbh->rollback if $oldAutoCommit;
484 my @cancelled_cust_pkg = $self->all_pkgs;
485 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
486 my $error = $cust_pkg->delete;
488 $dbh->rollback if $oldAutoCommit;
493 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
494 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
496 my $error = $cust_main_invoice->delete;
498 $dbh->rollback if $oldAutoCommit;
503 my $error = $self->SUPER::delete;
505 $dbh->rollback if $oldAutoCommit;
509 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
514 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
516 Replaces the OLD_RECORD with this one in the database. If there is an error,
517 returns the error, otherwise returns false.
519 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
520 be set as the invoicing list (see L<"invoicing_list">). Errors return as
521 expected and rollback the entire transaction; it is not necessary to call
522 check_invoicing_list first. Here's an example:
524 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
533 local $SIG{HUP} = 'IGNORE';
534 local $SIG{INT} = 'IGNORE';
535 local $SIG{QUIT} = 'IGNORE';
536 local $SIG{TERM} = 'IGNORE';
537 local $SIG{TSTP} = 'IGNORE';
538 local $SIG{PIPE} = 'IGNORE';
540 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
541 && $conf->config('users-allow_comp') ) {
542 return "You are not permitted to create complimentary accounts."
543 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
546 my $oldAutoCommit = $FS::UID::AutoCommit;
547 local $FS::UID::AutoCommit = 0;
550 my $error = $self->SUPER::replace($old);
553 $dbh->rollback if $oldAutoCommit;
557 if ( @param ) { # INVOICING_LIST_ARYREF
558 my $invoicing_list = shift @param;
559 $error = $self->check_invoicing_list( $invoicing_list );
561 $dbh->rollback if $oldAutoCommit;
564 $self->invoicing_list( $invoicing_list );
567 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
568 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
569 # card/check/lec info has changed, want to retry realtime_ invoice events
570 my $error = $self->retry_realtime;
572 $dbh->rollback if $oldAutoCommit;
577 $error = $self->queue_fuzzyfiles_update;
579 $dbh->rollback if $oldAutoCommit;
580 return "updating fuzzy search cache: $error";
583 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
588 =item queue_fuzzyfiles_update
590 Used by insert & replace to update the fuzzy search cache
594 sub queue_fuzzyfiles_update {
597 local $SIG{HUP} = 'IGNORE';
598 local $SIG{INT} = 'IGNORE';
599 local $SIG{QUIT} = 'IGNORE';
600 local $SIG{TERM} = 'IGNORE';
601 local $SIG{TSTP} = 'IGNORE';
602 local $SIG{PIPE} = 'IGNORE';
604 my $oldAutoCommit = $FS::UID::AutoCommit;
605 local $FS::UID::AutoCommit = 0;
608 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
609 my $error = $queue->insert($self->getfield('last'), $self->company);
611 $dbh->rollback if $oldAutoCommit;
612 return "queueing job (transaction rolled back): $error";
615 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
616 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
617 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
619 $dbh->rollback if $oldAutoCommit;
620 return "queueing job (transaction rolled back): $error";
624 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
631 Checks all fields to make sure this is a valid customer record. If there is
632 an error, returns the error, otherwise returns false. Called by the insert
640 #warn "BEFORE: \n". $self->_dump;
643 $self->ut_numbern('custnum')
644 || $self->ut_number('agentnum')
645 || $self->ut_number('refnum')
646 || $self->ut_name('last')
647 || $self->ut_name('first')
648 || $self->ut_textn('company')
649 || $self->ut_text('address1')
650 || $self->ut_textn('address2')
651 || $self->ut_text('city')
652 || $self->ut_textn('county')
653 || $self->ut_textn('state')
654 || $self->ut_country('country')
655 || $self->ut_anything('comments')
656 || $self->ut_numbern('referral_custnum')
658 #barf. need message catalogs. i18n. etc.
659 $error .= "Please select an advertising source."
660 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
661 return $error if $error;
663 return "Unknown agent"
664 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
666 return "Unknown refnum"
667 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
669 return "Unknown referring custnum ". $self->referral_custnum
670 unless ! $self->referral_custnum
671 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
673 if ( $self->ss eq '' ) {
678 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
679 or return "Illegal social security number: ". $self->ss;
680 $self->ss("$1-$2-$3");
684 # bad idea to disable, causes billing to fail because of no tax rates later
685 # unless ( $import ) {
686 unless ( qsearch('cust_main_county', {
687 'country' => $self->country,
690 return "Unknown state/county/country: ".
691 $self->state. "/". $self->county. "/". $self->country
692 unless qsearch('cust_main_county',{
693 'state' => $self->state,
694 'county' => $self->county,
695 'country' => $self->country,
701 $self->ut_phonen('daytime', $self->country)
702 || $self->ut_phonen('night', $self->country)
703 || $self->ut_phonen('fax', $self->country)
704 || $self->ut_zip('zip', $self->country)
706 return $error if $error;
709 last first company address1 address2 city county state zip
710 country daytime night fax
713 if ( defined $self->dbdef_table->column('ship_last') ) {
714 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
716 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
720 $self->ut_name('ship_last')
721 || $self->ut_name('ship_first')
722 || $self->ut_textn('ship_company')
723 || $self->ut_text('ship_address1')
724 || $self->ut_textn('ship_address2')
725 || $self->ut_text('ship_city')
726 || $self->ut_textn('ship_county')
727 || $self->ut_textn('ship_state')
728 || $self->ut_country('ship_country')
730 return $error if $error;
732 #false laziness with above
733 unless ( qsearchs('cust_main_county', {
734 'country' => $self->ship_country,
737 return "Unknown ship_state/ship_county/ship_country: ".
738 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
739 unless qsearchs('cust_main_county',{
740 'state' => $self->ship_state,
741 'county' => $self->ship_county,
742 'country' => $self->ship_country,
748 $self->ut_phonen('ship_daytime', $self->ship_country)
749 || $self->ut_phonen('ship_night', $self->ship_country)
750 || $self->ut_phonen('ship_fax', $self->ship_country)
751 || $self->ut_zip('ship_zip', $self->ship_country)
753 return $error if $error;
755 } else { # ship_ info eq billing info, so don't store dup info in database
756 $self->setfield("ship_$_", '')
757 foreach qw( last first company address1 address2 city county state zip
758 country daytime night fax );
762 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
763 or return "Illegal payby: ". $self->payby;
766 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
768 my $payinfo = $self->payinfo;
770 $payinfo =~ /^(\d{13,16})$/
771 or return gettext('invalid_card'); # . ": ". $self->payinfo;
773 $self->payinfo($payinfo);
775 or return gettext('invalid_card'); # . ": ". $self->payinfo;
776 return gettext('unknown_card_type')
777 if cardtype($self->payinfo) eq "Unknown";
778 if ( defined $self->dbdef_table->column('paycvv') ) {
779 if ( length($self->paycvv) ) {
780 if ( cardtype($self->payinfo) eq 'American Express card' ) {
781 $self->paycvv =~ /^(\d{4})$/
782 or return "CVV2 (CID) for American Express cards is four digits.";
785 $self->paycvv =~ /^(\d{3})$/
786 or return "CVV2 (CVC2/CID) is three digits.";
794 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
796 my $payinfo = $self->payinfo;
797 $payinfo =~ s/[^\d\@]//g;
798 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
800 $self->payinfo($payinfo);
801 $self->paycvv('') if $self->dbdef_table->column('paycvv');
803 } elsif ( $self->payby eq 'LECB' ) {
805 my $payinfo = $self->payinfo;
807 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
809 $self->payinfo($payinfo);
810 $self->paycvv('') if $self->dbdef_table->column('paycvv');
812 } elsif ( $self->payby eq 'BILL' ) {
814 $error = $self->ut_textn('payinfo');
815 return "Illegal P.O. number: ". $self->payinfo if $error;
816 $self->paycvv('') if $self->dbdef_table->column('paycvv');
818 } elsif ( $self->payby eq 'COMP' ) {
820 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
821 return "You are not permitted to create complimentary accounts."
822 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
825 $error = $self->ut_textn('payinfo');
826 return "Illegal comp account issuer: ". $self->payinfo if $error;
827 $self->paycvv('') if $self->dbdef_table->column('paycvv');
829 } elsif ( $self->payby eq 'PREPAY' ) {
831 my $payinfo = $self->payinfo;
832 $payinfo =~ s/\W//g; #anything else would just confuse things
833 $self->payinfo($payinfo);
834 $error = $self->ut_alpha('payinfo');
835 return "Illegal prepayment identifier: ". $self->payinfo if $error;
836 return "Unknown prepayment identifier"
837 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
838 $self->paycvv('') if $self->dbdef_table->column('paycvv');
842 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
843 return "Expriation date required"
844 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
848 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
849 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
850 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
851 ( $m, $y ) = ( $3, "20$2" );
853 return "Illegal expiration date: ". $self->paydate;
855 $self->paydate("$y-$m-01");
856 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
857 return gettext('expired_card')
858 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
861 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
862 ( ! $conf->exists('require_cardname')
863 || $self->payby !~ /^(CARD|DCRD)$/ )
865 $self->payname( $self->first. " ". $self->getfield('last') );
867 $self->payname =~ /^([\w \,\.\-\']+)$/
868 or return gettext('illegal_name'). " payname: ". $self->payname;
872 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
875 $self->otaker(getotaker);
877 #warn "AFTER: \n". $self->_dump;
884 Returns all packages (see L<FS::cust_pkg>) for this customer.
890 if ( $self->{'_pkgnum'} ) {
891 values %{ $self->{'_pkgnum'}->cache };
893 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
897 =item ncancelled_pkgs
899 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
903 sub ncancelled_pkgs {
905 if ( $self->{'_pkgnum'} ) {
906 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
908 @{ [ # force list context
909 qsearch( 'cust_pkg', {
910 'custnum' => $self->custnum,
913 qsearch( 'cust_pkg', {
914 'custnum' => $self->custnum,
923 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
929 grep { $_->susp } $self->ncancelled_pkgs;
932 =item unflagged_suspended_pkgs
934 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
935 customer (thouse packages without the `manual_flag' set).
939 sub unflagged_suspended_pkgs {
941 return $self->suspended_pkgs
942 unless dbdef->table('cust_pkg')->column('manual_flag');
943 grep { ! $_->manual_flag } $self->suspended_pkgs;
946 =item unsuspended_pkgs
948 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
953 sub unsuspended_pkgs {
955 grep { ! $_->susp } $self->ncancelled_pkgs;
960 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
961 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
962 on success or a list of errors.
968 grep { $_->unsuspend } $self->suspended_pkgs;
973 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
974 Always returns a list: an empty list on success or a list of errors.
980 grep { $_->suspend } $self->unsuspended_pkgs;
983 =item cancel [ OPTION => VALUE ... ]
985 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
987 Available options are: I<quiet>
989 I<quiet> can be set true to supress email cancellation notices.
991 Always returns a list: an empty list on success or a list of errors.
997 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
1002 Returns the agent (see L<FS::agent>) for this customer.
1008 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1013 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1014 conjunction with the collect method.
1016 Options are passed as name-value pairs.
1018 Currently available options are:
1020 resetup - if set true, re-charges setup fees.
1022 time - bills the customer as if it were that time. Specified as a UNIX
1023 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1024 L<Date::Parse> for conversion functions. For example:
1028 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1031 If there is an error, returns the error, otherwise returns false.
1036 my( $self, %options ) = @_;
1037 my $time = $options{'time'} || time;
1042 local $SIG{HUP} = 'IGNORE';
1043 local $SIG{INT} = 'IGNORE';
1044 local $SIG{QUIT} = 'IGNORE';
1045 local $SIG{TERM} = 'IGNORE';
1046 local $SIG{TSTP} = 'IGNORE';
1047 local $SIG{PIPE} = 'IGNORE';
1049 my $oldAutoCommit = $FS::UID::AutoCommit;
1050 local $FS::UID::AutoCommit = 0;
1053 # find the packages which are due for billing, find out how much they are
1054 # & generate invoice database.
1056 my( $total_setup, $total_recur ) = ( 0, 0 );
1057 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1058 my @cust_bill_pkg = ();
1060 #my $taxable_charged = 0;##
1065 foreach my $cust_pkg (
1066 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1069 #NO!! next if $cust_pkg->cancel;
1070 next if $cust_pkg->getfield('cancel');
1072 #? to avoid use of uninitialized value errors... ?
1073 $cust_pkg->setfield('bill', '')
1074 unless defined($cust_pkg->bill);
1076 my $part_pkg = $cust_pkg->part_pkg;
1078 #so we don't modify cust_pkg record unnecessarily
1079 my $cust_pkg_mod_flag = 0;
1080 my %hash = $cust_pkg->hash;
1081 my $old_cust_pkg = new FS::cust_pkg \%hash;
1087 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1088 my $setup_prog = $part_pkg->getfield('setup');
1089 $setup_prog =~ /^(.*)$/ or do {
1090 $dbh->rollback if $oldAutoCommit;
1091 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1095 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1097 #my $cpt = new Safe;
1098 ##$cpt->permit(); #what is necessary?
1099 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1100 #$setup = $cpt->reval($setup_prog);
1101 $setup = eval $setup_prog;
1102 unless ( defined($setup) ) {
1103 $dbh->rollback if $oldAutoCommit;
1104 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1105 "(expression $setup_prog): $@";
1107 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1108 $cust_pkg_mod_flag=1;
1114 if ( $part_pkg->getfield('freq') ne '0' &&
1115 ! $cust_pkg->getfield('susp') &&
1116 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1118 my $recur_prog = $part_pkg->getfield('recur');
1119 $recur_prog =~ /^(.*)$/ or do {
1120 $dbh->rollback if $oldAutoCommit;
1121 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1125 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1127 # shared with $recur_prog
1128 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1130 #my $cpt = new Safe;
1131 ##$cpt->permit(); #what is necessary?
1132 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1133 #$recur = $cpt->reval($recur_prog);
1134 $recur = eval $recur_prog;
1135 unless ( defined($recur) ) {
1136 $dbh->rollback if $oldAutoCommit;
1137 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1138 "(expression $recur_prog): $@";
1140 #change this bit to use Date::Manip? CAREFUL with timezones (see
1141 # mailing list archive)
1142 my ($sec,$min,$hour,$mday,$mon,$year) =
1143 (localtime($sdate) )[0,1,2,3,4,5];
1145 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1146 # only for figuring next bill date, nothing else, so, reset $sdate again
1148 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1149 $cust_pkg->last_bill($sdate)
1150 if $cust_pkg->dbdef_table->column('last_bill');
1152 if ( $part_pkg->freq =~ /^\d+$/ ) {
1153 $mon += $part_pkg->freq;
1154 until ( $mon < 12 ) { $mon -= 12; $year++; }
1155 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1157 $mday += $weeks * 7;
1158 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1162 $dbh->rollback if $oldAutoCommit;
1163 return "unparsable frequency: ". $part_pkg->freq;
1165 $cust_pkg->setfield('bill',
1166 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1167 $cust_pkg_mod_flag = 1;
1170 warn "\$setup is undefined" unless defined($setup);
1171 warn "\$recur is undefined" unless defined($recur);
1172 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1174 if ( $cust_pkg_mod_flag ) {
1175 $error=$cust_pkg->replace($old_cust_pkg);
1176 if ( $error ) { #just in case
1177 $dbh->rollback if $oldAutoCommit;
1178 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1180 $setup = sprintf( "%.2f", $setup );
1181 $recur = sprintf( "%.2f", $recur );
1183 $dbh->rollback if $oldAutoCommit;
1184 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1187 $dbh->rollback if $oldAutoCommit;
1188 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1190 if ( $setup > 0 || $recur > 0 ) {
1191 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1192 'pkgnum' => $cust_pkg->pkgnum,
1196 'edate' => $cust_pkg->bill,
1197 'details' => \@details,
1199 push @cust_bill_pkg, $cust_bill_pkg;
1200 $total_setup += $setup;
1201 $total_recur += $recur;
1203 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1205 my @taxes = qsearch( 'cust_main_county', {
1206 'state' => $self->state,
1207 'county' => $self->county,
1208 'country' => $self->country,
1209 'taxclass' => $part_pkg->taxclass,
1212 @taxes = qsearch( 'cust_main_county', {
1213 'state' => $self->state,
1214 'county' => $self->county,
1215 'country' => $self->country,
1220 # maybe eliminate this entirely, along with all the 0% records
1222 $dbh->rollback if $oldAutoCommit;
1224 "fatal: can't find tax rate for state/county/country/taxclass ".
1225 join('/', ( map $self->$_(), qw(state county country) ),
1226 $part_pkg->taxclass ). "\n";
1229 foreach my $tax ( @taxes ) {
1231 my $taxable_charged = 0;
1232 $taxable_charged += $setup
1233 unless $part_pkg->setuptax =~ /^Y$/i
1234 || $tax->setuptax =~ /^Y$/i;
1235 $taxable_charged += $recur
1236 unless $part_pkg->recurtax =~ /^Y$/i
1237 || $tax->recurtax =~ /^Y$/i;
1238 next unless $taxable_charged;
1240 if ( $tax->exempt_amount > 0 ) {
1241 my ($mon,$year) = (localtime($sdate) )[4,5];
1243 my $freq = $part_pkg->freq || 1;
1244 if ( $freq !~ /(\d+)$/ ) {
1245 $dbh->rollback if $oldAutoCommit;
1246 return "daily/weekly package definitions not (yet?)".
1247 " compatible with monthly tax exemptions";
1249 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1250 foreach my $which_month ( 1 .. $freq ) {
1252 'custnum' => $self->custnum,
1253 'taxnum' => $tax->taxnum,
1254 'year' => 1900+$year,
1257 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1258 until ( $mon < 13 ) { $mon -= 12; $year++; }
1259 my $cust_tax_exempt =
1260 qsearchs('cust_tax_exempt', \%hash)
1261 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1262 my $remaining_exemption = sprintf("%.2f",
1263 $tax->exempt_amount - $cust_tax_exempt->amount );
1264 if ( $remaining_exemption > 0 ) {
1265 my $addl = $remaining_exemption > $taxable_per_month
1266 ? $taxable_per_month
1267 : $remaining_exemption;
1268 $taxable_charged -= $addl;
1269 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1270 $cust_tax_exempt->hash,
1272 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1274 $error = $new_cust_tax_exempt->exemptnum
1275 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1276 : $new_cust_tax_exempt->insert;
1278 $dbh->rollback if $oldAutoCommit;
1279 return "fatal: can't update cust_tax_exempt: $error";
1282 } # if $remaining_exemption > 0
1284 } #foreach $which_month
1286 } #if $tax->exempt_amount
1288 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1290 #$tax += $taxable_charged * $cust_main_county->tax / 100
1291 $tax{ $tax->taxname || 'Tax' } +=
1292 $taxable_charged * $tax->tax / 100
1294 } #foreach my $tax ( @taxes )
1296 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1298 } #if $setup > 0 || $recur > 0
1300 } #if $cust_pkg_mod_flag
1302 } #foreach my $cust_pkg
1304 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1305 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1307 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1308 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1312 # unless ( $self->tax =~ /Y/i
1313 # || $self->payby eq 'COMP'
1314 # || $taxable_charged == 0 ) {
1315 # my $cust_main_county = qsearchs('cust_main_county',{
1316 # 'state' => $self->state,
1317 # 'county' => $self->county,
1318 # 'country' => $self->country,
1319 # } ) or die "fatal: can't find tax rate for state/county/country ".
1320 # $self->state. "/". $self->county. "/". $self->country. "\n";
1321 # my $tax = sprintf( "%.2f",
1322 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1325 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1327 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1328 my $tax = sprintf("%.2f", $tax{$taxname} );
1329 $charged = sprintf( "%.2f", $charged+$tax );
1331 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1337 'itemdesc' => $taxname,
1339 push @cust_bill_pkg, $cust_bill_pkg;
1342 } else { #1.4 schema
1345 foreach ( values %tax ) { $tax += $_ };
1346 $tax = sprintf("%.2f", $tax);
1348 $charged = sprintf( "%.2f", $charged+$tax );
1350 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1357 push @cust_bill_pkg, $cust_bill_pkg;
1362 my $cust_bill = new FS::cust_bill ( {
1363 'custnum' => $self->custnum,
1365 'charged' => $charged,
1367 $error = $cust_bill->insert;
1369 $dbh->rollback if $oldAutoCommit;
1370 return "can't create invoice for customer #". $self->custnum. ": $error";
1373 my $invnum = $cust_bill->invnum;
1375 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1377 $cust_bill_pkg->invnum($invnum);
1378 $error = $cust_bill_pkg->insert;
1380 $dbh->rollback if $oldAutoCommit;
1381 return "can't create invoice line item for customer #". $self->custnum.
1386 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1390 =item collect OPTIONS
1392 (Attempt to) collect money for this customer's outstanding invoices (see
1393 L<FS::cust_bill>). Usually used after the bill method.
1395 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1396 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1397 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1399 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1400 and the invoice events web interface.
1402 If there is an error, returns the error, otherwise returns false.
1404 Options are passed as name-value pairs.
1406 Currently available options are:
1408 invoice_time - Use this time when deciding when to print invoices and
1409 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>
1410 for conversion functions.
1412 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1415 retry_card - Deprecated alias for 'retry'
1417 batch_card - This option is deprecated. See the invoice events web interface
1418 to control whether cards are batched or run against a realtime gateway.
1420 report_badcard - This option is deprecated.
1422 force_print - This option is deprecated; see the invoice events web interface.
1424 quiet - set true to surpress email card/ACH decline notices.
1429 my( $self, %options ) = @_;
1430 my $invoice_time = $options{'invoice_time'} || time;
1433 local $SIG{HUP} = 'IGNORE';
1434 local $SIG{INT} = 'IGNORE';
1435 local $SIG{QUIT} = 'IGNORE';
1436 local $SIG{TERM} = 'IGNORE';
1437 local $SIG{TSTP} = 'IGNORE';
1438 local $SIG{PIPE} = 'IGNORE';
1440 my $oldAutoCommit = $FS::UID::AutoCommit;
1441 local $FS::UID::AutoCommit = 0;
1444 my $balance = $self->balance;
1445 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1446 unless ( $balance > 0 ) { #redundant?????
1447 $dbh->rollback if $oldAutoCommit; #hmm
1451 if ( exists($options{'retry_card'}) ) {
1452 carp 'retry_card option passed to collect is deprecated; use retry';
1453 $options{'retry'} ||= $options{'retry_card'};
1455 if ( exists($options{'retry'}) && $options{'retry'} ) {
1456 my $error = $self->retry_realtime;
1458 $dbh->rollback if $oldAutoCommit;
1463 foreach my $cust_bill ( $self->cust_bill ) {
1465 #this has to be before next's
1466 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1470 $balance = sprintf( "%.2f", $balance - $amount );
1472 next unless $cust_bill->owed > 0;
1474 # don't try to charge for the same invoice if it's already in a batch
1475 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1477 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1479 next unless $amount > 0;
1482 foreach my $part_bill_event (
1483 sort { $a->seconds <=> $b->seconds
1484 || $a->weight <=> $b->weight
1485 || $a->eventpart <=> $b->eventpart }
1486 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1487 && ! qsearchs( 'cust_bill_event', {
1488 'invnum' => $cust_bill->invnum,
1489 'eventpart' => $_->eventpart,
1493 qsearch('part_bill_event', { 'payby' => $self->payby,
1494 'disabled' => '', } )
1497 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1499 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1501 my $cust_main = $self; #for callback
1505 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1506 $error = eval $part_bill_event->eventcode;
1510 my $statustext = '';
1514 } elsif ( $error ) {
1516 $statustext = $error;
1521 #add cust_bill_event
1522 my $cust_bill_event = new FS::cust_bill_event {
1523 'invnum' => $cust_bill->invnum,
1524 'eventpart' => $part_bill_event->eventpart,
1525 #'_date' => $invoice_time,
1527 'status' => $status,
1528 'statustext' => $statustext,
1530 $error = $cust_bill_event->insert;
1532 #$dbh->rollback if $oldAutoCommit;
1533 #return "error: $error";
1535 # gah, even with transactions.
1536 $dbh->commit if $oldAutoCommit; #well.
1537 my $e = 'WARNING: Event run but database not updated - '.
1538 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1539 ', eventpart '. $part_bill_event->eventpart.
1550 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1555 =item retry_realtime
1557 Schedules realtime credit card / electronic check / LEC billing events for
1558 for retry. Useful if card information has changed or manual retry is desired.
1559 The 'collect' method must be called to actually retry the transaction.
1561 Implementation details: For each of this customer's open invoices, changes
1562 the status of the first "done" (with statustext error) realtime processing
1567 sub retry_realtime {
1570 local $SIG{HUP} = 'IGNORE';
1571 local $SIG{INT} = 'IGNORE';
1572 local $SIG{QUIT} = 'IGNORE';
1573 local $SIG{TERM} = 'IGNORE';
1574 local $SIG{TSTP} = 'IGNORE';
1575 local $SIG{PIPE} = 'IGNORE';
1577 my $oldAutoCommit = $FS::UID::AutoCommit;
1578 local $FS::UID::AutoCommit = 0;
1581 foreach my $cust_bill (
1582 grep { $_->cust_bill_event }
1583 $self->open_cust_bill
1585 my @cust_bill_event =
1586 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1588 #$_->part_bill_event->plan eq 'realtime-card'
1589 $_->part_bill_event->eventcode =~
1590 /\$cust_bill\->realtime_(card|ach|lec)/
1591 && $_->status eq 'done'
1594 $cust_bill->cust_bill_event;
1595 next unless @cust_bill_event;
1596 my $error = $cust_bill_event[0]->retry;
1598 $dbh->rollback if $oldAutoCommit;
1599 return "error scheduling invoice event for retry: $error";
1604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1609 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1611 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1612 via a Business::OnlinePayment realtime gateway. See
1613 L<http://420.am/business-onlinepayment> for supported gateways.
1615 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1617 Available options are: I<description>, I<invnum>, I<quiet>
1619 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1620 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1621 if set, will override the value from the customer record.
1623 I<description> is a free-text field passed to the gateway. It defaults to
1624 "Internet services".
1626 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1627 specified invoice. If you don't specify an I<invnum> you might want to
1628 call the B<apply_payments> method.
1630 I<quiet> can be set true to surpress email decline notices.
1632 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1637 my( $self, $method, $amount, %options ) = @_;
1639 warn "$self $method $amount\n";
1640 warn " $_ => $options{$_}\n" foreach keys %options;
1643 $options{'description'} ||= 'Internet services';
1646 die "Real-time processing not enabled\n"
1647 unless $conf->exists('business-onlinepayment');
1648 eval "use Business::OnlinePayment";
1652 $self->set( $_ => $options{$_} )
1653 foreach grep { exists($options{$_}) }
1654 qw( payname address1 address2 city state zip payinfo paydate );
1657 my $bop_config = 'business-onlinepayment';
1658 $bop_config .= '-ach'
1659 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1660 my ( $processor, $login, $password, $action, @bop_options ) =
1661 $conf->config($bop_config);
1662 $action ||= 'normal authorization';
1663 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1667 my $address = $self->address1;
1668 $address .= ", ". $self->address2 if $self->address2;
1670 my($payname, $payfirst, $paylast);
1671 if ( $self->payname && $method ne 'ECHECK' ) {
1672 $payname = $self->payname;
1673 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1674 or return "Illegal payname $payname";
1675 ($payfirst, $paylast) = ($1, $2);
1677 $payfirst = $self->getfield('first');
1678 $paylast = $self->getfield('last');
1679 $payname = "$payfirst $paylast";
1682 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1683 if ( $conf->exists('emailinvoiceauto')
1684 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1685 push @invoicing_list, $self->all_emails;
1687 my $email = $invoicing_list[0];
1690 if ( $method eq 'CC' ) {
1692 $content{card_number} = $self->payinfo;
1693 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1694 $content{expiration} = "$2/$1";
1696 $content{cvv2} = $self->paycvv
1697 if defined $self->dbdef_table->column('paycvv')
1698 && length($self->paycvv);
1700 $content{recurring_billing} = 'YES'
1701 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1703 'payinfo' => $self->payinfo, } );
1705 } elsif ( $method eq 'ECHECK' ) {
1706 my($account_number,$routing_code) = $self->payinfo;
1707 ( $content{account_number}, $content{routing_code} ) =
1708 split('@', $self->payinfo);
1709 $content{bank_name} = $self->payname;
1710 $content{account_type} = 'CHECKING';
1711 $content{account_name} = $payname;
1712 $content{customer_org} = $self->company ? 'B' : 'I';
1713 $content{customer_ssn} = $self->ss;
1714 } elsif ( $method eq 'LEC' ) {
1715 $content{phone} = $self->payinfo;
1720 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1723 new Business::OnlinePayment( $processor, @bop_options );
1724 $transaction->content(
1727 'password' => $password,
1728 'action' => $action1,
1729 'description' => $options{'description'},
1730 'amount' => $amount,
1731 'invoice_number' => $options{'invnum'},
1732 'customer_id' => $self->custnum,
1733 'last_name' => $paylast,
1734 'first_name' => $payfirst,
1736 'address' => $address,
1737 'city' => $self->city,
1738 'state' => $self->state,
1739 'zip' => $self->zip,
1740 'country' => $self->country,
1741 'referer' => 'http://cleanwhisker.420.am/',
1743 'phone' => $self->daytime || $self->night,
1746 $transaction->submit();
1748 if ( $transaction->is_success() && $action2 ) {
1749 my $auth = $transaction->authorization;
1750 my $ordernum = $transaction->can('order_number')
1751 ? $transaction->order_number
1755 new Business::OnlinePayment( $processor, @bop_options );
1762 password => $password,
1763 order_number => $ordernum,
1765 authorization => $auth,
1766 description => $options{'description'},
1769 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1770 transaction_sequence_num local_transaction_date
1771 local_transaction_time AVS_result_code )) {
1772 $capture{$field} = $transaction->$field() if $transaction->can($field);
1775 $capture->content( %capture );
1779 unless ( $capture->is_success ) {
1780 my $e = "Authorization sucessful but capture failed, custnum #".
1781 $self->custnum. ': '. $capture->result_code.
1782 ": ". $capture->error_message;
1789 #remove paycvv after initial transaction
1790 #make this disable-able via a config option if anyone insists?
1791 # (though that probably violates cardholder agreements)
1792 if ( defined $self->dbdef_table->column('paycvv')
1793 && length($self->paycvv)
1795 my $new = new FS::cust_main { $self->hash };
1797 my $error = $new->replace($self);
1799 warn "error removing cvv: $error\n";
1804 if ( $transaction->is_success() ) {
1806 my %method2payby = (
1812 my $cust_pay = new FS::cust_pay ( {
1813 'custnum' => $self->custnum,
1814 'invnum' => $options{'invnum'},
1817 'payby' => $method2payby{$method},
1818 'payinfo' => $self->payinfo,
1819 'paybatch' => "$processor:". $transaction->authorization,
1821 my $error = $cust_pay->insert;
1823 # gah, even with transactions.
1824 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1825 'error applying payment, invnum #' . $self->invnum.
1826 " ($processor): $error";
1835 my $perror = "$processor error: ". $transaction->error_message;
1837 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1838 && $conf->exists('emaildecline')
1839 && grep { $_ ne 'POST' } $self->invoicing_list
1840 && ! grep { $_ eq $transaction->error_message }
1841 $conf->config('emaildecline-exclude')
1843 my @templ = $conf->config('declinetemplate');
1844 my $template = new Text::Template (
1846 SOURCE => [ map "$_\n", @templ ],
1847 ) or return "($perror) can't create template: $Text::Template::ERROR";
1848 $template->compile()
1849 or return "($perror) can't compile template: $Text::Template::ERROR";
1851 my $templ_hash = { error => $transaction->error_message };
1853 my $error = send_email(
1854 'from' => $conf->config('invoice_from'),
1855 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1856 'subject' => 'Your payment could not be processed',
1857 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1860 $perror .= " (also received error sending decline notification: $error)"
1872 Returns the total owed for this customer on all invoices
1873 (see L<FS::cust_bill/owed>).
1879 $self->total_owed_date(2145859200); #12/31/2037
1882 =item total_owed_date TIME
1884 Returns the total owed for this customer on all invoices with date earlier than
1885 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1886 see L<Time::Local> and L<Date::Parse> for conversion functions.
1890 sub total_owed_date {
1894 foreach my $cust_bill (
1895 grep { $_->_date <= $time }
1896 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1898 $total_bill += $cust_bill->owed;
1900 sprintf( "%.2f", $total_bill );
1905 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1906 to outstanding invoice balances in chronological order and returns the value
1907 of any remaining unapplied credits available for refund
1908 (see L<FS::cust_refund>).
1915 return 0 unless $self->total_credited;
1917 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1918 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1920 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1921 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1925 foreach my $cust_bill ( @invoices ) {
1928 if ( !defined($credit) || $credit->credited == 0) {
1929 $credit = pop @credits or last;
1932 if ($cust_bill->owed >= $credit->credited) {
1933 $amount=$credit->credited;
1935 $amount=$cust_bill->owed;
1938 my $cust_credit_bill = new FS::cust_credit_bill ( {
1939 'crednum' => $credit->crednum,
1940 'invnum' => $cust_bill->invnum,
1941 'amount' => $amount,
1943 my $error = $cust_credit_bill->insert;
1944 die $error if $error;
1946 redo if ($cust_bill->owed > 0);
1950 return $self->total_credited;
1953 =item apply_payments
1955 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1956 to outstanding invoice balances in chronological order.
1958 #and returns the value of any remaining unapplied payments.
1962 sub apply_payments {
1967 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1968 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1970 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1971 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1975 foreach my $cust_bill ( @invoices ) {
1978 if ( !defined($payment) || $payment->unapplied == 0 ) {
1979 $payment = pop @payments or last;
1982 if ( $cust_bill->owed >= $payment->unapplied ) {
1983 $amount = $payment->unapplied;
1985 $amount = $cust_bill->owed;
1988 my $cust_bill_pay = new FS::cust_bill_pay ( {
1989 'paynum' => $payment->paynum,
1990 'invnum' => $cust_bill->invnum,
1991 'amount' => $amount,
1993 my $error = $cust_bill_pay->insert;
1994 die $error if $error;
1996 redo if ( $cust_bill->owed > 0);
2000 return $self->total_unapplied_payments;
2003 =item total_credited
2005 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2006 customer. See L<FS::cust_credit/credited>.
2010 sub total_credited {
2012 my $total_credit = 0;
2013 foreach my $cust_credit ( qsearch('cust_credit', {
2014 'custnum' => $self->custnum,
2016 $total_credit += $cust_credit->credited;
2018 sprintf( "%.2f", $total_credit );
2021 =item total_unapplied_payments
2023 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2024 See L<FS::cust_pay/unapplied>.
2028 sub total_unapplied_payments {
2030 my $total_unapplied = 0;
2031 foreach my $cust_pay ( qsearch('cust_pay', {
2032 'custnum' => $self->custnum,
2034 $total_unapplied += $cust_pay->unapplied;
2036 sprintf( "%.2f", $total_unapplied );
2041 Returns the balance for this customer (total_owed minus total_credited
2042 minus total_unapplied_payments).
2049 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2053 =item balance_date TIME
2055 Returns the balance for this customer, only considering invoices with date
2056 earlier than TIME (total_owed_date minus total_credited minus
2057 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2058 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2067 $self->total_owed_date($time)
2068 - $self->total_credited
2069 - $self->total_unapplied_payments
2073 =item invoicing_list [ ARRAYREF ]
2075 If an arguement is given, sets these email addresses as invoice recipients
2076 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2077 (except as warnings), so use check_invoicing_list first.
2079 Returns a list of email addresses (with svcnum entries expanded).
2081 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2082 check it without disturbing anything by passing nothing.
2084 This interface may change in the future.
2088 sub invoicing_list {
2089 my( $self, $arrayref ) = @_;
2091 my @cust_main_invoice;
2092 if ( $self->custnum ) {
2093 @cust_main_invoice =
2094 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2096 @cust_main_invoice = ();
2098 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2099 #warn $cust_main_invoice->destnum;
2100 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2101 #warn $cust_main_invoice->destnum;
2102 my $error = $cust_main_invoice->delete;
2103 warn $error if $error;
2106 if ( $self->custnum ) {
2107 @cust_main_invoice =
2108 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2110 @cust_main_invoice = ();
2112 my %seen = map { $_->address => 1 } @cust_main_invoice;
2113 foreach my $address ( @{$arrayref} ) {
2114 next if exists $seen{$address} && $seen{$address};
2115 $seen{$address} = 1;
2116 my $cust_main_invoice = new FS::cust_main_invoice ( {
2117 'custnum' => $self->custnum,
2120 my $error = $cust_main_invoice->insert;
2121 warn $error if $error;
2124 if ( $self->custnum ) {
2126 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2132 =item check_invoicing_list ARRAYREF
2134 Checks these arguements as valid input for the invoicing_list method. If there
2135 is an error, returns the error, otherwise returns false.
2139 sub check_invoicing_list {
2140 my( $self, $arrayref ) = @_;
2141 foreach my $address ( @{$arrayref} ) {
2142 my $cust_main_invoice = new FS::cust_main_invoice ( {
2143 'custnum' => $self->custnum,
2146 my $error = $self->custnum
2147 ? $cust_main_invoice->check
2148 : $cust_main_invoice->checkdest
2150 return $error if $error;
2155 =item set_default_invoicing_list
2157 Sets the invoicing list to all accounts associated with this customer,
2158 overwriting any previous invoicing list.
2162 sub set_default_invoicing_list {
2164 $self->invoicing_list($self->all_emails);
2169 Returns the email addresses of all accounts provisioned for this customer.
2176 foreach my $cust_pkg ( $self->all_pkgs ) {
2177 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2179 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2180 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2182 $list{$_}=1 foreach map { $_->email } @svc_acct;
2187 =item invoicing_list_addpost
2189 Adds postal invoicing to this customer. If this customer is already configured
2190 to receive postal invoices, does nothing.
2194 sub invoicing_list_addpost {
2196 return if grep { $_ eq 'POST' } $self->invoicing_list;
2197 my @invoicing_list = $self->invoicing_list;
2198 push @invoicing_list, 'POST';
2199 $self->invoicing_list(\@invoicing_list);
2202 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2204 Returns an array of customers referred by this customer (referral_custnum set
2205 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2206 customers referred by customers referred by this customer and so on, inclusive.
2207 The default behavior is DEPTH 1 (no recursion).
2211 sub referral_cust_main {
2213 my $depth = @_ ? shift : 1;
2214 my $exclude = @_ ? shift : {};
2217 map { $exclude->{$_->custnum}++; $_; }
2218 grep { ! $exclude->{ $_->custnum } }
2219 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2223 map { $_->referral_cust_main($depth-1, $exclude) }
2230 =item referral_cust_main_ncancelled
2232 Same as referral_cust_main, except only returns customers with uncancelled
2237 sub referral_cust_main_ncancelled {
2239 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2242 =item referral_cust_pkg [ DEPTH ]
2244 Like referral_cust_main, except returns a flat list of all unsuspended (and
2245 uncancelled) packages for each customer. The number of items in this list may
2246 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2250 sub referral_cust_pkg {
2252 my $depth = @_ ? shift : 1;
2254 map { $_->unsuspended_pkgs }
2255 grep { $_->unsuspended_pkgs }
2256 $self->referral_cust_main($depth);
2259 =item credit AMOUNT, REASON
2261 Applies a credit to this customer. If there is an error, returns the error,
2262 otherwise returns false.
2267 my( $self, $amount, $reason ) = @_;
2268 my $cust_credit = new FS::cust_credit {
2269 'custnum' => $self->custnum,
2270 'amount' => $amount,
2271 'reason' => $reason,
2273 $cust_credit->insert;
2276 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2278 Creates a one-time charge for this customer. If there is an error, returns
2279 the error, otherwise returns false.
2284 my ( $self, $amount ) = ( shift, shift );
2285 my $pkg = @_ ? shift : 'One-time charge';
2286 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2287 my $taxclass = @_ ? shift : '';
2289 local $SIG{HUP} = 'IGNORE';
2290 local $SIG{INT} = 'IGNORE';
2291 local $SIG{QUIT} = 'IGNORE';
2292 local $SIG{TERM} = 'IGNORE';
2293 local $SIG{TSTP} = 'IGNORE';
2294 local $SIG{PIPE} = 'IGNORE';
2296 my $oldAutoCommit = $FS::UID::AutoCommit;
2297 local $FS::UID::AutoCommit = 0;
2300 my $part_pkg = new FS::part_pkg ( {
2302 'comment' => $comment,
2307 'taxclass' => $taxclass,
2310 my $error = $part_pkg->insert;
2312 $dbh->rollback if $oldAutoCommit;
2316 my $pkgpart = $part_pkg->pkgpart;
2317 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2318 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2319 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2320 $error = $type_pkgs->insert;
2322 $dbh->rollback if $oldAutoCommit;
2327 my $cust_pkg = new FS::cust_pkg ( {
2328 'custnum' => $self->custnum,
2329 'pkgpart' => $pkgpart,
2332 $error = $cust_pkg->insert;
2334 $dbh->rollback if $oldAutoCommit;
2338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2345 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2351 sort { $a->_date <=> $b->_date }
2352 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2355 =item open_cust_bill
2357 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2362 sub open_cust_bill {
2364 grep { $_->owed > 0 } $self->cust_bill;
2373 =item check_and_rebuild_fuzzyfiles
2377 sub check_and_rebuild_fuzzyfiles {
2378 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2379 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2380 or &rebuild_fuzzyfiles;
2383 =item rebuild_fuzzyfiles
2387 sub rebuild_fuzzyfiles {
2389 use Fcntl qw(:flock);
2391 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2395 open(LASTLOCK,">>$dir/cust_main.last")
2396 or die "can't open $dir/cust_main.last: $!";
2397 flock(LASTLOCK,LOCK_EX)
2398 or die "can't lock $dir/cust_main.last: $!";
2400 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2402 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2403 if defined dbdef->table('cust_main')->column('ship_last');
2405 open (LASTCACHE,">$dir/cust_main.last.tmp")
2406 or die "can't open $dir/cust_main.last.tmp: $!";
2407 print LASTCACHE join("\n", @all_last), "\n";
2408 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2410 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2415 open(COMPANYLOCK,">>$dir/cust_main.company")
2416 or die "can't open $dir/cust_main.company: $!";
2417 flock(COMPANYLOCK,LOCK_EX)
2418 or die "can't lock $dir/cust_main.company: $!";
2420 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2422 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2423 if defined dbdef->table('cust_main')->column('ship_last');
2425 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2426 or die "can't open $dir/cust_main.company.tmp: $!";
2427 print COMPANYCACHE join("\n", @all_company), "\n";
2428 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2430 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2440 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2441 open(LASTCACHE,"<$dir/cust_main.last")
2442 or die "can't open $dir/cust_main.last: $!";
2443 my @array = map { chomp; $_; } <LASTCACHE>;
2453 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2454 open(COMPANYCACHE,"<$dir/cust_main.company")
2455 or die "can't open $dir/cust_main.last: $!";
2456 my @array = map { chomp; $_; } <COMPANYCACHE>;
2461 =item append_fuzzyfiles LASTNAME COMPANY
2465 sub append_fuzzyfiles {
2466 my( $last, $company ) = @_;
2468 &check_and_rebuild_fuzzyfiles;
2470 use Fcntl qw(:flock);
2472 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2476 open(LAST,">>$dir/cust_main.last")
2477 or die "can't open $dir/cust_main.last: $!";
2479 or die "can't lock $dir/cust_main.last: $!";
2481 print LAST "$last\n";
2484 or die "can't unlock $dir/cust_main.last: $!";
2490 open(COMPANY,">>$dir/cust_main.company")
2491 or die "can't open $dir/cust_main.company: $!";
2492 flock(COMPANY,LOCK_EX)
2493 or die "can't lock $dir/cust_main.company: $!";
2495 print COMPANY "$company\n";
2497 flock(COMPANY,LOCK_UN)
2498 or die "can't unlock $dir/cust_main.company: $!";
2512 #warn join('-',keys %$param);
2513 my $fh = $param->{filehandle};
2514 my $agentnum = $param->{agentnum};
2515 my $refnum = $param->{refnum};
2516 my $pkgpart = $param->{pkgpart};
2517 my @fields = @{$param->{fields}};
2519 eval "use Date::Parse;";
2521 eval "use Text::CSV_XS;";
2524 my $csv = new Text::CSV_XS;
2531 local $SIG{HUP} = 'IGNORE';
2532 local $SIG{INT} = 'IGNORE';
2533 local $SIG{QUIT} = 'IGNORE';
2534 local $SIG{TERM} = 'IGNORE';
2535 local $SIG{TSTP} = 'IGNORE';
2536 local $SIG{PIPE} = 'IGNORE';
2538 my $oldAutoCommit = $FS::UID::AutoCommit;
2539 local $FS::UID::AutoCommit = 0;
2542 #while ( $columns = $csv->getline($fh) ) {
2544 while ( defined($line=<$fh>) ) {
2546 $csv->parse($line) or do {
2547 $dbh->rollback if $oldAutoCommit;
2548 return "can't parse: ". $csv->error_input();
2551 my @columns = $csv->fields();
2552 #warn join('-',@columns);
2555 agentnum => $agentnum,
2557 country => 'US', #default
2558 payby => 'BILL', #default
2559 paydate => '12/2037', #default
2561 my $billtime = time;
2562 my %cust_pkg = ( pkgpart => $pkgpart );
2563 foreach my $field ( @fields ) {
2564 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2565 #$cust_pkg{$1} = str2time( shift @$columns );
2566 if ( $1 eq 'setup' ) {
2567 $billtime = str2time(shift @columns);
2569 $cust_pkg{$1} = str2time( shift @columns );
2572 #$cust_main{$field} = shift @$columns;
2573 $cust_main{$field} = shift @columns;
2577 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2578 my $cust_main = new FS::cust_main ( \%cust_main );
2580 tie my %hash, 'Tie::RefHash'; #this part is important
2581 $hash{$cust_pkg} = [] if $pkgpart;
2582 my $error = $cust_main->insert( \%hash );
2585 $dbh->rollback if $oldAutoCommit;
2586 return "can't insert customer for $line: $error";
2589 #false laziness w/bill.cgi
2590 $error = $cust_main->bill( 'time' => $billtime );
2592 $dbh->rollback if $oldAutoCommit;
2593 return "can't bill customer for $line: $error";
2596 $cust_main->apply_payments;
2597 $cust_main->apply_credits;
2599 $error = $cust_main->collect();
2601 $dbh->rollback if $oldAutoCommit;
2602 return "can't collect customer for $line: $error";
2608 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2610 return "Empty file!" unless $imported;
2622 #warn join('-',keys %$param);
2623 my $fh = $param->{filehandle};
2624 my @fields = @{$param->{fields}};
2626 eval "use Date::Parse;";
2628 eval "use Text::CSV_XS;";
2631 my $csv = new Text::CSV_XS;
2638 local $SIG{HUP} = 'IGNORE';
2639 local $SIG{INT} = 'IGNORE';
2640 local $SIG{QUIT} = 'IGNORE';
2641 local $SIG{TERM} = 'IGNORE';
2642 local $SIG{TSTP} = 'IGNORE';
2643 local $SIG{PIPE} = 'IGNORE';
2645 my $oldAutoCommit = $FS::UID::AutoCommit;
2646 local $FS::UID::AutoCommit = 0;
2649 #while ( $columns = $csv->getline($fh) ) {
2651 while ( defined($line=<$fh>) ) {
2653 $csv->parse($line) or do {
2654 $dbh->rollback if $oldAutoCommit;
2655 return "can't parse: ". $csv->error_input();
2658 my @columns = $csv->fields();
2659 #warn join('-',@columns);
2662 foreach my $field ( @fields ) {
2663 $row{$field} = shift @columns;
2666 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2667 unless ( $cust_main ) {
2668 $dbh->rollback if $oldAutoCommit;
2669 return "unknown custnum $row{'custnum'}";
2672 if ( $row{'amount'} > 0 ) {
2673 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2675 $dbh->rollback if $oldAutoCommit;
2679 } elsif ( $row{'amount'} < 0 ) {
2680 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2683 $dbh->rollback if $oldAutoCommit;
2693 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2695 return "Empty file!" unless $imported;
2707 The delete method should possibly take an FS::cust_main object reference
2708 instead of a scalar customer number.
2710 Bill and collect options should probably be passed as references instead of a
2713 There should probably be a configuration file with a list of allowed credit
2716 No multiple currency support (probably a larger project than just this module).
2720 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2721 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2722 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.