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->cust_bill ) {
1486 #this has to be before next's
1487 my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1491 $balance = sprintf( "%.2f", $balance - $amount );
1493 next unless $cust_bill->owed > 0;
1495 # don't try to charge for the same invoice if it's already in a batch
1496 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1498 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1500 next unless $amount > 0;
1503 foreach my $part_bill_event (
1504 sort { $a->seconds <=> $b->seconds
1505 || $a->weight <=> $b->weight
1506 || $a->eventpart <=> $b->eventpart }
1507 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1508 && ! qsearchs( 'cust_bill_event', {
1509 'invnum' => $cust_bill->invnum,
1510 'eventpart' => $_->eventpart,
1514 qsearch('part_bill_event', { 'payby' => $self->payby,
1515 'disabled' => '', } )
1518 last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1520 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1522 my $cust_main = $self; #for callback
1526 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1527 $error = eval $part_bill_event->eventcode;
1531 my $statustext = '';
1535 } elsif ( $error ) {
1537 $statustext = $error;
1542 #add cust_bill_event
1543 my $cust_bill_event = new FS::cust_bill_event {
1544 'invnum' => $cust_bill->invnum,
1545 'eventpart' => $part_bill_event->eventpart,
1546 #'_date' => $invoice_time,
1548 'status' => $status,
1549 'statustext' => $statustext,
1551 $error = $cust_bill_event->insert;
1553 #$dbh->rollback if $oldAutoCommit;
1554 #return "error: $error";
1556 # gah, even with transactions.
1557 $dbh->commit if $oldAutoCommit; #well.
1558 my $e = 'WARNING: Event run but database not updated - '.
1559 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1560 ', eventpart '. $part_bill_event->eventpart.
1571 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1576 =item retry_realtime
1578 Schedules realtime credit card / electronic check / LEC billing events for
1579 for retry. Useful if card information has changed or manual retry is desired.
1580 The 'collect' method must be called to actually retry the transaction.
1582 Implementation details: For each of this customer's open invoices, changes
1583 the status of the first "done" (with statustext error) realtime processing
1588 sub retry_realtime {
1591 local $SIG{HUP} = 'IGNORE';
1592 local $SIG{INT} = 'IGNORE';
1593 local $SIG{QUIT} = 'IGNORE';
1594 local $SIG{TERM} = 'IGNORE';
1595 local $SIG{TSTP} = 'IGNORE';
1596 local $SIG{PIPE} = 'IGNORE';
1598 my $oldAutoCommit = $FS::UID::AutoCommit;
1599 local $FS::UID::AutoCommit = 0;
1602 foreach my $cust_bill (
1603 grep { $_->cust_bill_event }
1604 $self->open_cust_bill
1606 my @cust_bill_event =
1607 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1609 #$_->part_bill_event->plan eq 'realtime-card'
1610 $_->part_bill_event->eventcode =~
1611 /\$cust_bill\->realtime_(card|ach|lec)/
1612 && $_->status eq 'done'
1615 $cust_bill->cust_bill_event;
1616 next unless @cust_bill_event;
1617 my $error = $cust_bill_event[0]->retry;
1619 $dbh->rollback if $oldAutoCommit;
1620 return "error scheduling invoice event for retry: $error";
1625 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1630 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1632 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1633 via a Business::OnlinePayment realtime gateway. See
1634 L<http://420.am/business-onlinepayment> for supported gateways.
1636 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1638 Available options are: I<description>, I<invnum>, I<quiet>
1640 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1641 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1642 if set, will override the value from the customer record.
1644 I<description> is a free-text field passed to the gateway. It defaults to
1645 "Internet services".
1647 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1648 specified invoice. If you don't specify an I<invnum> you might want to
1649 call the B<apply_payments> method.
1651 I<quiet> can be set true to surpress email decline notices.
1653 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1658 my( $self, $method, $amount, %options ) = @_;
1660 warn "$self $method $amount\n";
1661 warn " $_ => $options{$_}\n" foreach keys %options;
1664 $options{'description'} ||= 'Internet services';
1667 die "Real-time processing not enabled\n"
1668 unless $conf->exists('business-onlinepayment');
1669 eval "use Business::OnlinePayment";
1673 $self->set( $_ => $options{$_} )
1674 foreach grep { exists($options{$_}) }
1675 qw( payname address1 address2 city state zip payinfo paydate );
1678 my $bop_config = 'business-onlinepayment';
1679 $bop_config .= '-ach'
1680 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1681 my ( $processor, $login, $password, $action, @bop_options ) =
1682 $conf->config($bop_config);
1683 $action ||= 'normal authorization';
1684 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1688 my $address = $self->address1;
1689 $address .= ", ". $self->address2 if $self->address2;
1691 my($payname, $payfirst, $paylast);
1692 if ( $self->payname && $method ne 'ECHECK' ) {
1693 $payname = $self->payname;
1694 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1695 or return "Illegal payname $payname";
1696 ($payfirst, $paylast) = ($1, $2);
1698 $payfirst = $self->getfield('first');
1699 $paylast = $self->getfield('last');
1700 $payname = "$payfirst $paylast";
1703 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1704 if ( $conf->exists('emailinvoiceauto')
1705 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1706 push @invoicing_list, $self->all_emails;
1708 my $email = $invoicing_list[0];
1711 if ( $method eq 'CC' ) {
1713 $content{card_number} = $self->payinfo;
1714 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1715 $content{expiration} = "$2/$1";
1717 $content{cvv2} = $self->paycvv
1718 if defined $self->dbdef_table->column('paycvv')
1719 && length($self->paycvv);
1721 $content{recurring_billing} = 'YES'
1722 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1724 'payinfo' => $self->payinfo, } );
1726 } elsif ( $method eq 'ECHECK' ) {
1727 my($account_number,$routing_code) = $self->payinfo;
1728 ( $content{account_number}, $content{routing_code} ) =
1729 split('@', $self->payinfo);
1730 $content{bank_name} = $self->payname;
1731 $content{account_type} = 'CHECKING';
1732 $content{account_name} = $payname;
1733 $content{customer_org} = $self->company ? 'B' : 'I';
1734 $content{customer_ssn} = $self->ss;
1735 } elsif ( $method eq 'LEC' ) {
1736 $content{phone} = $self->payinfo;
1741 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1744 new Business::OnlinePayment( $processor, @bop_options );
1745 $transaction->content(
1748 'password' => $password,
1749 'action' => $action1,
1750 'description' => $options{'description'},
1751 'amount' => $amount,
1752 'invoice_number' => $options{'invnum'},
1753 'customer_id' => $self->custnum,
1754 'last_name' => $paylast,
1755 'first_name' => $payfirst,
1757 'address' => $address,
1758 'city' => $self->city,
1759 'state' => $self->state,
1760 'zip' => $self->zip,
1761 'country' => $self->country,
1762 'referer' => 'http://cleanwhisker.420.am/',
1764 'phone' => $self->daytime || $self->night,
1767 $transaction->submit();
1769 if ( $transaction->is_success() && $action2 ) {
1770 my $auth = $transaction->authorization;
1771 my $ordernum = $transaction->can('order_number')
1772 ? $transaction->order_number
1776 new Business::OnlinePayment( $processor, @bop_options );
1783 password => $password,
1784 order_number => $ordernum,
1786 authorization => $auth,
1787 description => $options{'description'},
1790 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1791 transaction_sequence_num local_transaction_date
1792 local_transaction_time AVS_result_code )) {
1793 $capture{$field} = $transaction->$field() if $transaction->can($field);
1796 $capture->content( %capture );
1800 unless ( $capture->is_success ) {
1801 my $e = "Authorization sucessful but capture failed, custnum #".
1802 $self->custnum. ': '. $capture->result_code.
1803 ": ". $capture->error_message;
1810 #remove paycvv after initial transaction
1811 #make this disable-able via a config option if anyone insists?
1812 # (though that probably violates cardholder agreements)
1813 if ( defined $self->dbdef_table->column('paycvv')
1814 && length($self->paycvv)
1815 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1817 my $new = new FS::cust_main { $self->hash };
1819 my $error = $new->replace($self);
1821 warn "error removing cvv: $error\n";
1826 if ( $transaction->is_success() ) {
1828 my %method2payby = (
1834 my $cust_pay = new FS::cust_pay ( {
1835 'custnum' => $self->custnum,
1836 'invnum' => $options{'invnum'},
1839 'payby' => $method2payby{$method},
1840 'payinfo' => $self->payinfo,
1841 'paybatch' => "$processor:". $transaction->authorization,
1843 my $error = $cust_pay->insert;
1845 # gah, even with transactions.
1846 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1847 'error applying payment, invnum #' . $self->invnum.
1848 " ($processor): $error";
1857 my $perror = "$processor error: ". $transaction->error_message;
1859 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1860 && $conf->exists('emaildecline')
1861 && grep { $_ ne 'POST' } $self->invoicing_list
1862 && ! grep { $_ eq $transaction->error_message }
1863 $conf->config('emaildecline-exclude')
1865 my @templ = $conf->config('declinetemplate');
1866 my $template = new Text::Template (
1868 SOURCE => [ map "$_\n", @templ ],
1869 ) or return "($perror) can't create template: $Text::Template::ERROR";
1870 $template->compile()
1871 or return "($perror) can't compile template: $Text::Template::ERROR";
1873 my $templ_hash = { error => $transaction->error_message };
1875 my $error = send_email(
1876 'from' => $conf->config('invoice_from'),
1877 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1878 'subject' => 'Your payment could not be processed',
1879 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1882 $perror .= " (also received error sending decline notification: $error)"
1894 Returns the total owed for this customer on all invoices
1895 (see L<FS::cust_bill/owed>).
1901 $self->total_owed_date(2145859200); #12/31/2037
1904 =item total_owed_date TIME
1906 Returns the total owed for this customer on all invoices with date earlier than
1907 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1908 see L<Time::Local> and L<Date::Parse> for conversion functions.
1912 sub total_owed_date {
1916 foreach my $cust_bill (
1917 grep { $_->_date <= $time }
1918 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1920 $total_bill += $cust_bill->owed;
1922 sprintf( "%.2f", $total_bill );
1927 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1928 to outstanding invoice balances in chronological order and returns the value
1929 of any remaining unapplied credits available for refund
1930 (see L<FS::cust_refund>).
1937 return 0 unless $self->total_credited;
1939 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1940 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1942 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1943 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1947 foreach my $cust_bill ( @invoices ) {
1950 if ( !defined($credit) || $credit->credited == 0) {
1951 $credit = pop @credits or last;
1954 if ($cust_bill->owed >= $credit->credited) {
1955 $amount=$credit->credited;
1957 $amount=$cust_bill->owed;
1960 my $cust_credit_bill = new FS::cust_credit_bill ( {
1961 'crednum' => $credit->crednum,
1962 'invnum' => $cust_bill->invnum,
1963 'amount' => $amount,
1965 my $error = $cust_credit_bill->insert;
1966 die $error if $error;
1968 redo if ($cust_bill->owed > 0);
1972 return $self->total_credited;
1975 =item apply_payments
1977 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1978 to outstanding invoice balances in chronological order.
1980 #and returns the value of any remaining unapplied payments.
1984 sub apply_payments {
1989 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1990 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1992 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1993 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1997 foreach my $cust_bill ( @invoices ) {
2000 if ( !defined($payment) || $payment->unapplied == 0 ) {
2001 $payment = pop @payments or last;
2004 if ( $cust_bill->owed >= $payment->unapplied ) {
2005 $amount = $payment->unapplied;
2007 $amount = $cust_bill->owed;
2010 my $cust_bill_pay = new FS::cust_bill_pay ( {
2011 'paynum' => $payment->paynum,
2012 'invnum' => $cust_bill->invnum,
2013 'amount' => $amount,
2015 my $error = $cust_bill_pay->insert;
2016 die $error if $error;
2018 redo if ( $cust_bill->owed > 0);
2022 return $self->total_unapplied_payments;
2025 =item total_credited
2027 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2028 customer. See L<FS::cust_credit/credited>.
2032 sub total_credited {
2034 my $total_credit = 0;
2035 foreach my $cust_credit ( qsearch('cust_credit', {
2036 'custnum' => $self->custnum,
2038 $total_credit += $cust_credit->credited;
2040 sprintf( "%.2f", $total_credit );
2043 =item total_unapplied_payments
2045 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2046 See L<FS::cust_pay/unapplied>.
2050 sub total_unapplied_payments {
2052 my $total_unapplied = 0;
2053 foreach my $cust_pay ( qsearch('cust_pay', {
2054 'custnum' => $self->custnum,
2056 $total_unapplied += $cust_pay->unapplied;
2058 sprintf( "%.2f", $total_unapplied );
2063 Returns the balance for this customer (total_owed minus total_credited
2064 minus total_unapplied_payments).
2071 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2075 =item balance_date TIME
2077 Returns the balance for this customer, only considering invoices with date
2078 earlier than TIME (total_owed_date minus total_credited minus
2079 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2080 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2089 $self->total_owed_date($time)
2090 - $self->total_credited
2091 - $self->total_unapplied_payments
2095 =item invoicing_list [ ARRAYREF ]
2097 If an arguement is given, sets these email addresses as invoice recipients
2098 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2099 (except as warnings), so use check_invoicing_list first.
2101 Returns a list of email addresses (with svcnum entries expanded).
2103 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2104 check it without disturbing anything by passing nothing.
2106 This interface may change in the future.
2110 sub invoicing_list {
2111 my( $self, $arrayref ) = @_;
2113 my @cust_main_invoice;
2114 if ( $self->custnum ) {
2115 @cust_main_invoice =
2116 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2118 @cust_main_invoice = ();
2120 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2121 #warn $cust_main_invoice->destnum;
2122 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2123 #warn $cust_main_invoice->destnum;
2124 my $error = $cust_main_invoice->delete;
2125 warn $error if $error;
2128 if ( $self->custnum ) {
2129 @cust_main_invoice =
2130 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2132 @cust_main_invoice = ();
2134 my %seen = map { $_->address => 1 } @cust_main_invoice;
2135 foreach my $address ( @{$arrayref} ) {
2136 next if exists $seen{$address} && $seen{$address};
2137 $seen{$address} = 1;
2138 my $cust_main_invoice = new FS::cust_main_invoice ( {
2139 'custnum' => $self->custnum,
2142 my $error = $cust_main_invoice->insert;
2143 warn $error if $error;
2146 if ( $self->custnum ) {
2148 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2154 =item check_invoicing_list ARRAYREF
2156 Checks these arguements as valid input for the invoicing_list method. If there
2157 is an error, returns the error, otherwise returns false.
2161 sub check_invoicing_list {
2162 my( $self, $arrayref ) = @_;
2163 foreach my $address ( @{$arrayref} ) {
2164 my $cust_main_invoice = new FS::cust_main_invoice ( {
2165 'custnum' => $self->custnum,
2168 my $error = $self->custnum
2169 ? $cust_main_invoice->check
2170 : $cust_main_invoice->checkdest
2172 return $error if $error;
2177 =item set_default_invoicing_list
2179 Sets the invoicing list to all accounts associated with this customer,
2180 overwriting any previous invoicing list.
2184 sub set_default_invoicing_list {
2186 $self->invoicing_list($self->all_emails);
2191 Returns the email addresses of all accounts provisioned for this customer.
2198 foreach my $cust_pkg ( $self->all_pkgs ) {
2199 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2201 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2202 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2204 $list{$_}=1 foreach map { $_->email } @svc_acct;
2209 =item invoicing_list_addpost
2211 Adds postal invoicing to this customer. If this customer is already configured
2212 to receive postal invoices, does nothing.
2216 sub invoicing_list_addpost {
2218 return if grep { $_ eq 'POST' } $self->invoicing_list;
2219 my @invoicing_list = $self->invoicing_list;
2220 push @invoicing_list, 'POST';
2221 $self->invoicing_list(\@invoicing_list);
2224 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2226 Returns an array of customers referred by this customer (referral_custnum set
2227 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2228 customers referred by customers referred by this customer and so on, inclusive.
2229 The default behavior is DEPTH 1 (no recursion).
2233 sub referral_cust_main {
2235 my $depth = @_ ? shift : 1;
2236 my $exclude = @_ ? shift : {};
2239 map { $exclude->{$_->custnum}++; $_; }
2240 grep { ! $exclude->{ $_->custnum } }
2241 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2245 map { $_->referral_cust_main($depth-1, $exclude) }
2252 =item referral_cust_main_ncancelled
2254 Same as referral_cust_main, except only returns customers with uncancelled
2259 sub referral_cust_main_ncancelled {
2261 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2264 =item referral_cust_pkg [ DEPTH ]
2266 Like referral_cust_main, except returns a flat list of all unsuspended (and
2267 uncancelled) packages for each customer. The number of items in this list may
2268 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2272 sub referral_cust_pkg {
2274 my $depth = @_ ? shift : 1;
2276 map { $_->unsuspended_pkgs }
2277 grep { $_->unsuspended_pkgs }
2278 $self->referral_cust_main($depth);
2281 =item credit AMOUNT, REASON
2283 Applies a credit to this customer. If there is an error, returns the error,
2284 otherwise returns false.
2289 my( $self, $amount, $reason ) = @_;
2290 my $cust_credit = new FS::cust_credit {
2291 'custnum' => $self->custnum,
2292 'amount' => $amount,
2293 'reason' => $reason,
2295 $cust_credit->insert;
2298 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2300 Creates a one-time charge for this customer. If there is an error, returns
2301 the error, otherwise returns false.
2306 my ( $self, $amount ) = ( shift, shift );
2307 my $pkg = @_ ? shift : 'One-time charge';
2308 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2309 my $taxclass = @_ ? shift : '';
2311 local $SIG{HUP} = 'IGNORE';
2312 local $SIG{INT} = 'IGNORE';
2313 local $SIG{QUIT} = 'IGNORE';
2314 local $SIG{TERM} = 'IGNORE';
2315 local $SIG{TSTP} = 'IGNORE';
2316 local $SIG{PIPE} = 'IGNORE';
2318 my $oldAutoCommit = $FS::UID::AutoCommit;
2319 local $FS::UID::AutoCommit = 0;
2322 my $part_pkg = new FS::part_pkg ( {
2324 'comment' => $comment,
2329 'taxclass' => $taxclass,
2332 my $error = $part_pkg->insert;
2334 $dbh->rollback if $oldAutoCommit;
2338 my $pkgpart = $part_pkg->pkgpart;
2339 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2340 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2341 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2342 $error = $type_pkgs->insert;
2344 $dbh->rollback if $oldAutoCommit;
2349 my $cust_pkg = new FS::cust_pkg ( {
2350 'custnum' => $self->custnum,
2351 'pkgpart' => $pkgpart,
2354 $error = $cust_pkg->insert;
2356 $dbh->rollback if $oldAutoCommit;
2360 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2367 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2373 sort { $a->_date <=> $b->_date }
2374 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2377 =item open_cust_bill
2379 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2384 sub open_cust_bill {
2386 grep { $_->owed > 0 } $self->cust_bill;
2395 =item check_and_rebuild_fuzzyfiles
2399 sub check_and_rebuild_fuzzyfiles {
2400 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2401 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2402 or &rebuild_fuzzyfiles;
2405 =item rebuild_fuzzyfiles
2409 sub rebuild_fuzzyfiles {
2411 use Fcntl qw(:flock);
2413 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2417 open(LASTLOCK,">>$dir/cust_main.last")
2418 or die "can't open $dir/cust_main.last: $!";
2419 flock(LASTLOCK,LOCK_EX)
2420 or die "can't lock $dir/cust_main.last: $!";
2422 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2424 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2425 if defined dbdef->table('cust_main')->column('ship_last');
2427 open (LASTCACHE,">$dir/cust_main.last.tmp")
2428 or die "can't open $dir/cust_main.last.tmp: $!";
2429 print LASTCACHE join("\n", @all_last), "\n";
2430 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2432 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2437 open(COMPANYLOCK,">>$dir/cust_main.company")
2438 or die "can't open $dir/cust_main.company: $!";
2439 flock(COMPANYLOCK,LOCK_EX)
2440 or die "can't lock $dir/cust_main.company: $!";
2442 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2444 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2445 if defined dbdef->table('cust_main')->column('ship_last');
2447 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2448 or die "can't open $dir/cust_main.company.tmp: $!";
2449 print COMPANYCACHE join("\n", @all_company), "\n";
2450 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2452 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2462 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2463 open(LASTCACHE,"<$dir/cust_main.last")
2464 or die "can't open $dir/cust_main.last: $!";
2465 my @array = map { chomp; $_; } <LASTCACHE>;
2475 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2476 open(COMPANYCACHE,"<$dir/cust_main.company")
2477 or die "can't open $dir/cust_main.last: $!";
2478 my @array = map { chomp; $_; } <COMPANYCACHE>;
2483 =item append_fuzzyfiles LASTNAME COMPANY
2487 sub append_fuzzyfiles {
2488 my( $last, $company ) = @_;
2490 &check_and_rebuild_fuzzyfiles;
2492 use Fcntl qw(:flock);
2494 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2498 open(LAST,">>$dir/cust_main.last")
2499 or die "can't open $dir/cust_main.last: $!";
2501 or die "can't lock $dir/cust_main.last: $!";
2503 print LAST "$last\n";
2506 or die "can't unlock $dir/cust_main.last: $!";
2512 open(COMPANY,">>$dir/cust_main.company")
2513 or die "can't open $dir/cust_main.company: $!";
2514 flock(COMPANY,LOCK_EX)
2515 or die "can't lock $dir/cust_main.company: $!";
2517 print COMPANY "$company\n";
2519 flock(COMPANY,LOCK_UN)
2520 or die "can't unlock $dir/cust_main.company: $!";
2534 #warn join('-',keys %$param);
2535 my $fh = $param->{filehandle};
2536 my $agentnum = $param->{agentnum};
2537 my $refnum = $param->{refnum};
2538 my $pkgpart = $param->{pkgpart};
2539 my @fields = @{$param->{fields}};
2541 eval "use Date::Parse;";
2543 eval "use Text::CSV_XS;";
2546 my $csv = new Text::CSV_XS;
2553 local $SIG{HUP} = 'IGNORE';
2554 local $SIG{INT} = 'IGNORE';
2555 local $SIG{QUIT} = 'IGNORE';
2556 local $SIG{TERM} = 'IGNORE';
2557 local $SIG{TSTP} = 'IGNORE';
2558 local $SIG{PIPE} = 'IGNORE';
2560 my $oldAutoCommit = $FS::UID::AutoCommit;
2561 local $FS::UID::AutoCommit = 0;
2564 #while ( $columns = $csv->getline($fh) ) {
2566 while ( defined($line=<$fh>) ) {
2568 $csv->parse($line) or do {
2569 $dbh->rollback if $oldAutoCommit;
2570 return "can't parse: ". $csv->error_input();
2573 my @columns = $csv->fields();
2574 #warn join('-',@columns);
2577 agentnum => $agentnum,
2579 country => 'US', #default
2580 payby => 'BILL', #default
2581 paydate => '12/2037', #default
2583 my $billtime = time;
2584 my %cust_pkg = ( pkgpart => $pkgpart );
2585 foreach my $field ( @fields ) {
2586 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2587 #$cust_pkg{$1} = str2time( shift @$columns );
2588 if ( $1 eq 'setup' ) {
2589 $billtime = str2time(shift @columns);
2591 $cust_pkg{$1} = str2time( shift @columns );
2594 #$cust_main{$field} = shift @$columns;
2595 $cust_main{$field} = shift @columns;
2599 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2600 my $cust_main = new FS::cust_main ( \%cust_main );
2602 tie my %hash, 'Tie::RefHash'; #this part is important
2603 $hash{$cust_pkg} = [] if $pkgpart;
2604 my $error = $cust_main->insert( \%hash );
2607 $dbh->rollback if $oldAutoCommit;
2608 return "can't insert customer for $line: $error";
2611 #false laziness w/bill.cgi
2612 $error = $cust_main->bill( 'time' => $billtime );
2614 $dbh->rollback if $oldAutoCommit;
2615 return "can't bill customer for $line: $error";
2618 $cust_main->apply_payments;
2619 $cust_main->apply_credits;
2621 $error = $cust_main->collect();
2623 $dbh->rollback if $oldAutoCommit;
2624 return "can't collect customer for $line: $error";
2630 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2632 return "Empty file!" unless $imported;
2644 #warn join('-',keys %$param);
2645 my $fh = $param->{filehandle};
2646 my @fields = @{$param->{fields}};
2648 eval "use Date::Parse;";
2650 eval "use Text::CSV_XS;";
2653 my $csv = new Text::CSV_XS;
2660 local $SIG{HUP} = 'IGNORE';
2661 local $SIG{INT} = 'IGNORE';
2662 local $SIG{QUIT} = 'IGNORE';
2663 local $SIG{TERM} = 'IGNORE';
2664 local $SIG{TSTP} = 'IGNORE';
2665 local $SIG{PIPE} = 'IGNORE';
2667 my $oldAutoCommit = $FS::UID::AutoCommit;
2668 local $FS::UID::AutoCommit = 0;
2671 #while ( $columns = $csv->getline($fh) ) {
2673 while ( defined($line=<$fh>) ) {
2675 $csv->parse($line) or do {
2676 $dbh->rollback if $oldAutoCommit;
2677 return "can't parse: ". $csv->error_input();
2680 my @columns = $csv->fields();
2681 #warn join('-',@columns);
2684 foreach my $field ( @fields ) {
2685 $row{$field} = shift @columns;
2688 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2689 unless ( $cust_main ) {
2690 $dbh->rollback if $oldAutoCommit;
2691 return "unknown custnum $row{'custnum'}";
2694 if ( $row{'amount'} > 0 ) {
2695 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2697 $dbh->rollback if $oldAutoCommit;
2701 } elsif ( $row{'amount'} < 0 ) {
2702 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2705 $dbh->rollback if $oldAutoCommit;
2715 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2717 return "Empty file!" unless $imported;
2729 The delete method should possibly take an FS::cust_main object reference
2730 instead of a scalar customer number.
2732 Bill and collect options should probably be passed as references instead of a
2735 There should probably be a configuration file with a list of allowed credit
2738 No multiple currency support (probably a larger project than just this module).
2742 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2743 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2744 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.