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;
26 use FS::part_referral;
27 use FS::cust_main_county;
29 use FS::cust_main_invoice;
30 use FS::cust_credit_bill;
31 use FS::cust_bill_pay;
32 use FS::prepay_credit;
35 use FS::part_bill_event;
36 use FS::cust_bill_event;
37 use FS::cust_tax_exempt;
39 use FS::Msgcat qw(gettext);
41 @ISA = qw( FS::Record );
43 $realtime_bop_decline_quiet = 0;
50 #ask FS::UID to run this stuff for us later
51 #$FS::UID::callback{'FS::cust_main'} = sub {
52 install_callback FS::UID sub {
54 #yes, need it for stuff below (prolly should be cached)
59 my ( $hashref, $cache ) = @_;
60 if ( exists $hashref->{'pkgnum'} ) {
61 # #@{ $self->{'_pkgnum'} } = ();
62 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
63 $self->{'_pkgnum'} = $subcache;
64 #push @{ $self->{'_pkgnum'} },
65 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
71 FS::cust_main - Object methods for cust_main records
77 $record = new FS::cust_main \%hash;
78 $record = new FS::cust_main { 'column' => 'value' };
80 $error = $record->insert;
82 $error = $new_record->replace($old_record);
84 $error = $record->delete;
86 $error = $record->check;
88 @cust_pkg = $record->all_pkgs;
90 @cust_pkg = $record->ncancelled_pkgs;
92 @cust_pkg = $record->suspended_pkgs;
94 $error = $record->bill;
95 $error = $record->bill %options;
96 $error = $record->bill 'time' => $time;
98 $error = $record->collect;
99 $error = $record->collect %options;
100 $error = $record->collect 'invoice_time' => $time,
101 'batch_card' => 'yes',
102 'report_badcard' => 'yes',
107 An FS::cust_main object represents a customer. FS::cust_main inherits from
108 FS::Record. The following fields are currently supported:
112 =item custnum - primary key (assigned automatically for new customers)
114 =item agentnum - agent (see L<FS::agent>)
116 =item refnum - Advertising source (see L<FS::part_referral>)
122 =item ss - social security number (optional)
124 =item company - (optional)
128 =item address2 - (optional)
132 =item county - (optional, see L<FS::cust_main_county>)
134 =item state - (see L<FS::cust_main_county>)
138 =item country - (see L<FS::cust_main_county>)
140 =item daytime - phone (optional)
142 =item night - phone (optional)
144 =item fax - phone (optional)
146 =item ship_first - name
148 =item ship_last - name
150 =item ship_company - (optional)
154 =item ship_address2 - (optional)
158 =item ship_county - (optional, see L<FS::cust_main_county>)
160 =item ship_state - (see L<FS::cust_main_county>)
164 =item ship_country - (see L<FS::cust_main_county>)
166 =item ship_daytime - phone (optional)
168 =item ship_night - phone (optional)
170 =item ship_fax - phone (optional)
172 =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>)
174 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
176 =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
178 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
180 =item payname - name on card or billing name
182 =item tax - tax exempt, empty or `Y'
184 =item otaker - order taker (assigned automatically, see L<FS::UID>)
186 =item comments - comments (optional)
188 =item referral_custnum - referring customer number
198 Creates a new customer. To add the customer to the database, see L<"insert">.
200 Note that this stores the hash reference, not a distinct copy of the hash it
201 points to. You can ask the object for a copy with the I<hash> method.
205 sub table { 'cust_main'; }
207 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
209 Adds this customer to the database. If there is an error, returns the error,
210 otherwise returns false.
212 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
213 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
214 are inserted atomicly, or the transaction is rolled back. Passing an empty
215 hash reference is equivalent to not supplying this parameter. There should be
216 a better explanation of this, but until then, here's an example:
219 tie %hash, 'Tie::RefHash'; #this part is important
221 $cust_pkg => [ $svc_acct ],
224 $cust_main->insert( \%hash );
226 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
227 be set as the invoicing list (see L<"invoicing_list">). Errors return as
228 expected and rollback the entire transaction; it is not necessary to call
229 check_invoicing_list first. The invoicing_list is set after the records in the
230 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
231 invoicing_list destination to the newly-created svc_acct. Here's an example:
233 $cust_main->insert( {}, [ $email, 'POST' ] );
235 Currently available options are: I<noexport>
237 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
238 (You can schedule them later with the B<reexport> method.)
244 my $cust_pkgs = @_ ? shift : {};
245 my $invoicing_list = @_ ? shift : '';
248 local $SIG{HUP} = 'IGNORE';
249 local $SIG{INT} = 'IGNORE';
250 local $SIG{QUIT} = 'IGNORE';
251 local $SIG{TERM} = 'IGNORE';
252 local $SIG{TSTP} = 'IGNORE';
253 local $SIG{PIPE} = 'IGNORE';
255 my $oldAutoCommit = $FS::UID::AutoCommit;
256 local $FS::UID::AutoCommit = 0;
261 if ( $self->payby eq 'PREPAY' ) {
262 $self->payby('BILL');
263 my $prepay_credit = qsearchs(
265 { 'identifier' => $self->payinfo },
269 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
270 unless $prepay_credit;
271 $amount = $prepay_credit->amount;
272 $seconds = $prepay_credit->seconds;
273 my $error = $prepay_credit->delete;
275 $dbh->rollback if $oldAutoCommit;
276 return "removing prepay_credit (transaction rolled back): $error";
280 my $error = $self->SUPER::insert;
282 $dbh->rollback if $oldAutoCommit;
283 #return "inserting cust_main record (transaction rolled back): $error";
288 if ( $invoicing_list ) {
289 $error = $self->check_invoicing_list( $invoicing_list );
291 $dbh->rollback if $oldAutoCommit;
292 return "checking invoicing_list (transaction rolled back): $error";
294 $self->invoicing_list( $invoicing_list );
298 #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
299 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
301 $dbh->rollback if $oldAutoCommit;
306 $dbh->rollback if $oldAutoCommit;
307 return "No svc_acct record to apply pre-paid time";
311 my $cust_credit = new FS::cust_credit {
312 'custnum' => $self->custnum,
315 $error = $cust_credit->insert;
317 $dbh->rollback if $oldAutoCommit;
318 return "inserting credit (transaction rolled back): $error";
322 $error = $self->queue_fuzzyfiles_update;
324 $dbh->rollback if $oldAutoCommit;
325 return "updating fuzzy search cache: $error";
328 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
333 =item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
335 Like the insert method on an existing record, this method orders a package
336 and included services atomicaly. Pass a Tie::RefHash data structure to this
337 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
338 be a better explanation of this, but until then, here's an example:
341 tie %hash, 'Tie::RefHash'; #this part is important
343 $cust_pkg => [ $svc_acct ],
346 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
348 Currently available options are: I<noexport>
350 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
351 (You can schedule them later with the B<reexport> method for each
352 cust_pkg object. Using the B<reexport> method on the cust_main object is not
353 recommended, as existing services will also be reexported.)
359 my $cust_pkgs = shift;
363 local $SIG{HUP} = 'IGNORE';
364 local $SIG{INT} = 'IGNORE';
365 local $SIG{QUIT} = 'IGNORE';
366 local $SIG{TERM} = 'IGNORE';
367 local $SIG{TSTP} = 'IGNORE';
368 local $SIG{PIPE} = 'IGNORE';
370 my $oldAutoCommit = $FS::UID::AutoCommit;
371 local $FS::UID::AutoCommit = 0;
374 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
376 foreach my $cust_pkg ( keys %$cust_pkgs ) {
377 $cust_pkg->custnum( $self->custnum );
378 my $error = $cust_pkg->insert;
380 $dbh->rollback if $oldAutoCommit;
381 return "inserting cust_pkg (transaction rolled back): $error";
383 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
384 $svc_something->pkgnum( $cust_pkg->pkgnum );
385 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
386 $svc_something->seconds( $svc_something->seconds + $$seconds );
389 $error = $svc_something->insert;
391 $dbh->rollback if $oldAutoCommit;
392 #return "inserting svc_ (transaction rolled back): $error";
398 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
404 Re-schedules all exports by calling the B<reexport> method of all associated
405 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
406 otherwise returns false.
413 local $SIG{HUP} = 'IGNORE';
414 local $SIG{INT} = 'IGNORE';
415 local $SIG{QUIT} = 'IGNORE';
416 local $SIG{TERM} = 'IGNORE';
417 local $SIG{TSTP} = 'IGNORE';
418 local $SIG{PIPE} = 'IGNORE';
420 my $oldAutoCommit = $FS::UID::AutoCommit;
421 local $FS::UID::AutoCommit = 0;
424 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
425 my $error = $cust_pkg->reexport;
427 $dbh->rollback if $oldAutoCommit;
432 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
437 =item delete NEW_CUSTNUM
439 This deletes the customer. If there is an error, returns the error, otherwise
442 This will completely remove all traces of the customer record. This is not
443 what you want when a customer cancels service; for that, cancel all of the
444 customer's packages (see L</cancel>).
446 If the customer has any uncancelled packages, you need to pass a new (valid)
447 customer number for those packages to be transferred to. Cancelled packages
448 will be deleted. Did I mention that this is NOT what you want when a customer
449 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
451 You can't delete a customer with invoices (see L<FS::cust_bill>),
452 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
453 refunds (see L<FS::cust_refund>).
460 local $SIG{HUP} = 'IGNORE';
461 local $SIG{INT} = 'IGNORE';
462 local $SIG{QUIT} = 'IGNORE';
463 local $SIG{TERM} = 'IGNORE';
464 local $SIG{TSTP} = 'IGNORE';
465 local $SIG{PIPE} = 'IGNORE';
467 my $oldAutoCommit = $FS::UID::AutoCommit;
468 local $FS::UID::AutoCommit = 0;
471 if ( $self->cust_bill ) {
472 $dbh->rollback if $oldAutoCommit;
473 return "Can't delete a customer with invoices";
475 if ( $self->cust_credit ) {
476 $dbh->rollback if $oldAutoCommit;
477 return "Can't delete a customer with credits";
479 if ( $self->cust_pay ) {
480 $dbh->rollback if $oldAutoCommit;
481 return "Can't delete a customer with payments";
483 if ( $self->cust_refund ) {
484 $dbh->rollback if $oldAutoCommit;
485 return "Can't delete a customer with refunds";
488 my @cust_pkg = $self->ncancelled_pkgs;
490 my $new_custnum = shift;
491 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
492 $dbh->rollback if $oldAutoCommit;
493 return "Invalid new customer number: $new_custnum";
495 foreach my $cust_pkg ( @cust_pkg ) {
496 my %hash = $cust_pkg->hash;
497 $hash{'custnum'} = $new_custnum;
498 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
499 my $error = $new_cust_pkg->replace($cust_pkg);
501 $dbh->rollback if $oldAutoCommit;
506 my @cancelled_cust_pkg = $self->all_pkgs;
507 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
508 my $error = $cust_pkg->delete;
510 $dbh->rollback if $oldAutoCommit;
515 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
516 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
518 my $error = $cust_main_invoice->delete;
520 $dbh->rollback if $oldAutoCommit;
525 my $error = $self->SUPER::delete;
527 $dbh->rollback if $oldAutoCommit;
531 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
536 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
538 Replaces the OLD_RECORD with this one in the database. If there is an error,
539 returns the error, otherwise returns false.
541 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
542 be set as the invoicing list (see L<"invoicing_list">). Errors return as
543 expected and rollback the entire transaction; it is not necessary to call
544 check_invoicing_list first. Here's an example:
546 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
555 local $SIG{HUP} = 'IGNORE';
556 local $SIG{INT} = 'IGNORE';
557 local $SIG{QUIT} = 'IGNORE';
558 local $SIG{TERM} = 'IGNORE';
559 local $SIG{TSTP} = 'IGNORE';
560 local $SIG{PIPE} = 'IGNORE';
562 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
563 && $conf->config('users-allow_comp') ) {
564 return "You are not permitted to create complimentary accounts."
565 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
568 my $oldAutoCommit = $FS::UID::AutoCommit;
569 local $FS::UID::AutoCommit = 0;
572 my $error = $self->SUPER::replace($old);
575 $dbh->rollback if $oldAutoCommit;
579 if ( @param ) { # INVOICING_LIST_ARYREF
580 my $invoicing_list = shift @param;
581 $error = $self->check_invoicing_list( $invoicing_list );
583 $dbh->rollback if $oldAutoCommit;
586 $self->invoicing_list( $invoicing_list );
589 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
590 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
591 # card/check/lec info has changed, want to retry realtime_ invoice events
592 my $error = $self->retry_realtime;
594 $dbh->rollback if $oldAutoCommit;
599 $error = $self->queue_fuzzyfiles_update;
601 $dbh->rollback if $oldAutoCommit;
602 return "updating fuzzy search cache: $error";
605 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
610 =item queue_fuzzyfiles_update
612 Used by insert & replace to update the fuzzy search cache
616 sub queue_fuzzyfiles_update {
619 local $SIG{HUP} = 'IGNORE';
620 local $SIG{INT} = 'IGNORE';
621 local $SIG{QUIT} = 'IGNORE';
622 local $SIG{TERM} = 'IGNORE';
623 local $SIG{TSTP} = 'IGNORE';
624 local $SIG{PIPE} = 'IGNORE';
626 my $oldAutoCommit = $FS::UID::AutoCommit;
627 local $FS::UID::AutoCommit = 0;
630 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
631 my $error = $queue->insert($self->getfield('last'), $self->company);
633 $dbh->rollback if $oldAutoCommit;
634 return "queueing job (transaction rolled back): $error";
637 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
638 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
639 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
641 $dbh->rollback if $oldAutoCommit;
642 return "queueing job (transaction rolled back): $error";
646 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
653 Checks all fields to make sure this is a valid customer record. If there is
654 an error, returns the error, otherwise returns false. Called by the insert
662 #warn "BEFORE: \n". $self->_dump;
665 $self->ut_numbern('custnum')
666 || $self->ut_number('agentnum')
667 || $self->ut_number('refnum')
668 || $self->ut_name('last')
669 || $self->ut_name('first')
670 || $self->ut_textn('company')
671 || $self->ut_text('address1')
672 || $self->ut_textn('address2')
673 || $self->ut_text('city')
674 || $self->ut_textn('county')
675 || $self->ut_textn('state')
676 || $self->ut_country('country')
677 || $self->ut_anything('comments')
678 || $self->ut_numbern('referral_custnum')
680 #barf. need message catalogs. i18n. etc.
681 $error .= "Please select an advertising source."
682 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
683 return $error if $error;
685 return "Unknown agent"
686 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
688 return "Unknown refnum"
689 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
691 return "Unknown referring custnum ". $self->referral_custnum
692 unless ! $self->referral_custnum
693 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
695 if ( $self->ss eq '' ) {
700 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
701 or return "Illegal social security number: ". $self->ss;
702 $self->ss("$1-$2-$3");
706 # bad idea to disable, causes billing to fail because of no tax rates later
707 # unless ( $import ) {
708 unless ( qsearch('cust_main_county', {
709 'country' => $self->country,
712 return "Unknown state/county/country: ".
713 $self->state. "/". $self->county. "/". $self->country
714 unless qsearch('cust_main_county',{
715 'state' => $self->state,
716 'county' => $self->county,
717 'country' => $self->country,
723 $self->ut_phonen('daytime', $self->country)
724 || $self->ut_phonen('night', $self->country)
725 || $self->ut_phonen('fax', $self->country)
726 || $self->ut_zip('zip', $self->country)
728 return $error if $error;
731 last first company address1 address2 city county state zip
732 country daytime night fax
735 if ( defined $self->dbdef_table->column('ship_last') ) {
736 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
738 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
742 $self->ut_name('ship_last')
743 || $self->ut_name('ship_first')
744 || $self->ut_textn('ship_company')
745 || $self->ut_text('ship_address1')
746 || $self->ut_textn('ship_address2')
747 || $self->ut_text('ship_city')
748 || $self->ut_textn('ship_county')
749 || $self->ut_textn('ship_state')
750 || $self->ut_country('ship_country')
752 return $error if $error;
754 #false laziness with above
755 unless ( qsearchs('cust_main_county', {
756 'country' => $self->ship_country,
759 return "Unknown ship_state/ship_county/ship_country: ".
760 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
761 unless qsearchs('cust_main_county',{
762 'state' => $self->ship_state,
763 'county' => $self->ship_county,
764 'country' => $self->ship_country,
770 $self->ut_phonen('ship_daytime', $self->ship_country)
771 || $self->ut_phonen('ship_night', $self->ship_country)
772 || $self->ut_phonen('ship_fax', $self->ship_country)
773 || $self->ut_zip('ship_zip', $self->ship_country)
775 return $error if $error;
777 } else { # ship_ info eq billing info, so don't store dup info in database
778 $self->setfield("ship_$_", '')
779 foreach qw( last first company address1 address2 city county state zip
780 country daytime night fax );
784 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
785 or return "Illegal payby: ". $self->payby;
788 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
790 my $payinfo = $self->payinfo;
792 $payinfo =~ /^(\d{13,16})$/
793 or return gettext('invalid_card'); # . ": ". $self->payinfo;
795 $self->payinfo($payinfo);
797 or return gettext('invalid_card'); # . ": ". $self->payinfo;
798 return gettext('unknown_card_type')
799 if cardtype($self->payinfo) eq "Unknown";
800 if ( defined $self->dbdef_table->column('paycvv') ) {
801 if ( length($self->paycvv) ) {
802 if ( cardtype($self->payinfo) eq 'American Express card' ) {
803 $self->paycvv =~ /^(\d{4})$/
804 or return "CVV2 (CID) for American Express cards is four digits.";
807 $self->paycvv =~ /^(\d{3})$/
808 or return "CVV2 (CVC2/CID) is three digits.";
816 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
818 my $payinfo = $self->payinfo;
819 $payinfo =~ s/[^\d\@]//g;
820 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
822 $self->payinfo($payinfo);
823 $self->paycvv('') if $self->dbdef_table->column('paycvv');
825 } elsif ( $self->payby eq 'LECB' ) {
827 my $payinfo = $self->payinfo;
829 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
831 $self->payinfo($payinfo);
832 $self->paycvv('') if $self->dbdef_table->column('paycvv');
834 } elsif ( $self->payby eq 'BILL' ) {
836 $error = $self->ut_textn('payinfo');
837 return "Illegal P.O. number: ". $self->payinfo if $error;
838 $self->paycvv('') if $self->dbdef_table->column('paycvv');
840 } elsif ( $self->payby eq 'COMP' ) {
842 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
843 return "You are not permitted to create complimentary accounts."
844 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
847 $error = $self->ut_textn('payinfo');
848 return "Illegal comp account issuer: ". $self->payinfo if $error;
849 $self->paycvv('') if $self->dbdef_table->column('paycvv');
851 } elsif ( $self->payby eq 'PREPAY' ) {
853 my $payinfo = $self->payinfo;
854 $payinfo =~ s/\W//g; #anything else would just confuse things
855 $self->payinfo($payinfo);
856 $error = $self->ut_alpha('payinfo');
857 return "Illegal prepayment identifier: ". $self->payinfo if $error;
858 return "Unknown prepayment identifier"
859 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
860 $self->paycvv('') if $self->dbdef_table->column('paycvv');
864 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
865 return "Expriation date required"
866 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
870 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
871 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
872 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
873 ( $m, $y ) = ( $3, "20$2" );
875 return "Illegal expiration date: ". $self->paydate;
877 $self->paydate("$y-$m-01");
878 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
879 return gettext('expired_card')
880 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
883 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
884 ( ! $conf->exists('require_cardname')
885 || $self->payby !~ /^(CARD|DCRD)$/ )
887 $self->payname( $self->first. " ". $self->getfield('last') );
889 $self->payname =~ /^([\w \,\.\-\']+)$/
890 or return gettext('illegal_name'). " payname: ". $self->payname;
894 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
897 $self->otaker(getotaker) unless $self->otaker;
899 #warn "AFTER: \n". $self->_dump;
906 Returns all packages (see L<FS::cust_pkg>) for this customer.
912 if ( $self->{'_pkgnum'} ) {
913 values %{ $self->{'_pkgnum'}->cache };
915 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
919 =item ncancelled_pkgs
921 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
925 sub ncancelled_pkgs {
927 if ( $self->{'_pkgnum'} ) {
928 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
930 @{ [ # force list context
931 qsearch( 'cust_pkg', {
932 'custnum' => $self->custnum,
935 qsearch( 'cust_pkg', {
936 'custnum' => $self->custnum,
945 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
951 grep { $_->susp } $self->ncancelled_pkgs;
954 =item unflagged_suspended_pkgs
956 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
957 customer (thouse packages without the `manual_flag' set).
961 sub unflagged_suspended_pkgs {
963 return $self->suspended_pkgs
964 unless dbdef->table('cust_pkg')->column('manual_flag');
965 grep { ! $_->manual_flag } $self->suspended_pkgs;
968 =item unsuspended_pkgs
970 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
975 sub unsuspended_pkgs {
977 grep { ! $_->susp } $self->ncancelled_pkgs;
982 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
983 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
984 on success or a list of errors.
990 grep { $_->unsuspend } $self->suspended_pkgs;
995 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
996 Always returns a list: an empty list on success or a list of errors.
1002 grep { $_->suspend } $self->unsuspended_pkgs;
1005 =item cancel [ OPTION => VALUE ... ]
1007 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1009 Available options are: I<quiet>
1011 I<quiet> can be set true to supress email cancellation notices.
1013 Always returns a list: an empty list on success or a list of errors.
1019 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
1024 Returns the agent (see L<FS::agent>) for this customer.
1030 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1035 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1036 conjunction with the collect method.
1038 Options are passed as name-value pairs.
1040 Currently available options are:
1042 resetup - if set true, re-charges setup fees.
1044 time - bills the customer as if it were that time. Specified as a UNIX
1045 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1046 L<Date::Parse> for conversion functions. For example:
1050 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1053 If there is an error, returns the error, otherwise returns false.
1058 my( $self, %options ) = @_;
1059 my $time = $options{'time'} || time;
1064 local $SIG{HUP} = 'IGNORE';
1065 local $SIG{INT} = 'IGNORE';
1066 local $SIG{QUIT} = 'IGNORE';
1067 local $SIG{TERM} = 'IGNORE';
1068 local $SIG{TSTP} = 'IGNORE';
1069 local $SIG{PIPE} = 'IGNORE';
1071 my $oldAutoCommit = $FS::UID::AutoCommit;
1072 local $FS::UID::AutoCommit = 0;
1075 # find the packages which are due for billing, find out how much they are
1076 # & generate invoice database.
1078 my( $total_setup, $total_recur ) = ( 0, 0 );
1079 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1080 my @cust_bill_pkg = ();
1082 #my $taxable_charged = 0;##
1087 foreach my $cust_pkg (
1088 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1091 #NO!! next if $cust_pkg->cancel;
1092 next if $cust_pkg->getfield('cancel');
1094 #? to avoid use of uninitialized value errors... ?
1095 $cust_pkg->setfield('bill', '')
1096 unless defined($cust_pkg->bill);
1098 my $part_pkg = $cust_pkg->part_pkg;
1100 #so we don't modify cust_pkg record unnecessarily
1101 my $cust_pkg_mod_flag = 0;
1102 my %hash = $cust_pkg->hash;
1103 my $old_cust_pkg = new FS::cust_pkg \%hash;
1109 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1110 my $setup_prog = $part_pkg->getfield('setup');
1111 $setup_prog =~ /^(.*)$/ or do {
1112 $dbh->rollback if $oldAutoCommit;
1113 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1117 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1119 #my $cpt = new Safe;
1120 ##$cpt->permit(); #what is necessary?
1121 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1122 #$setup = $cpt->reval($setup_prog);
1123 $setup = eval $setup_prog;
1124 unless ( defined($setup) ) {
1125 $dbh->rollback if $oldAutoCommit;
1126 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1127 "(expression $setup_prog): $@";
1129 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1130 $cust_pkg_mod_flag=1;
1136 if ( $part_pkg->getfield('freq') ne '0' &&
1137 ! $cust_pkg->getfield('susp') &&
1138 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1140 my $recur_prog = $part_pkg->getfield('recur');
1141 $recur_prog =~ /^(.*)$/ or do {
1142 $dbh->rollback if $oldAutoCommit;
1143 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1147 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1149 # shared with $recur_prog
1150 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1152 #my $cpt = new Safe;
1153 ##$cpt->permit(); #what is necessary?
1154 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1155 #$recur = $cpt->reval($recur_prog);
1156 $recur = eval $recur_prog;
1157 unless ( defined($recur) ) {
1158 $dbh->rollback if $oldAutoCommit;
1159 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1160 "(expression $recur_prog): $@";
1162 #change this bit to use Date::Manip? CAREFUL with timezones (see
1163 # mailing list archive)
1164 my ($sec,$min,$hour,$mday,$mon,$year) =
1165 (localtime($sdate) )[0,1,2,3,4,5];
1167 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1168 # only for figuring next bill date, nothing else, so, reset $sdate again
1170 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1171 $cust_pkg->last_bill($sdate)
1172 if $cust_pkg->dbdef_table->column('last_bill');
1174 if ( $part_pkg->freq =~ /^\d+$/ ) {
1175 $mon += $part_pkg->freq;
1176 until ( $mon < 12 ) { $mon -= 12; $year++; }
1177 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1179 $mday += $weeks * 7;
1180 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "unparsable frequency: ". $part_pkg->freq;
1187 $cust_pkg->setfield('bill',
1188 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1189 $cust_pkg_mod_flag = 1;
1192 warn "\$setup is undefined" unless defined($setup);
1193 warn "\$recur is undefined" unless defined($recur);
1194 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1196 if ( $cust_pkg_mod_flag ) {
1197 $error=$cust_pkg->replace($old_cust_pkg);
1198 if ( $error ) { #just in case
1199 $dbh->rollback if $oldAutoCommit;
1200 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1202 $setup = sprintf( "%.2f", $setup );
1203 $recur = sprintf( "%.2f", $recur );
1205 $dbh->rollback if $oldAutoCommit;
1206 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1209 $dbh->rollback if $oldAutoCommit;
1210 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1212 if ( $setup > 0 || $recur > 0 ) {
1213 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1214 'pkgnum' => $cust_pkg->pkgnum,
1218 'edate' => $cust_pkg->bill,
1219 'details' => \@details,
1221 push @cust_bill_pkg, $cust_bill_pkg;
1222 $total_setup += $setup;
1223 $total_recur += $recur;
1225 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1227 my @taxes = qsearch( 'cust_main_county', {
1228 'state' => $self->state,
1229 'county' => $self->county,
1230 'country' => $self->country,
1231 'taxclass' => $part_pkg->taxclass,
1234 @taxes = qsearch( 'cust_main_county', {
1235 'state' => $self->state,
1236 'county' => $self->county,
1237 'country' => $self->country,
1242 # maybe eliminate this entirely, along with all the 0% records
1244 $dbh->rollback if $oldAutoCommit;
1246 "fatal: can't find tax rate for state/county/country/taxclass ".
1247 join('/', ( map $self->$_(), qw(state county country) ),
1248 $part_pkg->taxclass ). "\n";
1251 foreach my $tax ( @taxes ) {
1253 my $taxable_charged = 0;
1254 $taxable_charged += $setup
1255 unless $part_pkg->setuptax =~ /^Y$/i
1256 || $tax->setuptax =~ /^Y$/i;
1257 $taxable_charged += $recur
1258 unless $part_pkg->recurtax =~ /^Y$/i
1259 || $tax->recurtax =~ /^Y$/i;
1260 next unless $taxable_charged;
1262 if ( $tax->exempt_amount > 0 ) {
1263 my ($mon,$year) = (localtime($sdate) )[4,5];
1265 my $freq = $part_pkg->freq || 1;
1266 if ( $freq !~ /(\d+)$/ ) {
1267 $dbh->rollback if $oldAutoCommit;
1268 return "daily/weekly package definitions not (yet?)".
1269 " compatible with monthly tax exemptions";
1271 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1272 foreach my $which_month ( 1 .. $freq ) {
1274 'custnum' => $self->custnum,
1275 'taxnum' => $tax->taxnum,
1276 'year' => 1900+$year,
1279 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1280 until ( $mon < 13 ) { $mon -= 12; $year++; }
1281 my $cust_tax_exempt =
1282 qsearchs('cust_tax_exempt', \%hash)
1283 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1284 my $remaining_exemption = sprintf("%.2f",
1285 $tax->exempt_amount - $cust_tax_exempt->amount );
1286 if ( $remaining_exemption > 0 ) {
1287 my $addl = $remaining_exemption > $taxable_per_month
1288 ? $taxable_per_month
1289 : $remaining_exemption;
1290 $taxable_charged -= $addl;
1291 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1292 $cust_tax_exempt->hash,
1294 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1296 $error = $new_cust_tax_exempt->exemptnum
1297 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1298 : $new_cust_tax_exempt->insert;
1300 $dbh->rollback if $oldAutoCommit;
1301 return "fatal: can't update cust_tax_exempt: $error";
1304 } # if $remaining_exemption > 0
1306 } #foreach $which_month
1308 } #if $tax->exempt_amount
1310 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1312 #$tax += $taxable_charged * $cust_main_county->tax / 100
1313 $tax{ $tax->taxname || 'Tax' } +=
1314 $taxable_charged * $tax->tax / 100
1316 } #foreach my $tax ( @taxes )
1318 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1320 } #if $setup > 0 || $recur > 0
1322 } #if $cust_pkg_mod_flag
1324 } #foreach my $cust_pkg
1326 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1327 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1329 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1330 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1334 # unless ( $self->tax =~ /Y/i
1335 # || $self->payby eq 'COMP'
1336 # || $taxable_charged == 0 ) {
1337 # my $cust_main_county = qsearchs('cust_main_county',{
1338 # 'state' => $self->state,
1339 # 'county' => $self->county,
1340 # 'country' => $self->country,
1341 # } ) or die "fatal: can't find tax rate for state/county/country ".
1342 # $self->state. "/". $self->county. "/". $self->country. "\n";
1343 # my $tax = sprintf( "%.2f",
1344 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1347 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1349 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1350 my $tax = sprintf("%.2f", $tax{$taxname} );
1351 $charged = sprintf( "%.2f", $charged+$tax );
1353 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1359 'itemdesc' => $taxname,
1361 push @cust_bill_pkg, $cust_bill_pkg;
1364 } else { #1.4 schema
1367 foreach ( values %tax ) { $tax += $_ };
1368 $tax = sprintf("%.2f", $tax);
1370 $charged = sprintf( "%.2f", $charged+$tax );
1372 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1379 push @cust_bill_pkg, $cust_bill_pkg;
1384 my $cust_bill = new FS::cust_bill ( {
1385 'custnum' => $self->custnum,
1387 'charged' => $charged,
1389 $error = $cust_bill->insert;
1391 $dbh->rollback if $oldAutoCommit;
1392 return "can't create invoice for customer #". $self->custnum. ": $error";
1395 my $invnum = $cust_bill->invnum;
1397 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1399 $cust_bill_pkg->invnum($invnum);
1400 $error = $cust_bill_pkg->insert;
1402 $dbh->rollback if $oldAutoCommit;
1403 return "can't create invoice line item for customer #". $self->custnum.
1408 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1412 =item collect OPTIONS
1414 (Attempt to) collect money for this customer's outstanding invoices (see
1415 L<FS::cust_bill>). Usually used after the bill method.
1417 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1418 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1419 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1421 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1422 and the invoice events web interface.
1424 If there is an error, returns the error, otherwise returns false.
1426 Options are passed as name-value pairs.
1428 Currently available options are:
1430 invoice_time - Use this time when deciding when to print invoices and
1431 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>
1432 for conversion functions.
1434 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1437 retry_card - Deprecated alias for 'retry'
1439 batch_card - This option is deprecated. See the invoice events web interface
1440 to control whether cards are batched or run against a realtime gateway.
1442 report_badcard - This option is deprecated.
1444 force_print - This option is deprecated; see the invoice events web interface.
1446 quiet - set true to surpress email card/ACH decline notices.
1451 my( $self, %options ) = @_;
1452 my $invoice_time = $options{'invoice_time'} || time;
1455 local $SIG{HUP} = 'IGNORE';
1456 local $SIG{INT} = 'IGNORE';
1457 local $SIG{QUIT} = 'IGNORE';
1458 local $SIG{TERM} = 'IGNORE';
1459 local $SIG{TSTP} = 'IGNORE';
1460 local $SIG{PIPE} = 'IGNORE';
1462 my $oldAutoCommit = $FS::UID::AutoCommit;
1463 local $FS::UID::AutoCommit = 0;
1466 my $balance = $self->balance;
1467 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1468 unless ( $balance > 0 ) { #redundant?????
1469 $dbh->rollback if $oldAutoCommit; #hmm
1473 if ( exists($options{'retry_card'}) ) {
1474 carp 'retry_card option passed to collect is deprecated; use retry';
1475 $options{'retry'} ||= $options{'retry_card'};
1477 if ( exists($options{'retry'}) && $options{'retry'} ) {
1478 my $error = $self->retry_realtime;
1480 $dbh->rollback if $oldAutoCommit;
1485 foreach my $cust_bill ( $self->open_cust_bill ) {
1487 # don't try to charge for the same invoice if it's already in a batch
1488 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1490 last if $self->balance <= 0;
1492 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1495 foreach my $part_bill_event (
1496 sort { $a->seconds <=> $b->seconds
1497 || $a->weight <=> $b->weight
1498 || $a->eventpart <=> $b->eventpart }
1499 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1500 && ! qsearchs( 'cust_bill_event', {
1501 'invnum' => $cust_bill->invnum,
1502 'eventpart' => $_->eventpart,
1506 qsearch('part_bill_event', { 'payby' => $self->payby,
1507 'disabled' => '', } )
1510 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1511 || $self->balance <= 0; # or if balance<=0
1513 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1515 my $cust_main = $self; #for callback
1519 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1520 $error = eval $part_bill_event->eventcode;
1524 my $statustext = '';
1528 } elsif ( $error ) {
1530 $statustext = $error;
1535 #add cust_bill_event
1536 my $cust_bill_event = new FS::cust_bill_event {
1537 'invnum' => $cust_bill->invnum,
1538 'eventpart' => $part_bill_event->eventpart,
1539 #'_date' => $invoice_time,
1541 'status' => $status,
1542 'statustext' => $statustext,
1544 $error = $cust_bill_event->insert;
1546 #$dbh->rollback if $oldAutoCommit;
1547 #return "error: $error";
1549 # gah, even with transactions.
1550 $dbh->commit if $oldAutoCommit; #well.
1551 my $e = 'WARNING: Event run but database not updated - '.
1552 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1553 ', eventpart '. $part_bill_event->eventpart.
1564 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1569 =item retry_realtime
1571 Schedules realtime credit card / electronic check / LEC billing events for
1572 for retry. Useful if card information has changed or manual retry is desired.
1573 The 'collect' method must be called to actually retry the transaction.
1575 Implementation details: For each of this customer's open invoices, changes
1576 the status of the first "done" (with statustext error) realtime processing
1581 sub retry_realtime {
1584 local $SIG{HUP} = 'IGNORE';
1585 local $SIG{INT} = 'IGNORE';
1586 local $SIG{QUIT} = 'IGNORE';
1587 local $SIG{TERM} = 'IGNORE';
1588 local $SIG{TSTP} = 'IGNORE';
1589 local $SIG{PIPE} = 'IGNORE';
1591 my $oldAutoCommit = $FS::UID::AutoCommit;
1592 local $FS::UID::AutoCommit = 0;
1595 foreach my $cust_bill (
1596 grep { $_->cust_bill_event }
1597 $self->open_cust_bill
1599 my @cust_bill_event =
1600 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1602 #$_->part_bill_event->plan eq 'realtime-card'
1603 $_->part_bill_event->eventcode =~
1604 /\$cust_bill\->realtime_(card|ach|lec)/
1605 && $_->status eq 'done'
1608 $cust_bill->cust_bill_event;
1609 next unless @cust_bill_event;
1610 my $error = $cust_bill_event[0]->retry;
1612 $dbh->rollback if $oldAutoCommit;
1613 return "error scheduling invoice event for retry: $error";
1618 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1623 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1625 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1626 via a Business::OnlinePayment realtime gateway. See
1627 L<http://420.am/business-onlinepayment> for supported gateways.
1629 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1631 Available options are: I<description>, I<invnum>, I<quiet>
1633 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1634 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1635 if set, will override the value from the customer record.
1637 I<description> is a free-text field passed to the gateway. It defaults to
1638 "Internet services".
1640 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1641 specified invoice. If you don't specify an I<invnum> you might want to
1642 call the B<apply_payments> method.
1644 I<quiet> can be set true to surpress email decline notices.
1646 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1651 my( $self, $method, $amount, %options ) = @_;
1653 warn "$self $method $amount\n";
1654 warn " $_ => $options{$_}\n" foreach keys %options;
1657 $options{'description'} ||= 'Internet services';
1660 die "Real-time processing not enabled\n"
1661 unless $conf->exists('business-onlinepayment');
1662 eval "use Business::OnlinePayment";
1666 $self->set( $_ => $options{$_} )
1667 foreach grep { exists($options{$_}) }
1668 qw( payname address1 address2 city state zip payinfo paydate );
1671 my $bop_config = 'business-onlinepayment';
1672 $bop_config .= '-ach'
1673 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1674 my ( $processor, $login, $password, $action, @bop_options ) =
1675 $conf->config($bop_config);
1676 $action ||= 'normal authorization';
1677 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1681 my $address = $self->address1;
1682 $address .= ", ". $self->address2 if $self->address2;
1684 my($payname, $payfirst, $paylast);
1685 if ( $self->payname && $method ne 'ECHECK' ) {
1686 $payname = $self->payname;
1687 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1688 or return "Illegal payname $payname";
1689 ($payfirst, $paylast) = ($1, $2);
1691 $payfirst = $self->getfield('first');
1692 $paylast = $self->getfield('last');
1693 $payname = "$payfirst $paylast";
1696 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1697 if ( $conf->exists('emailinvoiceauto')
1698 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1699 push @invoicing_list, $self->all_emails;
1701 my $email = $invoicing_list[0];
1704 if ( $method eq 'CC' ) {
1706 $content{card_number} = $self->payinfo;
1707 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1708 $content{expiration} = "$2/$1";
1710 $content{cvv2} = $self->paycvv
1711 if defined $self->dbdef_table->column('paycvv')
1712 && length($self->paycvv);
1714 $content{recurring_billing} = 'YES'
1715 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1717 'payinfo' => $self->payinfo, } );
1719 } elsif ( $method eq 'ECHECK' ) {
1720 my($account_number,$routing_code) = $self->payinfo;
1721 ( $content{account_number}, $content{routing_code} ) =
1722 split('@', $self->payinfo);
1723 $content{bank_name} = $self->payname;
1724 $content{account_type} = 'CHECKING';
1725 $content{account_name} = $payname;
1726 $content{customer_org} = $self->company ? 'B' : 'I';
1727 $content{customer_ssn} = $self->ss;
1728 } elsif ( $method eq 'LEC' ) {
1729 $content{phone} = $self->payinfo;
1734 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1737 new Business::OnlinePayment( $processor, @bop_options );
1738 $transaction->content(
1741 'password' => $password,
1742 'action' => $action1,
1743 'description' => $options{'description'},
1744 'amount' => $amount,
1745 'invoice_number' => $options{'invnum'},
1746 'customer_id' => $self->custnum,
1747 'last_name' => $paylast,
1748 'first_name' => $payfirst,
1750 'address' => $address,
1751 'city' => $self->city,
1752 'state' => $self->state,
1753 'zip' => $self->zip,
1754 'country' => $self->country,
1755 'referer' => 'http://cleanwhisker.420.am/',
1757 'phone' => $self->daytime || $self->night,
1760 $transaction->submit();
1762 if ( $transaction->is_success() && $action2 ) {
1763 my $auth = $transaction->authorization;
1764 my $ordernum = $transaction->can('order_number')
1765 ? $transaction->order_number
1769 new Business::OnlinePayment( $processor, @bop_options );
1776 password => $password,
1777 order_number => $ordernum,
1779 authorization => $auth,
1780 description => $options{'description'},
1783 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1784 transaction_sequence_num local_transaction_date
1785 local_transaction_time AVS_result_code )) {
1786 $capture{$field} = $transaction->$field() if $transaction->can($field);
1789 $capture->content( %capture );
1793 unless ( $capture->is_success ) {
1794 my $e = "Authorization sucessful but capture failed, custnum #".
1795 $self->custnum. ': '. $capture->result_code.
1796 ": ". $capture->error_message;
1803 #remove paycvv after initial transaction
1804 #make this disable-able via a config option if anyone insists?
1805 # (though that probably violates cardholder agreements)
1806 if ( defined $self->dbdef_table->column('paycvv')
1807 && length($self->paycvv)
1808 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1810 my $new = new FS::cust_main { $self->hash };
1812 my $error = $new->replace($self);
1814 warn "error removing cvv: $error\n";
1819 if ( $transaction->is_success() ) {
1821 my %method2payby = (
1827 my $cust_pay = new FS::cust_pay ( {
1828 'custnum' => $self->custnum,
1829 'invnum' => $options{'invnum'},
1832 'payby' => $method2payby{$method},
1833 'payinfo' => $self->payinfo,
1834 'paybatch' => "$processor:". $transaction->authorization,
1836 my $error = $cust_pay->insert;
1838 # gah, even with transactions.
1839 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1840 'error applying payment, invnum #' . $self->invnum.
1841 " ($processor): $error";
1850 my $perror = "$processor error: ". $transaction->error_message;
1852 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1853 && $conf->exists('emaildecline')
1854 && grep { $_ ne 'POST' } $self->invoicing_list
1855 && ! grep { $_ eq $transaction->error_message }
1856 $conf->config('emaildecline-exclude')
1858 my @templ = $conf->config('declinetemplate');
1859 my $template = new Text::Template (
1861 SOURCE => [ map "$_\n", @templ ],
1862 ) or return "($perror) can't create template: $Text::Template::ERROR";
1863 $template->compile()
1864 or return "($perror) can't compile template: $Text::Template::ERROR";
1866 my $templ_hash = { error => $transaction->error_message };
1868 my $error = send_email(
1869 'from' => $conf->config('invoice_from'),
1870 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1871 'subject' => 'Your payment could not be processed',
1872 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1875 $perror .= " (also received error sending decline notification: $error)"
1887 Returns the total owed for this customer on all invoices
1888 (see L<FS::cust_bill/owed>).
1894 $self->total_owed_date(2145859200); #12/31/2037
1897 =item total_owed_date TIME
1899 Returns the total owed for this customer on all invoices with date earlier than
1900 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1901 see L<Time::Local> and L<Date::Parse> for conversion functions.
1905 sub total_owed_date {
1909 foreach my $cust_bill (
1910 grep { $_->_date <= $time }
1911 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1913 $total_bill += $cust_bill->owed;
1915 sprintf( "%.2f", $total_bill );
1920 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1921 to outstanding invoice balances in chronological order and returns the value
1922 of any remaining unapplied credits available for refund
1923 (see L<FS::cust_refund>).
1930 return 0 unless $self->total_credited;
1932 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1933 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1935 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1936 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1940 foreach my $cust_bill ( @invoices ) {
1943 if ( !defined($credit) || $credit->credited == 0) {
1944 $credit = pop @credits or last;
1947 if ($cust_bill->owed >= $credit->credited) {
1948 $amount=$credit->credited;
1950 $amount=$cust_bill->owed;
1953 my $cust_credit_bill = new FS::cust_credit_bill ( {
1954 'crednum' => $credit->crednum,
1955 'invnum' => $cust_bill->invnum,
1956 'amount' => $amount,
1958 my $error = $cust_credit_bill->insert;
1959 die $error if $error;
1961 redo if ($cust_bill->owed > 0);
1965 return $self->total_credited;
1968 =item apply_payments
1970 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1971 to outstanding invoice balances in chronological order.
1973 #and returns the value of any remaining unapplied payments.
1977 sub apply_payments {
1982 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1983 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1985 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1986 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1990 foreach my $cust_bill ( @invoices ) {
1993 if ( !defined($payment) || $payment->unapplied == 0 ) {
1994 $payment = pop @payments or last;
1997 if ( $cust_bill->owed >= $payment->unapplied ) {
1998 $amount = $payment->unapplied;
2000 $amount = $cust_bill->owed;
2003 my $cust_bill_pay = new FS::cust_bill_pay ( {
2004 'paynum' => $payment->paynum,
2005 'invnum' => $cust_bill->invnum,
2006 'amount' => $amount,
2008 my $error = $cust_bill_pay->insert;
2009 die $error if $error;
2011 redo if ( $cust_bill->owed > 0);
2015 return $self->total_unapplied_payments;
2018 =item total_credited
2020 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2021 customer. See L<FS::cust_credit/credited>.
2025 sub total_credited {
2027 my $total_credit = 0;
2028 foreach my $cust_credit ( qsearch('cust_credit', {
2029 'custnum' => $self->custnum,
2031 $total_credit += $cust_credit->credited;
2033 sprintf( "%.2f", $total_credit );
2036 =item total_unapplied_payments
2038 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2039 See L<FS::cust_pay/unapplied>.
2043 sub total_unapplied_payments {
2045 my $total_unapplied = 0;
2046 foreach my $cust_pay ( qsearch('cust_pay', {
2047 'custnum' => $self->custnum,
2049 $total_unapplied += $cust_pay->unapplied;
2051 sprintf( "%.2f", $total_unapplied );
2056 Returns the balance for this customer (total_owed minus total_credited
2057 minus total_unapplied_payments).
2064 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2068 =item balance_date TIME
2070 Returns the balance for this customer, only considering invoices with date
2071 earlier than TIME (total_owed_date minus total_credited minus
2072 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2073 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2082 $self->total_owed_date($time)
2083 - $self->total_credited
2084 - $self->total_unapplied_payments
2088 =item invoicing_list [ ARRAYREF ]
2090 If an arguement is given, sets these email addresses as invoice recipients
2091 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2092 (except as warnings), so use check_invoicing_list first.
2094 Returns a list of email addresses (with svcnum entries expanded).
2096 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2097 check it without disturbing anything by passing nothing.
2099 This interface may change in the future.
2103 sub invoicing_list {
2104 my( $self, $arrayref ) = @_;
2106 my @cust_main_invoice;
2107 if ( $self->custnum ) {
2108 @cust_main_invoice =
2109 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2111 @cust_main_invoice = ();
2113 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2114 #warn $cust_main_invoice->destnum;
2115 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2116 #warn $cust_main_invoice->destnum;
2117 my $error = $cust_main_invoice->delete;
2118 warn $error if $error;
2121 if ( $self->custnum ) {
2122 @cust_main_invoice =
2123 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2125 @cust_main_invoice = ();
2127 my %seen = map { $_->address => 1 } @cust_main_invoice;
2128 foreach my $address ( @{$arrayref} ) {
2129 next if exists $seen{$address} && $seen{$address};
2130 $seen{$address} = 1;
2131 my $cust_main_invoice = new FS::cust_main_invoice ( {
2132 'custnum' => $self->custnum,
2135 my $error = $cust_main_invoice->insert;
2136 warn $error if $error;
2139 if ( $self->custnum ) {
2141 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2147 =item check_invoicing_list ARRAYREF
2149 Checks these arguements as valid input for the invoicing_list method. If there
2150 is an error, returns the error, otherwise returns false.
2154 sub check_invoicing_list {
2155 my( $self, $arrayref ) = @_;
2156 foreach my $address ( @{$arrayref} ) {
2157 my $cust_main_invoice = new FS::cust_main_invoice ( {
2158 'custnum' => $self->custnum,
2161 my $error = $self->custnum
2162 ? $cust_main_invoice->check
2163 : $cust_main_invoice->checkdest
2165 return $error if $error;
2170 =item set_default_invoicing_list
2172 Sets the invoicing list to all accounts associated with this customer,
2173 overwriting any previous invoicing list.
2177 sub set_default_invoicing_list {
2179 $self->invoicing_list($self->all_emails);
2184 Returns the email addresses of all accounts provisioned for this customer.
2191 foreach my $cust_pkg ( $self->all_pkgs ) {
2192 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2194 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2195 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2197 $list{$_}=1 foreach map { $_->email } @svc_acct;
2202 =item invoicing_list_addpost
2204 Adds postal invoicing to this customer. If this customer is already configured
2205 to receive postal invoices, does nothing.
2209 sub invoicing_list_addpost {
2211 return if grep { $_ eq 'POST' } $self->invoicing_list;
2212 my @invoicing_list = $self->invoicing_list;
2213 push @invoicing_list, 'POST';
2214 $self->invoicing_list(\@invoicing_list);
2217 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2219 Returns an array of customers referred by this customer (referral_custnum set
2220 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2221 customers referred by customers referred by this customer and so on, inclusive.
2222 The default behavior is DEPTH 1 (no recursion).
2226 sub referral_cust_main {
2228 my $depth = @_ ? shift : 1;
2229 my $exclude = @_ ? shift : {};
2232 map { $exclude->{$_->custnum}++; $_; }
2233 grep { ! $exclude->{ $_->custnum } }
2234 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2238 map { $_->referral_cust_main($depth-1, $exclude) }
2245 =item referral_cust_main_ncancelled
2247 Same as referral_cust_main, except only returns customers with uncancelled
2252 sub referral_cust_main_ncancelled {
2254 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2257 =item referral_cust_pkg [ DEPTH ]
2259 Like referral_cust_main, except returns a flat list of all unsuspended (and
2260 uncancelled) packages for each customer. The number of items in this list may
2261 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2265 sub referral_cust_pkg {
2267 my $depth = @_ ? shift : 1;
2269 map { $_->unsuspended_pkgs }
2270 grep { $_->unsuspended_pkgs }
2271 $self->referral_cust_main($depth);
2274 =item credit AMOUNT, REASON
2276 Applies a credit to this customer. If there is an error, returns the error,
2277 otherwise returns false.
2282 my( $self, $amount, $reason ) = @_;
2283 my $cust_credit = new FS::cust_credit {
2284 'custnum' => $self->custnum,
2285 'amount' => $amount,
2286 'reason' => $reason,
2288 $cust_credit->insert;
2291 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2293 Creates a one-time charge for this customer. If there is an error, returns
2294 the error, otherwise returns false.
2299 my ( $self, $amount ) = ( shift, shift );
2300 my $pkg = @_ ? shift : 'One-time charge';
2301 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2302 my $taxclass = @_ ? shift : '';
2304 local $SIG{HUP} = 'IGNORE';
2305 local $SIG{INT} = 'IGNORE';
2306 local $SIG{QUIT} = 'IGNORE';
2307 local $SIG{TERM} = 'IGNORE';
2308 local $SIG{TSTP} = 'IGNORE';
2309 local $SIG{PIPE} = 'IGNORE';
2311 my $oldAutoCommit = $FS::UID::AutoCommit;
2312 local $FS::UID::AutoCommit = 0;
2315 my $part_pkg = new FS::part_pkg ( {
2317 'comment' => $comment,
2322 'taxclass' => $taxclass,
2325 my $error = $part_pkg->insert;
2327 $dbh->rollback if $oldAutoCommit;
2331 my $pkgpart = $part_pkg->pkgpart;
2332 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2333 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2334 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2335 $error = $type_pkgs->insert;
2337 $dbh->rollback if $oldAutoCommit;
2342 my $cust_pkg = new FS::cust_pkg ( {
2343 'custnum' => $self->custnum,
2344 'pkgpart' => $pkgpart,
2347 $error = $cust_pkg->insert;
2349 $dbh->rollback if $oldAutoCommit;
2353 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2360 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2366 sort { $a->_date <=> $b->_date }
2367 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2370 =item open_cust_bill
2372 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2377 sub open_cust_bill {
2379 grep { $_->owed > 0 } $self->cust_bill;
2384 Returns all the credits (see L<FS::cust_credit>) for this customer.
2390 sort { $a->_date <=> $b->_date }
2391 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2396 Returns all the payments (see L<FS::cust_pay>) for this customer.
2402 sort { $a->_date <=> $b->_date }
2403 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2408 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2414 sort { $a->_date <=> $b->_date }
2415 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2424 =item check_and_rebuild_fuzzyfiles
2428 sub check_and_rebuild_fuzzyfiles {
2429 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2430 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2431 or &rebuild_fuzzyfiles;
2434 =item rebuild_fuzzyfiles
2438 sub rebuild_fuzzyfiles {
2440 use Fcntl qw(:flock);
2442 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2446 open(LASTLOCK,">>$dir/cust_main.last")
2447 or die "can't open $dir/cust_main.last: $!";
2448 flock(LASTLOCK,LOCK_EX)
2449 or die "can't lock $dir/cust_main.last: $!";
2451 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2453 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2454 if defined dbdef->table('cust_main')->column('ship_last');
2456 open (LASTCACHE,">$dir/cust_main.last.tmp")
2457 or die "can't open $dir/cust_main.last.tmp: $!";
2458 print LASTCACHE join("\n", @all_last), "\n";
2459 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2461 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2466 open(COMPANYLOCK,">>$dir/cust_main.company")
2467 or die "can't open $dir/cust_main.company: $!";
2468 flock(COMPANYLOCK,LOCK_EX)
2469 or die "can't lock $dir/cust_main.company: $!";
2471 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2473 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2474 if defined dbdef->table('cust_main')->column('ship_last');
2476 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2477 or die "can't open $dir/cust_main.company.tmp: $!";
2478 print COMPANYCACHE join("\n", @all_company), "\n";
2479 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2481 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2491 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2492 open(LASTCACHE,"<$dir/cust_main.last")
2493 or die "can't open $dir/cust_main.last: $!";
2494 my @array = map { chomp; $_; } <LASTCACHE>;
2504 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2505 open(COMPANYCACHE,"<$dir/cust_main.company")
2506 or die "can't open $dir/cust_main.last: $!";
2507 my @array = map { chomp; $_; } <COMPANYCACHE>;
2512 =item append_fuzzyfiles LASTNAME COMPANY
2516 sub append_fuzzyfiles {
2517 my( $last, $company ) = @_;
2519 &check_and_rebuild_fuzzyfiles;
2521 use Fcntl qw(:flock);
2523 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2527 open(LAST,">>$dir/cust_main.last")
2528 or die "can't open $dir/cust_main.last: $!";
2530 or die "can't lock $dir/cust_main.last: $!";
2532 print LAST "$last\n";
2535 or die "can't unlock $dir/cust_main.last: $!";
2541 open(COMPANY,">>$dir/cust_main.company")
2542 or die "can't open $dir/cust_main.company: $!";
2543 flock(COMPANY,LOCK_EX)
2544 or die "can't lock $dir/cust_main.company: $!";
2546 print COMPANY "$company\n";
2548 flock(COMPANY,LOCK_UN)
2549 or die "can't unlock $dir/cust_main.company: $!";
2563 #warn join('-',keys %$param);
2564 my $fh = $param->{filehandle};
2565 my $agentnum = $param->{agentnum};
2566 my $refnum = $param->{refnum};
2567 my $pkgpart = $param->{pkgpart};
2568 my @fields = @{$param->{fields}};
2570 eval "use Date::Parse;";
2572 eval "use Text::CSV_XS;";
2575 my $csv = new Text::CSV_XS;
2582 local $SIG{HUP} = 'IGNORE';
2583 local $SIG{INT} = 'IGNORE';
2584 local $SIG{QUIT} = 'IGNORE';
2585 local $SIG{TERM} = 'IGNORE';
2586 local $SIG{TSTP} = 'IGNORE';
2587 local $SIG{PIPE} = 'IGNORE';
2589 my $oldAutoCommit = $FS::UID::AutoCommit;
2590 local $FS::UID::AutoCommit = 0;
2593 #while ( $columns = $csv->getline($fh) ) {
2595 while ( defined($line=<$fh>) ) {
2597 $csv->parse($line) or do {
2598 $dbh->rollback if $oldAutoCommit;
2599 return "can't parse: ". $csv->error_input();
2602 my @columns = $csv->fields();
2603 #warn join('-',@columns);
2606 agentnum => $agentnum,
2608 country => 'US', #default
2609 payby => 'BILL', #default
2610 paydate => '12/2037', #default
2612 my $billtime = time;
2613 my %cust_pkg = ( pkgpart => $pkgpart );
2614 foreach my $field ( @fields ) {
2615 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2616 #$cust_pkg{$1} = str2time( shift @$columns );
2617 if ( $1 eq 'setup' ) {
2618 $billtime = str2time(shift @columns);
2620 $cust_pkg{$1} = str2time( shift @columns );
2623 #$cust_main{$field} = shift @$columns;
2624 $cust_main{$field} = shift @columns;
2628 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2629 my $cust_main = new FS::cust_main ( \%cust_main );
2631 tie my %hash, 'Tie::RefHash'; #this part is important
2632 $hash{$cust_pkg} = [] if $pkgpart;
2633 my $error = $cust_main->insert( \%hash );
2636 $dbh->rollback if $oldAutoCommit;
2637 return "can't insert customer for $line: $error";
2640 #false laziness w/bill.cgi
2641 $error = $cust_main->bill( 'time' => $billtime );
2643 $dbh->rollback if $oldAutoCommit;
2644 return "can't bill customer for $line: $error";
2647 $cust_main->apply_payments;
2648 $cust_main->apply_credits;
2650 $error = $cust_main->collect();
2652 $dbh->rollback if $oldAutoCommit;
2653 return "can't collect customer for $line: $error";
2659 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2661 return "Empty file!" unless $imported;
2673 #warn join('-',keys %$param);
2674 my $fh = $param->{filehandle};
2675 my @fields = @{$param->{fields}};
2677 eval "use Date::Parse;";
2679 eval "use Text::CSV_XS;";
2682 my $csv = new Text::CSV_XS;
2689 local $SIG{HUP} = 'IGNORE';
2690 local $SIG{INT} = 'IGNORE';
2691 local $SIG{QUIT} = 'IGNORE';
2692 local $SIG{TERM} = 'IGNORE';
2693 local $SIG{TSTP} = 'IGNORE';
2694 local $SIG{PIPE} = 'IGNORE';
2696 my $oldAutoCommit = $FS::UID::AutoCommit;
2697 local $FS::UID::AutoCommit = 0;
2700 #while ( $columns = $csv->getline($fh) ) {
2702 while ( defined($line=<$fh>) ) {
2704 $csv->parse($line) or do {
2705 $dbh->rollback if $oldAutoCommit;
2706 return "can't parse: ". $csv->error_input();
2709 my @columns = $csv->fields();
2710 #warn join('-',@columns);
2713 foreach my $field ( @fields ) {
2714 $row{$field} = shift @columns;
2717 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2718 unless ( $cust_main ) {
2719 $dbh->rollback if $oldAutoCommit;
2720 return "unknown custnum $row{'custnum'}";
2723 if ( $row{'amount'} > 0 ) {
2724 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2726 $dbh->rollback if $oldAutoCommit;
2730 } elsif ( $row{'amount'} < 0 ) {
2731 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2734 $dbh->rollback if $oldAutoCommit;
2744 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2746 return "Empty file!" unless $imported;
2758 The delete method should possibly take an FS::cust_main object reference
2759 instead of a scalar customer number.
2761 Bill and collect options should probably be passed as references instead of a
2764 There should probably be a configuration file with a list of allowed credit
2767 No multiple currency support (probably a larger project than just this module).
2771 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2772 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2773 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.