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, %options);
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;
332 =item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
334 Like the insert method on an existing record, this method orders a package
335 and included services atomicaly. Pass a Tie::RefHash data structure to this
336 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
337 be a better explanation of this, but until then, here's an example:
340 tie %hash, 'Tie::RefHash'; #this part is important
342 $cust_pkg => [ $svc_acct ],
345 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
347 Currently available options are: I<noexport>
349 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
350 (You can schedule them later with the B<reexport> method for each
351 cust_pkg object. Using the B<reexport> method on the cust_main object is not
352 recommended, as existing services will also be reexported.)
358 my $cust_pkgs = shift;
362 local $SIG{HUP} = 'IGNORE';
363 local $SIG{INT} = 'IGNORE';
364 local $SIG{QUIT} = 'IGNORE';
365 local $SIG{TERM} = 'IGNORE';
366 local $SIG{TSTP} = 'IGNORE';
367 local $SIG{PIPE} = 'IGNORE';
369 my $oldAutoCommit = $FS::UID::AutoCommit;
370 local $FS::UID::AutoCommit = 0;
373 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
375 foreach my $cust_pkg ( keys %$cust_pkgs ) {
376 $cust_pkg->custnum( $self->custnum );
377 my $error = $cust_pkg->insert;
379 $dbh->rollback if $oldAutoCommit;
380 return "inserting cust_pkg (transaction rolled back): $error";
382 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
383 $svc_something->pkgnum( $cust_pkg->pkgnum );
384 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
385 $svc_something->seconds( $svc_something->seconds + $$seconds );
388 $error = $svc_something->insert;
390 $dbh->rollback if $oldAutoCommit;
391 #return "inserting svc_ (transaction rolled back): $error";
397 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
403 Re-schedules all exports by calling the B<reexport> method of all associated
404 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
405 otherwise returns false.
412 local $SIG{HUP} = 'IGNORE';
413 local $SIG{INT} = 'IGNORE';
414 local $SIG{QUIT} = 'IGNORE';
415 local $SIG{TERM} = 'IGNORE';
416 local $SIG{TSTP} = 'IGNORE';
417 local $SIG{PIPE} = 'IGNORE';
419 my $oldAutoCommit = $FS::UID::AutoCommit;
420 local $FS::UID::AutoCommit = 0;
423 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
424 my $error = $cust_pkg->reexport;
426 $dbh->rollback if $oldAutoCommit;
431 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
436 =item delete NEW_CUSTNUM
438 This deletes the customer. If there is an error, returns the error, otherwise
441 This will completely remove all traces of the customer record. This is not
442 what you want when a customer cancels service; for that, cancel all of the
443 customer's packages (see L</cancel>).
445 If the customer has any uncancelled packages, you need to pass a new (valid)
446 customer number for those packages to be transferred to. Cancelled packages
447 will be deleted. Did I mention that this is NOT what you want when a customer
448 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
450 You can't delete a customer with invoices (see L<FS::cust_bill>),
451 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
452 refunds (see L<FS::cust_refund>).
459 local $SIG{HUP} = 'IGNORE';
460 local $SIG{INT} = 'IGNORE';
461 local $SIG{QUIT} = 'IGNORE';
462 local $SIG{TERM} = 'IGNORE';
463 local $SIG{TSTP} = 'IGNORE';
464 local $SIG{PIPE} = 'IGNORE';
466 my $oldAutoCommit = $FS::UID::AutoCommit;
467 local $FS::UID::AutoCommit = 0;
470 if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
471 $dbh->rollback if $oldAutoCommit;
472 return "Can't delete a customer with invoices";
474 if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
475 $dbh->rollback if $oldAutoCommit;
476 return "Can't delete a customer with credits";
478 if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
479 $dbh->rollback if $oldAutoCommit;
480 return "Can't delete a customer with payments";
482 if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
483 $dbh->rollback if $oldAutoCommit;
484 return "Can't delete a customer with refunds";
487 my @cust_pkg = $self->ncancelled_pkgs;
489 my $new_custnum = shift;
490 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
491 $dbh->rollback if $oldAutoCommit;
492 return "Invalid new customer number: $new_custnum";
494 foreach my $cust_pkg ( @cust_pkg ) {
495 my %hash = $cust_pkg->hash;
496 $hash{'custnum'} = $new_custnum;
497 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
498 my $error = $new_cust_pkg->replace($cust_pkg);
500 $dbh->rollback if $oldAutoCommit;
505 my @cancelled_cust_pkg = $self->all_pkgs;
506 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
507 my $error = $cust_pkg->delete;
509 $dbh->rollback if $oldAutoCommit;
514 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
515 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
517 my $error = $cust_main_invoice->delete;
519 $dbh->rollback if $oldAutoCommit;
524 my $error = $self->SUPER::delete;
526 $dbh->rollback if $oldAutoCommit;
530 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
535 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
537 Replaces the OLD_RECORD with this one in the database. If there is an error,
538 returns the error, otherwise returns false.
540 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
541 be set as the invoicing list (see L<"invoicing_list">). Errors return as
542 expected and rollback the entire transaction; it is not necessary to call
543 check_invoicing_list first. Here's an example:
545 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
554 local $SIG{HUP} = 'IGNORE';
555 local $SIG{INT} = 'IGNORE';
556 local $SIG{QUIT} = 'IGNORE';
557 local $SIG{TERM} = 'IGNORE';
558 local $SIG{TSTP} = 'IGNORE';
559 local $SIG{PIPE} = 'IGNORE';
561 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
562 && $conf->config('users-allow_comp') ) {
563 return "You are not permitted to create complimentary accounts."
564 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
567 my $oldAutoCommit = $FS::UID::AutoCommit;
568 local $FS::UID::AutoCommit = 0;
571 my $error = $self->SUPER::replace($old);
574 $dbh->rollback if $oldAutoCommit;
578 if ( @param ) { # INVOICING_LIST_ARYREF
579 my $invoicing_list = shift @param;
580 $error = $self->check_invoicing_list( $invoicing_list );
582 $dbh->rollback if $oldAutoCommit;
585 $self->invoicing_list( $invoicing_list );
588 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
589 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
590 # card/check/lec info has changed, want to retry realtime_ invoice events
591 my $error = $self->retry_realtime;
593 $dbh->rollback if $oldAutoCommit;
598 $error = $self->queue_fuzzyfiles_update;
600 $dbh->rollback if $oldAutoCommit;
601 return "updating fuzzy search cache: $error";
604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
609 =item queue_fuzzyfiles_update
611 Used by insert & replace to update the fuzzy search cache
615 sub queue_fuzzyfiles_update {
618 local $SIG{HUP} = 'IGNORE';
619 local $SIG{INT} = 'IGNORE';
620 local $SIG{QUIT} = 'IGNORE';
621 local $SIG{TERM} = 'IGNORE';
622 local $SIG{TSTP} = 'IGNORE';
623 local $SIG{PIPE} = 'IGNORE';
625 my $oldAutoCommit = $FS::UID::AutoCommit;
626 local $FS::UID::AutoCommit = 0;
629 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
630 my $error = $queue->insert($self->getfield('last'), $self->company);
632 $dbh->rollback if $oldAutoCommit;
633 return "queueing job (transaction rolled back): $error";
636 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
637 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
638 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
640 $dbh->rollback if $oldAutoCommit;
641 return "queueing job (transaction rolled back): $error";
645 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
652 Checks all fields to make sure this is a valid customer record. If there is
653 an error, returns the error, otherwise returns false. Called by the insert
661 #warn "BEFORE: \n". $self->_dump;
664 $self->ut_numbern('custnum')
665 || $self->ut_number('agentnum')
666 || $self->ut_number('refnum')
667 || $self->ut_name('last')
668 || $self->ut_name('first')
669 || $self->ut_textn('company')
670 || $self->ut_text('address1')
671 || $self->ut_textn('address2')
672 || $self->ut_text('city')
673 || $self->ut_textn('county')
674 || $self->ut_textn('state')
675 || $self->ut_country('country')
676 || $self->ut_anything('comments')
677 || $self->ut_numbern('referral_custnum')
679 #barf. need message catalogs. i18n. etc.
680 $error .= "Please select an advertising source."
681 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
682 return $error if $error;
684 return "Unknown agent"
685 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
687 return "Unknown refnum"
688 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
690 return "Unknown referring custnum ". $self->referral_custnum
691 unless ! $self->referral_custnum
692 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
694 if ( $self->ss eq '' ) {
699 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
700 or return "Illegal social security number: ". $self->ss;
701 $self->ss("$1-$2-$3");
705 # bad idea to disable, causes billing to fail because of no tax rates later
706 # unless ( $import ) {
707 unless ( qsearch('cust_main_county', {
708 'country' => $self->country,
711 return "Unknown state/county/country: ".
712 $self->state. "/". $self->county. "/". $self->country
713 unless qsearch('cust_main_county',{
714 'state' => $self->state,
715 'county' => $self->county,
716 'country' => $self->country,
722 $self->ut_phonen('daytime', $self->country)
723 || $self->ut_phonen('night', $self->country)
724 || $self->ut_phonen('fax', $self->country)
725 || $self->ut_zip('zip', $self->country)
727 return $error if $error;
730 last first company address1 address2 city county state zip
731 country daytime night fax
734 if ( defined $self->dbdef_table->column('ship_last') ) {
735 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
737 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
741 $self->ut_name('ship_last')
742 || $self->ut_name('ship_first')
743 || $self->ut_textn('ship_company')
744 || $self->ut_text('ship_address1')
745 || $self->ut_textn('ship_address2')
746 || $self->ut_text('ship_city')
747 || $self->ut_textn('ship_county')
748 || $self->ut_textn('ship_state')
749 || $self->ut_country('ship_country')
751 return $error if $error;
753 #false laziness with above
754 unless ( qsearchs('cust_main_county', {
755 'country' => $self->ship_country,
758 return "Unknown ship_state/ship_county/ship_country: ".
759 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
760 unless qsearchs('cust_main_county',{
761 'state' => $self->ship_state,
762 'county' => $self->ship_county,
763 'country' => $self->ship_country,
769 $self->ut_phonen('ship_daytime', $self->ship_country)
770 || $self->ut_phonen('ship_night', $self->ship_country)
771 || $self->ut_phonen('ship_fax', $self->ship_country)
772 || $self->ut_zip('ship_zip', $self->ship_country)
774 return $error if $error;
776 } else { # ship_ info eq billing info, so don't store dup info in database
777 $self->setfield("ship_$_", '')
778 foreach qw( last first company address1 address2 city county state zip
779 country daytime night fax );
783 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
784 or return "Illegal payby: ". $self->payby;
787 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
789 my $payinfo = $self->payinfo;
791 $payinfo =~ /^(\d{13,16})$/
792 or return gettext('invalid_card'); # . ": ". $self->payinfo;
794 $self->payinfo($payinfo);
796 or return gettext('invalid_card'); # . ": ". $self->payinfo;
797 return gettext('unknown_card_type')
798 if cardtype($self->payinfo) eq "Unknown";
799 if ( defined $self->dbdef_table->column('paycvv') ) {
800 if ( length($self->paycvv) ) {
801 if ( cardtype($self->payinfo) eq 'American Express card' ) {
802 $self->paycvv =~ /^(\d{4})$/
803 or return "CVV2 (CID) for American Express cards is four digits.";
806 $self->paycvv =~ /^(\d{3})$/
807 or return "CVV2 (CVC2/CID) is three digits.";
815 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
817 my $payinfo = $self->payinfo;
818 $payinfo =~ s/[^\d\@]//g;
819 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
821 $self->payinfo($payinfo);
822 $self->paycvv('') if $self->dbdef_table->column('paycvv');
824 } elsif ( $self->payby eq 'LECB' ) {
826 my $payinfo = $self->payinfo;
828 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
830 $self->payinfo($payinfo);
831 $self->paycvv('') if $self->dbdef_table->column('paycvv');
833 } elsif ( $self->payby eq 'BILL' ) {
835 $error = $self->ut_textn('payinfo');
836 return "Illegal P.O. number: ". $self->payinfo if $error;
837 $self->paycvv('') if $self->dbdef_table->column('paycvv');
839 } elsif ( $self->payby eq 'COMP' ) {
841 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
842 return "You are not permitted to create complimentary accounts."
843 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
846 $error = $self->ut_textn('payinfo');
847 return "Illegal comp account issuer: ". $self->payinfo if $error;
848 $self->paycvv('') if $self->dbdef_table->column('paycvv');
850 } elsif ( $self->payby eq 'PREPAY' ) {
852 my $payinfo = $self->payinfo;
853 $payinfo =~ s/\W//g; #anything else would just confuse things
854 $self->payinfo($payinfo);
855 $error = $self->ut_alpha('payinfo');
856 return "Illegal prepayment identifier: ". $self->payinfo if $error;
857 return "Unknown prepayment identifier"
858 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
859 $self->paycvv('') if $self->dbdef_table->column('paycvv');
863 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
864 return "Expriation date required"
865 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
869 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
870 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
871 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
872 ( $m, $y ) = ( $3, "20$2" );
874 return "Illegal expiration date: ". $self->paydate;
876 $self->paydate("$y-$m-01");
877 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
878 return gettext('expired_card')
879 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
882 if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
883 ( ! $conf->exists('require_cardname')
884 || $self->payby !~ /^(CARD|DCRD)$/ )
886 $self->payname( $self->first. " ". $self->getfield('last') );
888 $self->payname =~ /^([\w \,\.\-\']+)$/
889 or return gettext('illegal_name'). " payname: ". $self->payname;
893 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
896 $self->otaker(getotaker) unless $self->otaker;
898 #warn "AFTER: \n". $self->_dump;
905 Returns all packages (see L<FS::cust_pkg>) for this customer.
911 if ( $self->{'_pkgnum'} ) {
912 values %{ $self->{'_pkgnum'}->cache };
914 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
918 =item ncancelled_pkgs
920 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
924 sub ncancelled_pkgs {
926 if ( $self->{'_pkgnum'} ) {
927 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
929 @{ [ # force list context
930 qsearch( 'cust_pkg', {
931 'custnum' => $self->custnum,
934 qsearch( 'cust_pkg', {
935 'custnum' => $self->custnum,
944 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
950 grep { $_->susp } $self->ncancelled_pkgs;
953 =item unflagged_suspended_pkgs
955 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
956 customer (thouse packages without the `manual_flag' set).
960 sub unflagged_suspended_pkgs {
962 return $self->suspended_pkgs
963 unless dbdef->table('cust_pkg')->column('manual_flag');
964 grep { ! $_->manual_flag } $self->suspended_pkgs;
967 =item unsuspended_pkgs
969 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
974 sub unsuspended_pkgs {
976 grep { ! $_->susp } $self->ncancelled_pkgs;
981 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
982 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
983 on success or a list of errors.
989 grep { $_->unsuspend } $self->suspended_pkgs;
994 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
995 Always returns a list: an empty list on success or a list of errors.
1001 grep { $_->suspend } $self->unsuspended_pkgs;
1004 =item cancel [ OPTION => VALUE ... ]
1006 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1008 Available options are: I<quiet>
1010 I<quiet> can be set true to supress email cancellation notices.
1012 Always returns a list: an empty list on success or a list of errors.
1018 grep { $_->cancel(@_) } $self->ncancelled_pkgs;
1023 Returns the agent (see L<FS::agent>) for this customer.
1029 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1034 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1035 conjunction with the collect method.
1037 Options are passed as name-value pairs.
1039 Currently available options are:
1041 resetup - if set true, re-charges setup fees.
1043 time - bills the customer as if it were that time. Specified as a UNIX
1044 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1045 L<Date::Parse> for conversion functions. For example:
1049 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1052 If there is an error, returns the error, otherwise returns false.
1057 my( $self, %options ) = @_;
1058 my $time = $options{'time'} || time;
1063 local $SIG{HUP} = 'IGNORE';
1064 local $SIG{INT} = 'IGNORE';
1065 local $SIG{QUIT} = 'IGNORE';
1066 local $SIG{TERM} = 'IGNORE';
1067 local $SIG{TSTP} = 'IGNORE';
1068 local $SIG{PIPE} = 'IGNORE';
1070 my $oldAutoCommit = $FS::UID::AutoCommit;
1071 local $FS::UID::AutoCommit = 0;
1074 # find the packages which are due for billing, find out how much they are
1075 # & generate invoice database.
1077 my( $total_setup, $total_recur ) = ( 0, 0 );
1078 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1079 my @cust_bill_pkg = ();
1081 #my $taxable_charged = 0;##
1086 foreach my $cust_pkg (
1087 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1090 #NO!! next if $cust_pkg->cancel;
1091 next if $cust_pkg->getfield('cancel');
1093 #? to avoid use of uninitialized value errors... ?
1094 $cust_pkg->setfield('bill', '')
1095 unless defined($cust_pkg->bill);
1097 my $part_pkg = $cust_pkg->part_pkg;
1099 #so we don't modify cust_pkg record unnecessarily
1100 my $cust_pkg_mod_flag = 0;
1101 my %hash = $cust_pkg->hash;
1102 my $old_cust_pkg = new FS::cust_pkg \%hash;
1108 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1109 my $setup_prog = $part_pkg->getfield('setup');
1110 $setup_prog =~ /^(.*)$/ or do {
1111 $dbh->rollback if $oldAutoCommit;
1112 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1116 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1118 #my $cpt = new Safe;
1119 ##$cpt->permit(); #what is necessary?
1120 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1121 #$setup = $cpt->reval($setup_prog);
1122 $setup = eval $setup_prog;
1123 unless ( defined($setup) ) {
1124 $dbh->rollback if $oldAutoCommit;
1125 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1126 "(expression $setup_prog): $@";
1128 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1129 $cust_pkg_mod_flag=1;
1135 if ( $part_pkg->getfield('freq') ne '0' &&
1136 ! $cust_pkg->getfield('susp') &&
1137 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1139 my $recur_prog = $part_pkg->getfield('recur');
1140 $recur_prog =~ /^(.*)$/ or do {
1141 $dbh->rollback if $oldAutoCommit;
1142 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1146 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1148 # shared with $recur_prog
1149 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1151 #my $cpt = new Safe;
1152 ##$cpt->permit(); #what is necessary?
1153 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1154 #$recur = $cpt->reval($recur_prog);
1155 $recur = eval $recur_prog;
1156 unless ( defined($recur) ) {
1157 $dbh->rollback if $oldAutoCommit;
1158 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1159 "(expression $recur_prog): $@";
1161 #change this bit to use Date::Manip? CAREFUL with timezones (see
1162 # mailing list archive)
1163 my ($sec,$min,$hour,$mday,$mon,$year) =
1164 (localtime($sdate) )[0,1,2,3,4,5];
1166 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1167 # only for figuring next bill date, nothing else, so, reset $sdate again
1169 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1170 $cust_pkg->last_bill($sdate)
1171 if $cust_pkg->dbdef_table->column('last_bill');
1173 if ( $part_pkg->freq =~ /^\d+$/ ) {
1174 $mon += $part_pkg->freq;
1175 until ( $mon < 12 ) { $mon -= 12; $year++; }
1176 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1178 $mday += $weeks * 7;
1179 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1183 $dbh->rollback if $oldAutoCommit;
1184 return "unparsable frequency: ". $part_pkg->freq;
1186 $cust_pkg->setfield('bill',
1187 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1188 $cust_pkg_mod_flag = 1;
1191 warn "\$setup is undefined" unless defined($setup);
1192 warn "\$recur is undefined" unless defined($recur);
1193 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1195 if ( $cust_pkg_mod_flag ) {
1196 $error=$cust_pkg->replace($old_cust_pkg);
1197 if ( $error ) { #just in case
1198 $dbh->rollback if $oldAutoCommit;
1199 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1201 $setup = sprintf( "%.2f", $setup );
1202 $recur = sprintf( "%.2f", $recur );
1204 $dbh->rollback if $oldAutoCommit;
1205 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1208 $dbh->rollback if $oldAutoCommit;
1209 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1211 if ( $setup > 0 || $recur > 0 ) {
1212 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1213 'pkgnum' => $cust_pkg->pkgnum,
1217 'edate' => $cust_pkg->bill,
1218 'details' => \@details,
1220 push @cust_bill_pkg, $cust_bill_pkg;
1221 $total_setup += $setup;
1222 $total_recur += $recur;
1224 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1226 my @taxes = qsearch( 'cust_main_county', {
1227 'state' => $self->state,
1228 'county' => $self->county,
1229 'country' => $self->country,
1230 'taxclass' => $part_pkg->taxclass,
1233 @taxes = qsearch( 'cust_main_county', {
1234 'state' => $self->state,
1235 'county' => $self->county,
1236 'country' => $self->country,
1241 # maybe eliminate this entirely, along with all the 0% records
1243 $dbh->rollback if $oldAutoCommit;
1245 "fatal: can't find tax rate for state/county/country/taxclass ".
1246 join('/', ( map $self->$_(), qw(state county country) ),
1247 $part_pkg->taxclass ). "\n";
1250 foreach my $tax ( @taxes ) {
1252 my $taxable_charged = 0;
1253 $taxable_charged += $setup
1254 unless $part_pkg->setuptax =~ /^Y$/i
1255 || $tax->setuptax =~ /^Y$/i;
1256 $taxable_charged += $recur
1257 unless $part_pkg->recurtax =~ /^Y$/i
1258 || $tax->recurtax =~ /^Y$/i;
1259 next unless $taxable_charged;
1261 if ( $tax->exempt_amount > 0 ) {
1262 my ($mon,$year) = (localtime($sdate) )[4,5];
1264 my $freq = $part_pkg->freq || 1;
1265 if ( $freq !~ /(\d+)$/ ) {
1266 $dbh->rollback if $oldAutoCommit;
1267 return "daily/weekly package definitions not (yet?)".
1268 " compatible with monthly tax exemptions";
1270 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1271 foreach my $which_month ( 1 .. $freq ) {
1273 'custnum' => $self->custnum,
1274 'taxnum' => $tax->taxnum,
1275 'year' => 1900+$year,
1278 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1279 until ( $mon < 13 ) { $mon -= 12; $year++; }
1280 my $cust_tax_exempt =
1281 qsearchs('cust_tax_exempt', \%hash)
1282 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1283 my $remaining_exemption = sprintf("%.2f",
1284 $tax->exempt_amount - $cust_tax_exempt->amount );
1285 if ( $remaining_exemption > 0 ) {
1286 my $addl = $remaining_exemption > $taxable_per_month
1287 ? $taxable_per_month
1288 : $remaining_exemption;
1289 $taxable_charged -= $addl;
1290 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1291 $cust_tax_exempt->hash,
1293 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1295 $error = $new_cust_tax_exempt->exemptnum
1296 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1297 : $new_cust_tax_exempt->insert;
1299 $dbh->rollback if $oldAutoCommit;
1300 return "fatal: can't update cust_tax_exempt: $error";
1303 } # if $remaining_exemption > 0
1305 } #foreach $which_month
1307 } #if $tax->exempt_amount
1309 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1311 #$tax += $taxable_charged * $cust_main_county->tax / 100
1312 $tax{ $tax->taxname || 'Tax' } +=
1313 $taxable_charged * $tax->tax / 100
1315 } #foreach my $tax ( @taxes )
1317 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1319 } #if $setup > 0 || $recur > 0
1321 } #if $cust_pkg_mod_flag
1323 } #foreach my $cust_pkg
1325 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1326 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1328 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1329 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1333 # unless ( $self->tax =~ /Y/i
1334 # || $self->payby eq 'COMP'
1335 # || $taxable_charged == 0 ) {
1336 # my $cust_main_county = qsearchs('cust_main_county',{
1337 # 'state' => $self->state,
1338 # 'county' => $self->county,
1339 # 'country' => $self->country,
1340 # } ) or die "fatal: can't find tax rate for state/county/country ".
1341 # $self->state. "/". $self->county. "/". $self->country. "\n";
1342 # my $tax = sprintf( "%.2f",
1343 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1346 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1348 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1349 my $tax = sprintf("%.2f", $tax{$taxname} );
1350 $charged = sprintf( "%.2f", $charged+$tax );
1352 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1358 'itemdesc' => $taxname,
1360 push @cust_bill_pkg, $cust_bill_pkg;
1363 } else { #1.4 schema
1366 foreach ( values %tax ) { $tax += $_ };
1367 $tax = sprintf("%.2f", $tax);
1369 $charged = sprintf( "%.2f", $charged+$tax );
1371 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1378 push @cust_bill_pkg, $cust_bill_pkg;
1383 my $cust_bill = new FS::cust_bill ( {
1384 'custnum' => $self->custnum,
1386 'charged' => $charged,
1388 $error = $cust_bill->insert;
1390 $dbh->rollback if $oldAutoCommit;
1391 return "can't create invoice for customer #". $self->custnum. ": $error";
1394 my $invnum = $cust_bill->invnum;
1396 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1398 $cust_bill_pkg->invnum($invnum);
1399 $error = $cust_bill_pkg->insert;
1401 $dbh->rollback if $oldAutoCommit;
1402 return "can't create invoice line item for customer #". $self->custnum.
1407 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1411 =item collect OPTIONS
1413 (Attempt to) collect money for this customer's outstanding invoices (see
1414 L<FS::cust_bill>). Usually used after the bill method.
1416 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1417 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1418 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1420 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1421 and the invoice events web interface.
1423 If there is an error, returns the error, otherwise returns false.
1425 Options are passed as name-value pairs.
1427 Currently available options are:
1429 invoice_time - Use this time when deciding when to print invoices and
1430 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>
1431 for conversion functions.
1433 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1436 retry_card - Deprecated alias for 'retry'
1438 batch_card - This option is deprecated. See the invoice events web interface
1439 to control whether cards are batched or run against a realtime gateway.
1441 report_badcard - This option is deprecated.
1443 force_print - This option is deprecated; see the invoice events web interface.
1445 quiet - set true to surpress email card/ACH decline notices.
1450 my( $self, %options ) = @_;
1451 my $invoice_time = $options{'invoice_time'} || time;
1454 local $SIG{HUP} = 'IGNORE';
1455 local $SIG{INT} = 'IGNORE';
1456 local $SIG{QUIT} = 'IGNORE';
1457 local $SIG{TERM} = 'IGNORE';
1458 local $SIG{TSTP} = 'IGNORE';
1459 local $SIG{PIPE} = 'IGNORE';
1461 my $oldAutoCommit = $FS::UID::AutoCommit;
1462 local $FS::UID::AutoCommit = 0;
1465 my $balance = $self->balance;
1466 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1467 unless ( $balance > 0 ) { #redundant?????
1468 $dbh->rollback if $oldAutoCommit; #hmm
1472 if ( exists($options{'retry_card'}) ) {
1473 carp 'retry_card option passed to collect is deprecated; use retry';
1474 $options{'retry'} ||= $options{'retry_card'};
1476 if ( exists($options{'retry'}) && $options{'retry'} ) {
1477 my $error = $self->retry_realtime;
1479 $dbh->rollback if $oldAutoCommit;
1484 foreach my $cust_bill ( $self->open_cust_bill ) {
1486 # don't try to charge for the same invoice if it's already in a batch
1487 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1489 last if $self->balance <= 0;
1491 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1494 foreach my $part_bill_event (
1495 sort { $a->seconds <=> $b->seconds
1496 || $a->weight <=> $b->weight
1497 || $a->eventpart <=> $b->eventpart }
1498 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1499 && ! qsearchs( 'cust_bill_event', {
1500 'invnum' => $cust_bill->invnum,
1501 'eventpart' => $_->eventpart,
1505 qsearch('part_bill_event', { 'payby' => $self->payby,
1506 'disabled' => '', } )
1509 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1510 || $self->balance <= 0; # or if balance<=0
1512 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1514 my $cust_main = $self; #for callback
1518 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1519 $error = eval $part_bill_event->eventcode;
1523 my $statustext = '';
1527 } elsif ( $error ) {
1529 $statustext = $error;
1534 #add cust_bill_event
1535 my $cust_bill_event = new FS::cust_bill_event {
1536 'invnum' => $cust_bill->invnum,
1537 'eventpart' => $part_bill_event->eventpart,
1538 #'_date' => $invoice_time,
1540 'status' => $status,
1541 'statustext' => $statustext,
1543 $error = $cust_bill_event->insert;
1545 #$dbh->rollback if $oldAutoCommit;
1546 #return "error: $error";
1548 # gah, even with transactions.
1549 $dbh->commit if $oldAutoCommit; #well.
1550 my $e = 'WARNING: Event run but database not updated - '.
1551 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1552 ', eventpart '. $part_bill_event->eventpart.
1563 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1568 =item retry_realtime
1570 Schedules realtime credit card / electronic check / LEC billing events for
1571 for retry. Useful if card information has changed or manual retry is desired.
1572 The 'collect' method must be called to actually retry the transaction.
1574 Implementation details: For each of this customer's open invoices, changes
1575 the status of the first "done" (with statustext error) realtime processing
1580 sub retry_realtime {
1583 local $SIG{HUP} = 'IGNORE';
1584 local $SIG{INT} = 'IGNORE';
1585 local $SIG{QUIT} = 'IGNORE';
1586 local $SIG{TERM} = 'IGNORE';
1587 local $SIG{TSTP} = 'IGNORE';
1588 local $SIG{PIPE} = 'IGNORE';
1590 my $oldAutoCommit = $FS::UID::AutoCommit;
1591 local $FS::UID::AutoCommit = 0;
1594 foreach my $cust_bill (
1595 grep { $_->cust_bill_event }
1596 $self->open_cust_bill
1598 my @cust_bill_event =
1599 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1601 #$_->part_bill_event->plan eq 'realtime-card'
1602 $_->part_bill_event->eventcode =~
1603 /\$cust_bill\->realtime_(card|ach|lec)/
1604 && $_->status eq 'done'
1607 $cust_bill->cust_bill_event;
1608 next unless @cust_bill_event;
1609 my $error = $cust_bill_event[0]->retry;
1611 $dbh->rollback if $oldAutoCommit;
1612 return "error scheduling invoice event for retry: $error";
1617 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1622 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1624 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1625 via a Business::OnlinePayment realtime gateway. See
1626 L<http://420.am/business-onlinepayment> for supported gateways.
1628 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1630 Available options are: I<description>, I<invnum>, I<quiet>
1632 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1633 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1634 if set, will override the value from the customer record.
1636 I<description> is a free-text field passed to the gateway. It defaults to
1637 "Internet services".
1639 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1640 specified invoice. If you don't specify an I<invnum> you might want to
1641 call the B<apply_payments> method.
1643 I<quiet> can be set true to surpress email decline notices.
1645 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1650 my( $self, $method, $amount, %options ) = @_;
1652 warn "$self $method $amount\n";
1653 warn " $_ => $options{$_}\n" foreach keys %options;
1656 $options{'description'} ||= 'Internet services';
1659 die "Real-time processing not enabled\n"
1660 unless $conf->exists('business-onlinepayment');
1661 eval "use Business::OnlinePayment";
1665 $self->set( $_ => $options{$_} )
1666 foreach grep { exists($options{$_}) }
1667 qw( payname address1 address2 city state zip payinfo paydate );
1670 my $bop_config = 'business-onlinepayment';
1671 $bop_config .= '-ach'
1672 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1673 my ( $processor, $login, $password, $action, @bop_options ) =
1674 $conf->config($bop_config);
1675 $action ||= 'normal authorization';
1676 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1680 my $address = $self->address1;
1681 $address .= ", ". $self->address2 if $self->address2;
1683 my($payname, $payfirst, $paylast);
1684 if ( $self->payname && $method ne 'ECHECK' ) {
1685 $payname = $self->payname;
1686 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1687 or return "Illegal payname $payname";
1688 ($payfirst, $paylast) = ($1, $2);
1690 $payfirst = $self->getfield('first');
1691 $paylast = $self->getfield('last');
1692 $payname = "$payfirst $paylast";
1695 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1696 if ( $conf->exists('emailinvoiceauto')
1697 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1698 push @invoicing_list, $self->all_emails;
1700 my $email = $invoicing_list[0];
1703 if ( $method eq 'CC' ) {
1705 $content{card_number} = $self->payinfo;
1706 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1707 $content{expiration} = "$2/$1";
1709 $content{cvv2} = $self->paycvv
1710 if defined $self->dbdef_table->column('paycvv')
1711 && length($self->paycvv);
1713 $content{recurring_billing} = 'YES'
1714 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1716 'payinfo' => $self->payinfo, } );
1718 } elsif ( $method eq 'ECHECK' ) {
1719 my($account_number,$routing_code) = $self->payinfo;
1720 ( $content{account_number}, $content{routing_code} ) =
1721 split('@', $self->payinfo);
1722 $content{bank_name} = $self->payname;
1723 $content{account_type} = 'CHECKING';
1724 $content{account_name} = $payname;
1725 $content{customer_org} = $self->company ? 'B' : 'I';
1726 $content{customer_ssn} = $self->ss;
1727 } elsif ( $method eq 'LEC' ) {
1728 $content{phone} = $self->payinfo;
1733 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1736 new Business::OnlinePayment( $processor, @bop_options );
1737 $transaction->content(
1740 'password' => $password,
1741 'action' => $action1,
1742 'description' => $options{'description'},
1743 'amount' => $amount,
1744 'invoice_number' => $options{'invnum'},
1745 'customer_id' => $self->custnum,
1746 'last_name' => $paylast,
1747 'first_name' => $payfirst,
1749 'address' => $address,
1750 'city' => $self->city,
1751 'state' => $self->state,
1752 'zip' => $self->zip,
1753 'country' => $self->country,
1754 'referer' => 'http://cleanwhisker.420.am/',
1756 'phone' => $self->daytime || $self->night,
1759 $transaction->submit();
1761 if ( $transaction->is_success() && $action2 ) {
1762 my $auth = $transaction->authorization;
1763 my $ordernum = $transaction->can('order_number')
1764 ? $transaction->order_number
1768 new Business::OnlinePayment( $processor, @bop_options );
1775 password => $password,
1776 order_number => $ordernum,
1778 authorization => $auth,
1779 description => $options{'description'},
1782 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1783 transaction_sequence_num local_transaction_date
1784 local_transaction_time AVS_result_code )) {
1785 $capture{$field} = $transaction->$field() if $transaction->can($field);
1788 $capture->content( %capture );
1792 unless ( $capture->is_success ) {
1793 my $e = "Authorization sucessful but capture failed, custnum #".
1794 $self->custnum. ': '. $capture->result_code.
1795 ": ". $capture->error_message;
1802 #remove paycvv after initial transaction
1803 #make this disable-able via a config option if anyone insists?
1804 # (though that probably violates cardholder agreements)
1805 if ( defined $self->dbdef_table->column('paycvv')
1806 && length($self->paycvv)
1807 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1809 my $new = new FS::cust_main { $self->hash };
1811 my $error = $new->replace($self);
1813 warn "error removing cvv: $error\n";
1818 if ( $transaction->is_success() ) {
1820 my %method2payby = (
1826 my $cust_pay = new FS::cust_pay ( {
1827 'custnum' => $self->custnum,
1828 'invnum' => $options{'invnum'},
1831 'payby' => $method2payby{$method},
1832 'payinfo' => $self->payinfo,
1833 'paybatch' => "$processor:". $transaction->authorization,
1835 my $error = $cust_pay->insert;
1837 # gah, even with transactions.
1838 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1839 'error applying payment, invnum #' . $self->invnum.
1840 " ($processor): $error";
1849 my $perror = "$processor error: ". $transaction->error_message;
1851 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1852 && $conf->exists('emaildecline')
1853 && grep { $_ ne 'POST' } $self->invoicing_list
1854 && ! grep { $_ eq $transaction->error_message }
1855 $conf->config('emaildecline-exclude')
1857 my @templ = $conf->config('declinetemplate');
1858 my $template = new Text::Template (
1860 SOURCE => [ map "$_\n", @templ ],
1861 ) or return "($perror) can't create template: $Text::Template::ERROR";
1862 $template->compile()
1863 or return "($perror) can't compile template: $Text::Template::ERROR";
1865 my $templ_hash = { error => $transaction->error_message };
1867 my $error = send_email(
1868 'from' => $conf->config('invoice_from'),
1869 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1870 'subject' => 'Your payment could not be processed',
1871 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1874 $perror .= " (also received error sending decline notification: $error)"
1886 Returns the total owed for this customer on all invoices
1887 (see L<FS::cust_bill/owed>).
1893 $self->total_owed_date(2145859200); #12/31/2037
1896 =item total_owed_date TIME
1898 Returns the total owed for this customer on all invoices with date earlier than
1899 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1900 see L<Time::Local> and L<Date::Parse> for conversion functions.
1904 sub total_owed_date {
1908 foreach my $cust_bill (
1909 grep { $_->_date <= $time }
1910 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1912 $total_bill += $cust_bill->owed;
1914 sprintf( "%.2f", $total_bill );
1919 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1920 to outstanding invoice balances in chronological order and returns the value
1921 of any remaining unapplied credits available for refund
1922 (see L<FS::cust_refund>).
1929 return 0 unless $self->total_credited;
1931 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1932 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1934 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1935 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1939 foreach my $cust_bill ( @invoices ) {
1942 if ( !defined($credit) || $credit->credited == 0) {
1943 $credit = pop @credits or last;
1946 if ($cust_bill->owed >= $credit->credited) {
1947 $amount=$credit->credited;
1949 $amount=$cust_bill->owed;
1952 my $cust_credit_bill = new FS::cust_credit_bill ( {
1953 'crednum' => $credit->crednum,
1954 'invnum' => $cust_bill->invnum,
1955 'amount' => $amount,
1957 my $error = $cust_credit_bill->insert;
1958 die $error if $error;
1960 redo if ($cust_bill->owed > 0);
1964 return $self->total_credited;
1967 =item apply_payments
1969 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1970 to outstanding invoice balances in chronological order.
1972 #and returns the value of any remaining unapplied payments.
1976 sub apply_payments {
1981 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1982 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1984 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1985 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1989 foreach my $cust_bill ( @invoices ) {
1992 if ( !defined($payment) || $payment->unapplied == 0 ) {
1993 $payment = pop @payments or last;
1996 if ( $cust_bill->owed >= $payment->unapplied ) {
1997 $amount = $payment->unapplied;
1999 $amount = $cust_bill->owed;
2002 my $cust_bill_pay = new FS::cust_bill_pay ( {
2003 'paynum' => $payment->paynum,
2004 'invnum' => $cust_bill->invnum,
2005 'amount' => $amount,
2007 my $error = $cust_bill_pay->insert;
2008 die $error if $error;
2010 redo if ( $cust_bill->owed > 0);
2014 return $self->total_unapplied_payments;
2017 =item total_credited
2019 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2020 customer. See L<FS::cust_credit/credited>.
2024 sub total_credited {
2026 my $total_credit = 0;
2027 foreach my $cust_credit ( qsearch('cust_credit', {
2028 'custnum' => $self->custnum,
2030 $total_credit += $cust_credit->credited;
2032 sprintf( "%.2f", $total_credit );
2035 =item total_unapplied_payments
2037 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2038 See L<FS::cust_pay/unapplied>.
2042 sub total_unapplied_payments {
2044 my $total_unapplied = 0;
2045 foreach my $cust_pay ( qsearch('cust_pay', {
2046 'custnum' => $self->custnum,
2048 $total_unapplied += $cust_pay->unapplied;
2050 sprintf( "%.2f", $total_unapplied );
2055 Returns the balance for this customer (total_owed minus total_credited
2056 minus total_unapplied_payments).
2063 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2067 =item balance_date TIME
2069 Returns the balance for this customer, only considering invoices with date
2070 earlier than TIME (total_owed_date minus total_credited minus
2071 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2072 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2081 $self->total_owed_date($time)
2082 - $self->total_credited
2083 - $self->total_unapplied_payments
2087 =item invoicing_list [ ARRAYREF ]
2089 If an arguement is given, sets these email addresses as invoice recipients
2090 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2091 (except as warnings), so use check_invoicing_list first.
2093 Returns a list of email addresses (with svcnum entries expanded).
2095 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2096 check it without disturbing anything by passing nothing.
2098 This interface may change in the future.
2102 sub invoicing_list {
2103 my( $self, $arrayref ) = @_;
2105 my @cust_main_invoice;
2106 if ( $self->custnum ) {
2107 @cust_main_invoice =
2108 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2110 @cust_main_invoice = ();
2112 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2113 #warn $cust_main_invoice->destnum;
2114 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2115 #warn $cust_main_invoice->destnum;
2116 my $error = $cust_main_invoice->delete;
2117 warn $error if $error;
2120 if ( $self->custnum ) {
2121 @cust_main_invoice =
2122 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2124 @cust_main_invoice = ();
2126 my %seen = map { $_->address => 1 } @cust_main_invoice;
2127 foreach my $address ( @{$arrayref} ) {
2128 next if exists $seen{$address} && $seen{$address};
2129 $seen{$address} = 1;
2130 my $cust_main_invoice = new FS::cust_main_invoice ( {
2131 'custnum' => $self->custnum,
2134 my $error = $cust_main_invoice->insert;
2135 warn $error if $error;
2138 if ( $self->custnum ) {
2140 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2146 =item check_invoicing_list ARRAYREF
2148 Checks these arguements as valid input for the invoicing_list method. If there
2149 is an error, returns the error, otherwise returns false.
2153 sub check_invoicing_list {
2154 my( $self, $arrayref ) = @_;
2155 foreach my $address ( @{$arrayref} ) {
2156 my $cust_main_invoice = new FS::cust_main_invoice ( {
2157 'custnum' => $self->custnum,
2160 my $error = $self->custnum
2161 ? $cust_main_invoice->check
2162 : $cust_main_invoice->checkdest
2164 return $error if $error;
2169 =item set_default_invoicing_list
2171 Sets the invoicing list to all accounts associated with this customer,
2172 overwriting any previous invoicing list.
2176 sub set_default_invoicing_list {
2178 $self->invoicing_list($self->all_emails);
2183 Returns the email addresses of all accounts provisioned for this customer.
2190 foreach my $cust_pkg ( $self->all_pkgs ) {
2191 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2193 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2194 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2196 $list{$_}=1 foreach map { $_->email } @svc_acct;
2201 =item invoicing_list_addpost
2203 Adds postal invoicing to this customer. If this customer is already configured
2204 to receive postal invoices, does nothing.
2208 sub invoicing_list_addpost {
2210 return if grep { $_ eq 'POST' } $self->invoicing_list;
2211 my @invoicing_list = $self->invoicing_list;
2212 push @invoicing_list, 'POST';
2213 $self->invoicing_list(\@invoicing_list);
2216 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2218 Returns an array of customers referred by this customer (referral_custnum set
2219 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2220 customers referred by customers referred by this customer and so on, inclusive.
2221 The default behavior is DEPTH 1 (no recursion).
2225 sub referral_cust_main {
2227 my $depth = @_ ? shift : 1;
2228 my $exclude = @_ ? shift : {};
2231 map { $exclude->{$_->custnum}++; $_; }
2232 grep { ! $exclude->{ $_->custnum } }
2233 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2237 map { $_->referral_cust_main($depth-1, $exclude) }
2244 =item referral_cust_main_ncancelled
2246 Same as referral_cust_main, except only returns customers with uncancelled
2251 sub referral_cust_main_ncancelled {
2253 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2256 =item referral_cust_pkg [ DEPTH ]
2258 Like referral_cust_main, except returns a flat list of all unsuspended (and
2259 uncancelled) packages for each customer. The number of items in this list may
2260 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2264 sub referral_cust_pkg {
2266 my $depth = @_ ? shift : 1;
2268 map { $_->unsuspended_pkgs }
2269 grep { $_->unsuspended_pkgs }
2270 $self->referral_cust_main($depth);
2273 =item credit AMOUNT, REASON
2275 Applies a credit to this customer. If there is an error, returns the error,
2276 otherwise returns false.
2281 my( $self, $amount, $reason ) = @_;
2282 my $cust_credit = new FS::cust_credit {
2283 'custnum' => $self->custnum,
2284 'amount' => $amount,
2285 'reason' => $reason,
2287 $cust_credit->insert;
2290 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2292 Creates a one-time charge for this customer. If there is an error, returns
2293 the error, otherwise returns false.
2298 my ( $self, $amount ) = ( shift, shift );
2299 my $pkg = @_ ? shift : 'One-time charge';
2300 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2301 my $taxclass = @_ ? shift : '';
2303 local $SIG{HUP} = 'IGNORE';
2304 local $SIG{INT} = 'IGNORE';
2305 local $SIG{QUIT} = 'IGNORE';
2306 local $SIG{TERM} = 'IGNORE';
2307 local $SIG{TSTP} = 'IGNORE';
2308 local $SIG{PIPE} = 'IGNORE';
2310 my $oldAutoCommit = $FS::UID::AutoCommit;
2311 local $FS::UID::AutoCommit = 0;
2314 my $part_pkg = new FS::part_pkg ( {
2316 'comment' => $comment,
2321 'taxclass' => $taxclass,
2324 my $error = $part_pkg->insert;
2326 $dbh->rollback if $oldAutoCommit;
2330 my $pkgpart = $part_pkg->pkgpart;
2331 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2332 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2333 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2334 $error = $type_pkgs->insert;
2336 $dbh->rollback if $oldAutoCommit;
2341 my $cust_pkg = new FS::cust_pkg ( {
2342 'custnum' => $self->custnum,
2343 'pkgpart' => $pkgpart,
2346 $error = $cust_pkg->insert;
2348 $dbh->rollback if $oldAutoCommit;
2352 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2359 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2365 sort { $a->_date <=> $b->_date }
2366 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2369 =item open_cust_bill
2371 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2376 sub open_cust_bill {
2378 grep { $_->owed > 0 } $self->cust_bill;
2387 =item check_and_rebuild_fuzzyfiles
2391 sub check_and_rebuild_fuzzyfiles {
2392 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2393 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2394 or &rebuild_fuzzyfiles;
2397 =item rebuild_fuzzyfiles
2401 sub rebuild_fuzzyfiles {
2403 use Fcntl qw(:flock);
2405 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2409 open(LASTLOCK,">>$dir/cust_main.last")
2410 or die "can't open $dir/cust_main.last: $!";
2411 flock(LASTLOCK,LOCK_EX)
2412 or die "can't lock $dir/cust_main.last: $!";
2414 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2416 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2417 if defined dbdef->table('cust_main')->column('ship_last');
2419 open (LASTCACHE,">$dir/cust_main.last.tmp")
2420 or die "can't open $dir/cust_main.last.tmp: $!";
2421 print LASTCACHE join("\n", @all_last), "\n";
2422 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2424 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2429 open(COMPANYLOCK,">>$dir/cust_main.company")
2430 or die "can't open $dir/cust_main.company: $!";
2431 flock(COMPANYLOCK,LOCK_EX)
2432 or die "can't lock $dir/cust_main.company: $!";
2434 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2436 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2437 if defined dbdef->table('cust_main')->column('ship_last');
2439 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2440 or die "can't open $dir/cust_main.company.tmp: $!";
2441 print COMPANYCACHE join("\n", @all_company), "\n";
2442 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2444 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2454 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2455 open(LASTCACHE,"<$dir/cust_main.last")
2456 or die "can't open $dir/cust_main.last: $!";
2457 my @array = map { chomp; $_; } <LASTCACHE>;
2467 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2468 open(COMPANYCACHE,"<$dir/cust_main.company")
2469 or die "can't open $dir/cust_main.last: $!";
2470 my @array = map { chomp; $_; } <COMPANYCACHE>;
2475 =item append_fuzzyfiles LASTNAME COMPANY
2479 sub append_fuzzyfiles {
2480 my( $last, $company ) = @_;
2482 &check_and_rebuild_fuzzyfiles;
2484 use Fcntl qw(:flock);
2486 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2490 open(LAST,">>$dir/cust_main.last")
2491 or die "can't open $dir/cust_main.last: $!";
2493 or die "can't lock $dir/cust_main.last: $!";
2495 print LAST "$last\n";
2498 or die "can't unlock $dir/cust_main.last: $!";
2504 open(COMPANY,">>$dir/cust_main.company")
2505 or die "can't open $dir/cust_main.company: $!";
2506 flock(COMPANY,LOCK_EX)
2507 or die "can't lock $dir/cust_main.company: $!";
2509 print COMPANY "$company\n";
2511 flock(COMPANY,LOCK_UN)
2512 or die "can't unlock $dir/cust_main.company: $!";
2526 #warn join('-',keys %$param);
2527 my $fh = $param->{filehandle};
2528 my $agentnum = $param->{agentnum};
2529 my $refnum = $param->{refnum};
2530 my $pkgpart = $param->{pkgpart};
2531 my @fields = @{$param->{fields}};
2533 eval "use Date::Parse;";
2535 eval "use Text::CSV_XS;";
2538 my $csv = new Text::CSV_XS;
2545 local $SIG{HUP} = 'IGNORE';
2546 local $SIG{INT} = 'IGNORE';
2547 local $SIG{QUIT} = 'IGNORE';
2548 local $SIG{TERM} = 'IGNORE';
2549 local $SIG{TSTP} = 'IGNORE';
2550 local $SIG{PIPE} = 'IGNORE';
2552 my $oldAutoCommit = $FS::UID::AutoCommit;
2553 local $FS::UID::AutoCommit = 0;
2556 #while ( $columns = $csv->getline($fh) ) {
2558 while ( defined($line=<$fh>) ) {
2560 $csv->parse($line) or do {
2561 $dbh->rollback if $oldAutoCommit;
2562 return "can't parse: ". $csv->error_input();
2565 my @columns = $csv->fields();
2566 #warn join('-',@columns);
2569 agentnum => $agentnum,
2571 country => 'US', #default
2572 payby => 'BILL', #default
2573 paydate => '12/2037', #default
2575 my $billtime = time;
2576 my %cust_pkg = ( pkgpart => $pkgpart );
2577 foreach my $field ( @fields ) {
2578 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2579 #$cust_pkg{$1} = str2time( shift @$columns );
2580 if ( $1 eq 'setup' ) {
2581 $billtime = str2time(shift @columns);
2583 $cust_pkg{$1} = str2time( shift @columns );
2586 #$cust_main{$field} = shift @$columns;
2587 $cust_main{$field} = shift @columns;
2591 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2592 my $cust_main = new FS::cust_main ( \%cust_main );
2594 tie my %hash, 'Tie::RefHash'; #this part is important
2595 $hash{$cust_pkg} = [] if $pkgpart;
2596 my $error = $cust_main->insert( \%hash );
2599 $dbh->rollback if $oldAutoCommit;
2600 return "can't insert customer for $line: $error";
2603 #false laziness w/bill.cgi
2604 $error = $cust_main->bill( 'time' => $billtime );
2606 $dbh->rollback if $oldAutoCommit;
2607 return "can't bill customer for $line: $error";
2610 $cust_main->apply_payments;
2611 $cust_main->apply_credits;
2613 $error = $cust_main->collect();
2615 $dbh->rollback if $oldAutoCommit;
2616 return "can't collect customer for $line: $error";
2622 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2624 return "Empty file!" unless $imported;
2636 #warn join('-',keys %$param);
2637 my $fh = $param->{filehandle};
2638 my @fields = @{$param->{fields}};
2640 eval "use Date::Parse;";
2642 eval "use Text::CSV_XS;";
2645 my $csv = new Text::CSV_XS;
2652 local $SIG{HUP} = 'IGNORE';
2653 local $SIG{INT} = 'IGNORE';
2654 local $SIG{QUIT} = 'IGNORE';
2655 local $SIG{TERM} = 'IGNORE';
2656 local $SIG{TSTP} = 'IGNORE';
2657 local $SIG{PIPE} = 'IGNORE';
2659 my $oldAutoCommit = $FS::UID::AutoCommit;
2660 local $FS::UID::AutoCommit = 0;
2663 #while ( $columns = $csv->getline($fh) ) {
2665 while ( defined($line=<$fh>) ) {
2667 $csv->parse($line) or do {
2668 $dbh->rollback if $oldAutoCommit;
2669 return "can't parse: ". $csv->error_input();
2672 my @columns = $csv->fields();
2673 #warn join('-',@columns);
2676 foreach my $field ( @fields ) {
2677 $row{$field} = shift @columns;
2680 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2681 unless ( $cust_main ) {
2682 $dbh->rollback if $oldAutoCommit;
2683 return "unknown custnum $row{'custnum'}";
2686 if ( $row{'amount'} > 0 ) {
2687 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2689 $dbh->rollback if $oldAutoCommit;
2693 } elsif ( $row{'amount'} < 0 ) {
2694 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2697 $dbh->rollback if $oldAutoCommit;
2707 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2709 return "Empty file!" unless $imported;
2721 The delete method should possibly take an FS::cust_main object reference
2722 instead of a scalar customer number.
2724 Bill and collect options should probably be passed as references instead of a
2727 There should probably be a configuration file with a list of allowed credit
2730 No multiple currency support (probably a larger project than just this module).
2734 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2735 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2736 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.