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)
1794 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1796 my $new = new FS::cust_main { $self->hash };
1798 my $error = $new->replace($self);
1800 warn "error removing cvv: $error\n";
1805 if ( $transaction->is_success() ) {
1807 my %method2payby = (
1813 my $cust_pay = new FS::cust_pay ( {
1814 'custnum' => $self->custnum,
1815 'invnum' => $options{'invnum'},
1818 'payby' => $method2payby{$method},
1819 'payinfo' => $self->payinfo,
1820 'paybatch' => "$processor:". $transaction->authorization,
1822 my $error = $cust_pay->insert;
1824 # gah, even with transactions.
1825 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1826 'error applying payment, invnum #' . $self->invnum.
1827 " ($processor): $error";
1836 my $perror = "$processor error: ". $transaction->error_message;
1838 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1839 && $conf->exists('emaildecline')
1840 && grep { $_ ne 'POST' } $self->invoicing_list
1841 && ! grep { $_ eq $transaction->error_message }
1842 $conf->config('emaildecline-exclude')
1844 my @templ = $conf->config('declinetemplate');
1845 my $template = new Text::Template (
1847 SOURCE => [ map "$_\n", @templ ],
1848 ) or return "($perror) can't create template: $Text::Template::ERROR";
1849 $template->compile()
1850 or return "($perror) can't compile template: $Text::Template::ERROR";
1852 my $templ_hash = { error => $transaction->error_message };
1854 my $error = send_email(
1855 'from' => $conf->config('invoice_from'),
1856 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1857 'subject' => 'Your payment could not be processed',
1858 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1861 $perror .= " (also received error sending decline notification: $error)"
1873 Returns the total owed for this customer on all invoices
1874 (see L<FS::cust_bill/owed>).
1880 $self->total_owed_date(2145859200); #12/31/2037
1883 =item total_owed_date TIME
1885 Returns the total owed for this customer on all invoices with date earlier than
1886 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1887 see L<Time::Local> and L<Date::Parse> for conversion functions.
1891 sub total_owed_date {
1895 foreach my $cust_bill (
1896 grep { $_->_date <= $time }
1897 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1899 $total_bill += $cust_bill->owed;
1901 sprintf( "%.2f", $total_bill );
1906 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1907 to outstanding invoice balances in chronological order and returns the value
1908 of any remaining unapplied credits available for refund
1909 (see L<FS::cust_refund>).
1916 return 0 unless $self->total_credited;
1918 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1919 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1921 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1922 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1926 foreach my $cust_bill ( @invoices ) {
1929 if ( !defined($credit) || $credit->credited == 0) {
1930 $credit = pop @credits or last;
1933 if ($cust_bill->owed >= $credit->credited) {
1934 $amount=$credit->credited;
1936 $amount=$cust_bill->owed;
1939 my $cust_credit_bill = new FS::cust_credit_bill ( {
1940 'crednum' => $credit->crednum,
1941 'invnum' => $cust_bill->invnum,
1942 'amount' => $amount,
1944 my $error = $cust_credit_bill->insert;
1945 die $error if $error;
1947 redo if ($cust_bill->owed > 0);
1951 return $self->total_credited;
1954 =item apply_payments
1956 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1957 to outstanding invoice balances in chronological order.
1959 #and returns the value of any remaining unapplied payments.
1963 sub apply_payments {
1968 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1969 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1971 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1972 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1976 foreach my $cust_bill ( @invoices ) {
1979 if ( !defined($payment) || $payment->unapplied == 0 ) {
1980 $payment = pop @payments or last;
1983 if ( $cust_bill->owed >= $payment->unapplied ) {
1984 $amount = $payment->unapplied;
1986 $amount = $cust_bill->owed;
1989 my $cust_bill_pay = new FS::cust_bill_pay ( {
1990 'paynum' => $payment->paynum,
1991 'invnum' => $cust_bill->invnum,
1992 'amount' => $amount,
1994 my $error = $cust_bill_pay->insert;
1995 die $error if $error;
1997 redo if ( $cust_bill->owed > 0);
2001 return $self->total_unapplied_payments;
2004 =item total_credited
2006 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2007 customer. See L<FS::cust_credit/credited>.
2011 sub total_credited {
2013 my $total_credit = 0;
2014 foreach my $cust_credit ( qsearch('cust_credit', {
2015 'custnum' => $self->custnum,
2017 $total_credit += $cust_credit->credited;
2019 sprintf( "%.2f", $total_credit );
2022 =item total_unapplied_payments
2024 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2025 See L<FS::cust_pay/unapplied>.
2029 sub total_unapplied_payments {
2031 my $total_unapplied = 0;
2032 foreach my $cust_pay ( qsearch('cust_pay', {
2033 'custnum' => $self->custnum,
2035 $total_unapplied += $cust_pay->unapplied;
2037 sprintf( "%.2f", $total_unapplied );
2042 Returns the balance for this customer (total_owed minus total_credited
2043 minus total_unapplied_payments).
2050 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2054 =item balance_date TIME
2056 Returns the balance for this customer, only considering invoices with date
2057 earlier than TIME (total_owed_date minus total_credited minus
2058 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2059 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2068 $self->total_owed_date($time)
2069 - $self->total_credited
2070 - $self->total_unapplied_payments
2074 =item invoicing_list [ ARRAYREF ]
2076 If an arguement is given, sets these email addresses as invoice recipients
2077 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2078 (except as warnings), so use check_invoicing_list first.
2080 Returns a list of email addresses (with svcnum entries expanded).
2082 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2083 check it without disturbing anything by passing nothing.
2085 This interface may change in the future.
2089 sub invoicing_list {
2090 my( $self, $arrayref ) = @_;
2092 my @cust_main_invoice;
2093 if ( $self->custnum ) {
2094 @cust_main_invoice =
2095 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2097 @cust_main_invoice = ();
2099 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2100 #warn $cust_main_invoice->destnum;
2101 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2102 #warn $cust_main_invoice->destnum;
2103 my $error = $cust_main_invoice->delete;
2104 warn $error if $error;
2107 if ( $self->custnum ) {
2108 @cust_main_invoice =
2109 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2111 @cust_main_invoice = ();
2113 my %seen = map { $_->address => 1 } @cust_main_invoice;
2114 foreach my $address ( @{$arrayref} ) {
2115 next if exists $seen{$address} && $seen{$address};
2116 $seen{$address} = 1;
2117 my $cust_main_invoice = new FS::cust_main_invoice ( {
2118 'custnum' => $self->custnum,
2121 my $error = $cust_main_invoice->insert;
2122 warn $error if $error;
2125 if ( $self->custnum ) {
2127 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2133 =item check_invoicing_list ARRAYREF
2135 Checks these arguements as valid input for the invoicing_list method. If there
2136 is an error, returns the error, otherwise returns false.
2140 sub check_invoicing_list {
2141 my( $self, $arrayref ) = @_;
2142 foreach my $address ( @{$arrayref} ) {
2143 my $cust_main_invoice = new FS::cust_main_invoice ( {
2144 'custnum' => $self->custnum,
2147 my $error = $self->custnum
2148 ? $cust_main_invoice->check
2149 : $cust_main_invoice->checkdest
2151 return $error if $error;
2156 =item set_default_invoicing_list
2158 Sets the invoicing list to all accounts associated with this customer,
2159 overwriting any previous invoicing list.
2163 sub set_default_invoicing_list {
2165 $self->invoicing_list($self->all_emails);
2170 Returns the email addresses of all accounts provisioned for this customer.
2177 foreach my $cust_pkg ( $self->all_pkgs ) {
2178 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2180 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2181 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2183 $list{$_}=1 foreach map { $_->email } @svc_acct;
2188 =item invoicing_list_addpost
2190 Adds postal invoicing to this customer. If this customer is already configured
2191 to receive postal invoices, does nothing.
2195 sub invoicing_list_addpost {
2197 return if grep { $_ eq 'POST' } $self->invoicing_list;
2198 my @invoicing_list = $self->invoicing_list;
2199 push @invoicing_list, 'POST';
2200 $self->invoicing_list(\@invoicing_list);
2203 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2205 Returns an array of customers referred by this customer (referral_custnum set
2206 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2207 customers referred by customers referred by this customer and so on, inclusive.
2208 The default behavior is DEPTH 1 (no recursion).
2212 sub referral_cust_main {
2214 my $depth = @_ ? shift : 1;
2215 my $exclude = @_ ? shift : {};
2218 map { $exclude->{$_->custnum}++; $_; }
2219 grep { ! $exclude->{ $_->custnum } }
2220 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2224 map { $_->referral_cust_main($depth-1, $exclude) }
2231 =item referral_cust_main_ncancelled
2233 Same as referral_cust_main, except only returns customers with uncancelled
2238 sub referral_cust_main_ncancelled {
2240 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2243 =item referral_cust_pkg [ DEPTH ]
2245 Like referral_cust_main, except returns a flat list of all unsuspended (and
2246 uncancelled) packages for each customer. The number of items in this list may
2247 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2251 sub referral_cust_pkg {
2253 my $depth = @_ ? shift : 1;
2255 map { $_->unsuspended_pkgs }
2256 grep { $_->unsuspended_pkgs }
2257 $self->referral_cust_main($depth);
2260 =item credit AMOUNT, REASON
2262 Applies a credit to this customer. If there is an error, returns the error,
2263 otherwise returns false.
2268 my( $self, $amount, $reason ) = @_;
2269 my $cust_credit = new FS::cust_credit {
2270 'custnum' => $self->custnum,
2271 'amount' => $amount,
2272 'reason' => $reason,
2274 $cust_credit->insert;
2277 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2279 Creates a one-time charge for this customer. If there is an error, returns
2280 the error, otherwise returns false.
2285 my ( $self, $amount ) = ( shift, shift );
2286 my $pkg = @_ ? shift : 'One-time charge';
2287 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2288 my $taxclass = @_ ? shift : '';
2290 local $SIG{HUP} = 'IGNORE';
2291 local $SIG{INT} = 'IGNORE';
2292 local $SIG{QUIT} = 'IGNORE';
2293 local $SIG{TERM} = 'IGNORE';
2294 local $SIG{TSTP} = 'IGNORE';
2295 local $SIG{PIPE} = 'IGNORE';
2297 my $oldAutoCommit = $FS::UID::AutoCommit;
2298 local $FS::UID::AutoCommit = 0;
2301 my $part_pkg = new FS::part_pkg ( {
2303 'comment' => $comment,
2308 'taxclass' => $taxclass,
2311 my $error = $part_pkg->insert;
2313 $dbh->rollback if $oldAutoCommit;
2317 my $pkgpart = $part_pkg->pkgpart;
2318 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2319 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2320 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2321 $error = $type_pkgs->insert;
2323 $dbh->rollback if $oldAutoCommit;
2328 my $cust_pkg = new FS::cust_pkg ( {
2329 'custnum' => $self->custnum,
2330 'pkgpart' => $pkgpart,
2333 $error = $cust_pkg->insert;
2335 $dbh->rollback if $oldAutoCommit;
2339 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2346 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2352 sort { $a->_date <=> $b->_date }
2353 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2356 =item open_cust_bill
2358 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2363 sub open_cust_bill {
2365 grep { $_->owed > 0 } $self->cust_bill;
2374 =item check_and_rebuild_fuzzyfiles
2378 sub check_and_rebuild_fuzzyfiles {
2379 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2380 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2381 or &rebuild_fuzzyfiles;
2384 =item rebuild_fuzzyfiles
2388 sub rebuild_fuzzyfiles {
2390 use Fcntl qw(:flock);
2392 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2396 open(LASTLOCK,">>$dir/cust_main.last")
2397 or die "can't open $dir/cust_main.last: $!";
2398 flock(LASTLOCK,LOCK_EX)
2399 or die "can't lock $dir/cust_main.last: $!";
2401 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2403 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2404 if defined dbdef->table('cust_main')->column('ship_last');
2406 open (LASTCACHE,">$dir/cust_main.last.tmp")
2407 or die "can't open $dir/cust_main.last.tmp: $!";
2408 print LASTCACHE join("\n", @all_last), "\n";
2409 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2411 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2416 open(COMPANYLOCK,">>$dir/cust_main.company")
2417 or die "can't open $dir/cust_main.company: $!";
2418 flock(COMPANYLOCK,LOCK_EX)
2419 or die "can't lock $dir/cust_main.company: $!";
2421 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2423 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2424 if defined dbdef->table('cust_main')->column('ship_last');
2426 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2427 or die "can't open $dir/cust_main.company.tmp: $!";
2428 print COMPANYCACHE join("\n", @all_company), "\n";
2429 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2431 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2441 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2442 open(LASTCACHE,"<$dir/cust_main.last")
2443 or die "can't open $dir/cust_main.last: $!";
2444 my @array = map { chomp; $_; } <LASTCACHE>;
2454 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2455 open(COMPANYCACHE,"<$dir/cust_main.company")
2456 or die "can't open $dir/cust_main.last: $!";
2457 my @array = map { chomp; $_; } <COMPANYCACHE>;
2462 =item append_fuzzyfiles LASTNAME COMPANY
2466 sub append_fuzzyfiles {
2467 my( $last, $company ) = @_;
2469 &check_and_rebuild_fuzzyfiles;
2471 use Fcntl qw(:flock);
2473 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2477 open(LAST,">>$dir/cust_main.last")
2478 or die "can't open $dir/cust_main.last: $!";
2480 or die "can't lock $dir/cust_main.last: $!";
2482 print LAST "$last\n";
2485 or die "can't unlock $dir/cust_main.last: $!";
2491 open(COMPANY,">>$dir/cust_main.company")
2492 or die "can't open $dir/cust_main.company: $!";
2493 flock(COMPANY,LOCK_EX)
2494 or die "can't lock $dir/cust_main.company: $!";
2496 print COMPANY "$company\n";
2498 flock(COMPANY,LOCK_UN)
2499 or die "can't unlock $dir/cust_main.company: $!";
2513 #warn join('-',keys %$param);
2514 my $fh = $param->{filehandle};
2515 my $agentnum = $param->{agentnum};
2516 my $refnum = $param->{refnum};
2517 my $pkgpart = $param->{pkgpart};
2518 my @fields = @{$param->{fields}};
2520 eval "use Date::Parse;";
2522 eval "use Text::CSV_XS;";
2525 my $csv = new Text::CSV_XS;
2532 local $SIG{HUP} = 'IGNORE';
2533 local $SIG{INT} = 'IGNORE';
2534 local $SIG{QUIT} = 'IGNORE';
2535 local $SIG{TERM} = 'IGNORE';
2536 local $SIG{TSTP} = 'IGNORE';
2537 local $SIG{PIPE} = 'IGNORE';
2539 my $oldAutoCommit = $FS::UID::AutoCommit;
2540 local $FS::UID::AutoCommit = 0;
2543 #while ( $columns = $csv->getline($fh) ) {
2545 while ( defined($line=<$fh>) ) {
2547 $csv->parse($line) or do {
2548 $dbh->rollback if $oldAutoCommit;
2549 return "can't parse: ". $csv->error_input();
2552 my @columns = $csv->fields();
2553 #warn join('-',@columns);
2556 agentnum => $agentnum,
2558 country => 'US', #default
2559 payby => 'BILL', #default
2560 paydate => '12/2037', #default
2562 my $billtime = time;
2563 my %cust_pkg = ( pkgpart => $pkgpart );
2564 foreach my $field ( @fields ) {
2565 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2566 #$cust_pkg{$1} = str2time( shift @$columns );
2567 if ( $1 eq 'setup' ) {
2568 $billtime = str2time(shift @columns);
2570 $cust_pkg{$1} = str2time( shift @columns );
2573 #$cust_main{$field} = shift @$columns;
2574 $cust_main{$field} = shift @columns;
2578 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2579 my $cust_main = new FS::cust_main ( \%cust_main );
2581 tie my %hash, 'Tie::RefHash'; #this part is important
2582 $hash{$cust_pkg} = [] if $pkgpart;
2583 my $error = $cust_main->insert( \%hash );
2586 $dbh->rollback if $oldAutoCommit;
2587 return "can't insert customer for $line: $error";
2590 #false laziness w/bill.cgi
2591 $error = $cust_main->bill( 'time' => $billtime );
2593 $dbh->rollback if $oldAutoCommit;
2594 return "can't bill customer for $line: $error";
2597 $cust_main->apply_payments;
2598 $cust_main->apply_credits;
2600 $error = $cust_main->collect();
2602 $dbh->rollback if $oldAutoCommit;
2603 return "can't collect customer for $line: $error";
2609 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2611 return "Empty file!" unless $imported;
2623 #warn join('-',keys %$param);
2624 my $fh = $param->{filehandle};
2625 my @fields = @{$param->{fields}};
2627 eval "use Date::Parse;";
2629 eval "use Text::CSV_XS;";
2632 my $csv = new Text::CSV_XS;
2639 local $SIG{HUP} = 'IGNORE';
2640 local $SIG{INT} = 'IGNORE';
2641 local $SIG{QUIT} = 'IGNORE';
2642 local $SIG{TERM} = 'IGNORE';
2643 local $SIG{TSTP} = 'IGNORE';
2644 local $SIG{PIPE} = 'IGNORE';
2646 my $oldAutoCommit = $FS::UID::AutoCommit;
2647 local $FS::UID::AutoCommit = 0;
2650 #while ( $columns = $csv->getline($fh) ) {
2652 while ( defined($line=<$fh>) ) {
2654 $csv->parse($line) or do {
2655 $dbh->rollback if $oldAutoCommit;
2656 return "can't parse: ". $csv->error_input();
2659 my @columns = $csv->fields();
2660 #warn join('-',@columns);
2663 foreach my $field ( @fields ) {
2664 $row{$field} = shift @columns;
2667 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2668 unless ( $cust_main ) {
2669 $dbh->rollback if $oldAutoCommit;
2670 return "unknown custnum $row{'custnum'}";
2673 if ( $row{'amount'} > 0 ) {
2674 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2676 $dbh->rollback if $oldAutoCommit;
2680 } elsif ( $row{'amount'} < 0 ) {
2681 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2684 $dbh->rollback if $oldAutoCommit;
2694 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2696 return "Empty file!" unless $imported;
2708 The delete method should possibly take an FS::cust_main object reference
2709 instead of a scalar customer number.
2711 Bill and collect options should probably be passed as references instead of a
2714 There should probably be a configuration file with a list of allowed credit
2717 No multiple currency support (probably a larger project than just this module).
2721 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2722 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2723 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.