4 use vars qw( @ISA $conf $Debug $import );
5 use vars qw( $realtime_bop_decline_quiet ); #ugh
9 eval "use Time::Local;";
10 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
11 if $] < 5.006 && !defined($Time::Local::VERSION);
12 eval "use Time::Local qw(timelocal timelocal_nocheck);";
16 use Business::CreditCard;
17 use FS::UID qw( getotaker dbh );
18 use FS::Record qw( qsearchs qsearch dbdef );
19 use FS::Misc qw( send_email );
22 use FS::cust_bill_pkg;
26 use FS::part_referral;
27 use FS::cust_main_county;
29 use FS::cust_main_invoice;
30 use FS::cust_credit_bill;
31 use FS::cust_bill_pay;
32 use FS::prepay_credit;
35 use FS::part_bill_event;
36 use FS::cust_bill_event;
37 use FS::cust_tax_exempt;
39 use FS::Msgcat qw(gettext);
41 @ISA = qw( FS::Record );
43 $realtime_bop_decline_quiet = 0;
50 #ask FS::UID to run this stuff for us later
51 #$FS::UID::callback{'FS::cust_main'} = sub {
52 install_callback FS::UID sub {
54 #yes, need it for stuff below (prolly should be cached)
59 my ( $hashref, $cache ) = @_;
60 if ( exists $hashref->{'pkgnum'} ) {
61 # #@{ $self->{'_pkgnum'} } = ();
62 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
63 $self->{'_pkgnum'} = $subcache;
64 #push @{ $self->{'_pkgnum'} },
65 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
71 FS::cust_main - Object methods for cust_main records
77 $record = new FS::cust_main \%hash;
78 $record = new FS::cust_main { 'column' => 'value' };
80 $error = $record->insert;
82 $error = $new_record->replace($old_record);
84 $error = $record->delete;
86 $error = $record->check;
88 @cust_pkg = $record->all_pkgs;
90 @cust_pkg = $record->ncancelled_pkgs;
92 @cust_pkg = $record->suspended_pkgs;
94 $error = $record->bill;
95 $error = $record->bill %options;
96 $error = $record->bill 'time' => $time;
98 $error = $record->collect;
99 $error = $record->collect %options;
100 $error = $record->collect 'invoice_time' => $time,
101 'batch_card' => 'yes',
102 'report_badcard' => 'yes',
107 An FS::cust_main object represents a customer. FS::cust_main inherits from
108 FS::Record. The following fields are currently supported:
112 =item custnum - primary key (assigned automatically for new customers)
114 =item agentnum - agent (see L<FS::agent>)
116 =item refnum - Advertising source (see L<FS::part_referral>)
122 =item ss - social security number (optional)
124 =item company - (optional)
128 =item address2 - (optional)
132 =item county - (optional, see L<FS::cust_main_county>)
134 =item state - (see L<FS::cust_main_county>)
138 =item country - (see L<FS::cust_main_county>)
140 =item daytime - phone (optional)
142 =item night - phone (optional)
144 =item fax - phone (optional)
146 =item ship_first - name
148 =item ship_last - name
150 =item ship_company - (optional)
154 =item ship_address2 - (optional)
158 =item ship_county - (optional, see L<FS::cust_main_county>)
160 =item ship_state - (see L<FS::cust_main_county>)
164 =item ship_country - (see L<FS::cust_main_county>)
166 =item ship_daytime - phone (optional)
168 =item ship_night - phone (optional)
170 =item ship_fax - phone (optional)
172 =item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
174 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
176 =item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
178 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
180 =item payname - name on card or billing name
182 =item tax - tax exempt, empty or `Y'
184 =item otaker - order taker (assigned automatically, see L<FS::UID>)
186 =item comments - comments (optional)
188 =item referral_custnum - referring customer number
198 Creates a new customer. To add the customer to the database, see L<"insert">.
200 Note that this stores the hash reference, not a distinct copy of the hash it
201 points to. You can ask the object for a copy with the I<hash> method.
205 sub table { 'cust_main'; }
207 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
209 Adds this customer to the database. If there is an error, returns the error,
210 otherwise returns false.
212 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
213 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
214 are inserted atomicly, or the transaction is rolled back. Passing an empty
215 hash reference is equivalent to not supplying this parameter. There should be
216 a better explanation of this, but until then, here's an example:
219 tie %hash, 'Tie::RefHash'; #this part is important
221 $cust_pkg => [ $svc_acct ],
224 $cust_main->insert( \%hash );
226 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
227 be set as the invoicing list (see L<"invoicing_list">). Errors return as
228 expected and rollback the entire transaction; it is not necessary to call
229 check_invoicing_list first. The invoicing_list is set after the records in the
230 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
231 invoicing_list destination to the newly-created svc_acct. Here's an example:
233 $cust_main->insert( {}, [ $email, 'POST' ] );
235 Currently available options are: I<noexport>
237 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
238 (You can schedule them later with the B<reexport> method.)
244 my $cust_pkgs = @_ ? shift : {};
245 my $invoicing_list = @_ ? shift : '';
248 local $SIG{HUP} = 'IGNORE';
249 local $SIG{INT} = 'IGNORE';
250 local $SIG{QUIT} = 'IGNORE';
251 local $SIG{TERM} = 'IGNORE';
252 local $SIG{TSTP} = 'IGNORE';
253 local $SIG{PIPE} = 'IGNORE';
255 my $oldAutoCommit = $FS::UID::AutoCommit;
256 local $FS::UID::AutoCommit = 0;
261 if ( $self->payby eq 'PREPAY' ) {
262 $self->payby('BILL');
263 my $prepay_credit = qsearchs(
265 { 'identifier' => $self->payinfo },
269 warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
270 unless $prepay_credit;
271 $amount = $prepay_credit->amount;
272 $seconds = $prepay_credit->seconds;
273 my $error = $prepay_credit->delete;
275 $dbh->rollback if $oldAutoCommit;
276 return "removing prepay_credit (transaction rolled back): $error";
280 my $error = $self->SUPER::insert;
282 $dbh->rollback if $oldAutoCommit;
283 #return "inserting cust_main record (transaction rolled back): $error";
288 if ( $invoicing_list ) {
289 $error = $self->check_invoicing_list( $invoicing_list );
291 $dbh->rollback if $oldAutoCommit;
292 return "checking invoicing_list (transaction rolled back): $error";
294 $self->invoicing_list( $invoicing_list );
298 #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
299 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
301 $dbh->rollback if $oldAutoCommit;
306 $dbh->rollback if $oldAutoCommit;
307 return "No svc_acct record to apply pre-paid time";
311 my $cust_credit = new FS::cust_credit {
312 'custnum' => $self->custnum,
315 $error = $cust_credit->insert;
317 $dbh->rollback if $oldAutoCommit;
318 return "inserting credit (transaction rolled back): $error";
322 $error = $self->queue_fuzzyfiles_update;
324 $dbh->rollback if $oldAutoCommit;
325 return "updating fuzzy search cache: $error";
328 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
333 =item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
335 Like the insert method on an existing record, this method orders a package
336 and included services atomicaly. Pass a Tie::RefHash data structure to this
337 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
338 be a better explanation of this, but until then, here's an example:
341 tie %hash, 'Tie::RefHash'; #this part is important
343 $cust_pkg => [ $svc_acct ],
346 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
348 Currently available options are: I<noexport>
350 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
351 (You can schedule them later with the B<reexport> method for each
352 cust_pkg object. Using the B<reexport> method on the cust_main object is not
353 recommended, as existing services will also be reexported.)
359 my $cust_pkgs = shift;
363 local $SIG{HUP} = 'IGNORE';
364 local $SIG{INT} = 'IGNORE';
365 local $SIG{QUIT} = 'IGNORE';
366 local $SIG{TERM} = 'IGNORE';
367 local $SIG{TSTP} = 'IGNORE';
368 local $SIG{PIPE} = 'IGNORE';
370 my $oldAutoCommit = $FS::UID::AutoCommit;
371 local $FS::UID::AutoCommit = 0;
374 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
376 foreach my $cust_pkg ( keys %$cust_pkgs ) {
377 $cust_pkg->custnum( $self->custnum );
378 my $error = $cust_pkg->insert;
380 $dbh->rollback if $oldAutoCommit;
381 return "inserting cust_pkg (transaction rolled back): $error";
383 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
384 $svc_something->pkgnum( $cust_pkg->pkgnum );
385 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
386 $svc_something->seconds( $svc_something->seconds + $$seconds );
389 $error = $svc_something->insert;
391 $dbh->rollback if $oldAutoCommit;
392 #return "inserting svc_ (transaction rolled back): $error";
398 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
404 Re-schedules all exports by calling the B<reexport> method of all associated
405 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
406 otherwise returns false.
413 local $SIG{HUP} = 'IGNORE';
414 local $SIG{INT} = 'IGNORE';
415 local $SIG{QUIT} = 'IGNORE';
416 local $SIG{TERM} = 'IGNORE';
417 local $SIG{TSTP} = 'IGNORE';
418 local $SIG{PIPE} = 'IGNORE';
420 my $oldAutoCommit = $FS::UID::AutoCommit;
421 local $FS::UID::AutoCommit = 0;
424 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
425 my $error = $cust_pkg->reexport;
427 $dbh->rollback if $oldAutoCommit;
432 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
437 =item delete NEW_CUSTNUM
439 This deletes the customer. If there is an error, returns the error, otherwise
442 This will completely remove all traces of the customer record. This is not
443 what you want when a customer cancels service; for that, cancel all of the
444 customer's packages (see L</cancel>).
446 If the customer has any uncancelled packages, you need to pass a new (valid)
447 customer number for those packages to be transferred to. Cancelled packages
448 will be deleted. Did I mention that this is NOT what you want when a customer
449 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
451 You can't delete a customer with invoices (see L<FS::cust_bill>),
452 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
453 refunds (see L<FS::cust_refund>).
460 local $SIG{HUP} = 'IGNORE';
461 local $SIG{INT} = 'IGNORE';
462 local $SIG{QUIT} = 'IGNORE';
463 local $SIG{TERM} = 'IGNORE';
464 local $SIG{TSTP} = 'IGNORE';
465 local $SIG{PIPE} = 'IGNORE';
467 my $oldAutoCommit = $FS::UID::AutoCommit;
468 local $FS::UID::AutoCommit = 0;
471 if ( $self->cust_bill ) {
472 $dbh->rollback if $oldAutoCommit;
473 return "Can't delete a customer with invoices";
475 if ( $self->cust_credit ) {
476 $dbh->rollback if $oldAutoCommit;
477 return "Can't delete a customer with credits";
479 if ( $self->cust_pay ) {
480 $dbh->rollback if $oldAutoCommit;
481 return "Can't delete a customer with payments";
483 if ( $self->cust_refund ) {
484 $dbh->rollback if $oldAutoCommit;
485 return "Can't delete a customer with refunds";
488 my @cust_pkg = $self->ncancelled_pkgs;
490 my $new_custnum = shift;
491 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
492 $dbh->rollback if $oldAutoCommit;
493 return "Invalid new customer number: $new_custnum";
495 foreach my $cust_pkg ( @cust_pkg ) {
496 my %hash = $cust_pkg->hash;
497 $hash{'custnum'} = $new_custnum;
498 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
499 my $error = $new_cust_pkg->replace($cust_pkg);
501 $dbh->rollback if $oldAutoCommit;
506 my @cancelled_cust_pkg = $self->all_pkgs;
507 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
508 my $error = $cust_pkg->delete;
510 $dbh->rollback if $oldAutoCommit;
515 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
516 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
518 my $error = $cust_main_invoice->delete;
520 $dbh->rollback if $oldAutoCommit;
525 my $error = $self->SUPER::delete;
527 $dbh->rollback if $oldAutoCommit;
531 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
536 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
538 Replaces the OLD_RECORD with this one in the database. If there is an error,
539 returns the error, otherwise returns false.
541 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
542 be set as the invoicing list (see L<"invoicing_list">). Errors return as
543 expected and rollback the entire transaction; it is not necessary to call
544 check_invoicing_list first. Here's an example:
546 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
555 local $SIG{HUP} = 'IGNORE';
556 local $SIG{INT} = 'IGNORE';
557 local $SIG{QUIT} = 'IGNORE';
558 local $SIG{TERM} = 'IGNORE';
559 local $SIG{TSTP} = 'IGNORE';
560 local $SIG{PIPE} = 'IGNORE';
562 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
563 && $conf->config('users-allow_comp') ) {
564 return "You are not permitted to create complimentary accounts."
565 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
568 my $oldAutoCommit = $FS::UID::AutoCommit;
569 local $FS::UID::AutoCommit = 0;
572 my $error = $self->SUPER::replace($old);
575 $dbh->rollback if $oldAutoCommit;
579 if ( @param ) { # INVOICING_LIST_ARYREF
580 my $invoicing_list = shift @param;
581 $error = $self->check_invoicing_list( $invoicing_list );
583 $dbh->rollback if $oldAutoCommit;
586 $self->invoicing_list( $invoicing_list );
589 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
590 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
591 # card/check/lec info has changed, want to retry realtime_ invoice events
592 my $error = $self->retry_realtime;
594 $dbh->rollback if $oldAutoCommit;
599 $error = $self->queue_fuzzyfiles_update;
601 $dbh->rollback if $oldAutoCommit;
602 return "updating fuzzy search cache: $error";
605 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
610 =item queue_fuzzyfiles_update
612 Used by insert & replace to update the fuzzy search cache
616 sub queue_fuzzyfiles_update {
619 local $SIG{HUP} = 'IGNORE';
620 local $SIG{INT} = 'IGNORE';
621 local $SIG{QUIT} = 'IGNORE';
622 local $SIG{TERM} = 'IGNORE';
623 local $SIG{TSTP} = 'IGNORE';
624 local $SIG{PIPE} = 'IGNORE';
626 my $oldAutoCommit = $FS::UID::AutoCommit;
627 local $FS::UID::AutoCommit = 0;
630 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
631 my $error = $queue->insert($self->getfield('last'), $self->company);
633 $dbh->rollback if $oldAutoCommit;
634 return "queueing job (transaction rolled back): $error";
637 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
638 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
639 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
641 $dbh->rollback if $oldAutoCommit;
642 return "queueing job (transaction rolled back): $error";
646 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
653 Checks all fields to make sure this is a valid customer record. If there is
654 an error, returns the error, otherwise returns false. Called by the insert
662 #warn "BEFORE: \n". $self->_dump;
665 $self->ut_numbern('custnum')
666 || $self->ut_number('agentnum')
667 || $self->ut_number('refnum')
668 || $self->ut_name('last')
669 || $self->ut_name('first')
670 || $self->ut_textn('company')
671 || $self->ut_text('address1')
672 || $self->ut_textn('address2')
673 || $self->ut_text('city')
674 || $self->ut_textn('county')
675 || $self->ut_textn('state')
676 || $self->ut_country('country')
677 || $self->ut_anything('comments')
678 || $self->ut_numbern('referral_custnum')
680 #barf. need message catalogs. i18n. etc.
681 $error .= "Please select an advertising source."
682 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
683 return $error if $error;
685 return "Unknown agent"
686 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
688 return "Unknown refnum"
689 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
691 return "Unknown referring custnum ". $self->referral_custnum
692 unless ! $self->referral_custnum
693 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
695 if ( $self->ss eq '' ) {
700 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
701 or return "Illegal social security number: ". $self->ss;
702 $self->ss("$1-$2-$3");
706 # bad idea to disable, causes billing to fail because of no tax rates later
707 # unless ( $import ) {
708 unless ( qsearch('cust_main_county', {
709 'country' => $self->country,
712 return "Unknown state/county/country: ".
713 $self->state. "/". $self->county. "/". $self->country
714 unless qsearch('cust_main_county',{
715 'state' => $self->state,
716 'county' => $self->county,
717 'country' => $self->country,
723 $self->ut_phonen('daytime', $self->country)
724 || $self->ut_phonen('night', $self->country)
725 || $self->ut_phonen('fax', $self->country)
726 || $self->ut_zip('zip', $self->country)
728 return $error if $error;
731 last first company address1 address2 city county state zip
732 country daytime night fax
735 if ( defined $self->dbdef_table->column('ship_last') ) {
736 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
738 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
742 $self->ut_name('ship_last')
743 || $self->ut_name('ship_first')
744 || $self->ut_textn('ship_company')
745 || $self->ut_text('ship_address1')
746 || $self->ut_textn('ship_address2')
747 || $self->ut_text('ship_city')
748 || $self->ut_textn('ship_county')
749 || $self->ut_textn('ship_state')
750 || $self->ut_country('ship_country')
752 return $error if $error;
754 #false laziness with above
755 unless ( qsearchs('cust_main_county', {
756 'country' => $self->ship_country,
759 return "Unknown ship_state/ship_county/ship_country: ".
760 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
761 unless qsearchs('cust_main_county',{
762 'state' => $self->ship_state,
763 'county' => $self->ship_county,
764 'country' => $self->ship_country,
770 $self->ut_phonen('ship_daytime', $self->ship_country)
771 || $self->ut_phonen('ship_night', $self->ship_country)
772 || $self->ut_phonen('ship_fax', $self->ship_country)
773 || $self->ut_zip('ship_zip', $self->ship_country)
775 return $error if $error;
777 } else { # ship_ info eq billing info, so don't store dup info in database
778 $self->setfield("ship_$_", '')
779 foreach qw( last first company address1 address2 city county state zip
780 country daytime night fax );
784 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
785 or return "Illegal payby: ". $self->payby;
788 if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
790 my $payinfo = $self->payinfo;
792 $payinfo =~ /^(\d{13,16})$/
793 or return gettext('invalid_card'); # . ": ". $self->payinfo;
795 $self->payinfo($payinfo);
797 or return gettext('invalid_card'); # . ": ". $self->payinfo;
798 return gettext('unknown_card_type')
799 if cardtype($self->payinfo) eq "Unknown";
800 if ( defined $self->dbdef_table->column('paycvv') ) {
801 if ( length($self->paycvv) ) {
802 if ( cardtype($self->payinfo) eq 'American Express card' ) {
803 $self->paycvv =~ /^(\d{4})$/
804 or return "CVV2 (CID) for American Express cards is four digits.";
807 $self->paycvv =~ /^(\d{3})$/
808 or return "CVV2 (CVC2/CID) is three digits.";
816 } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
818 my $payinfo = $self->payinfo;
819 $payinfo =~ s/[^\d\@]//g;
820 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
822 $self->payinfo($payinfo);
823 $self->paycvv('') if $self->dbdef_table->column('paycvv');
825 } elsif ( $self->payby eq 'LECB' ) {
827 my $payinfo = $self->payinfo;
829 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
831 $self->payinfo($payinfo);
832 $self->paycvv('') if $self->dbdef_table->column('paycvv');
834 } elsif ( $self->payby eq 'BILL' ) {
836 $error = $self->ut_textn('payinfo');
837 return "Illegal P.O. number: ". $self->payinfo if $error;
838 $self->paycvv('') if $self->dbdef_table->column('paycvv');
840 } elsif ( $self->payby eq 'COMP' ) {
842 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
843 return "You are not permitted to create complimentary accounts."
844 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
847 $error = $self->ut_textn('payinfo');
848 return "Illegal comp account issuer: ". $self->payinfo if $error;
849 $self->paycvv('') if $self->dbdef_table->column('paycvv');
851 } elsif ( $self->payby eq 'PREPAY' ) {
853 my $payinfo = $self->payinfo;
854 $payinfo =~ s/\W//g; #anything else would just confuse things
855 $self->payinfo($payinfo);
856 $error = $self->ut_alpha('payinfo');
857 return "Illegal prepayment identifier: ". $self->payinfo if $error;
858 return "Unknown prepayment identifier"
859 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
860 $self->paycvv('') if $self->dbdef_table->column('paycvv');
864 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
865 return "Expriation date required"
866 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
870 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
871 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
872 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
873 ( $m, $y ) = ( $3, "20$2" );
875 return "Illegal expiration date: ". $self->paydate;
877 $self->paydate("$y-$m-01");
878 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
879 return gettext('expired_card')
880 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
883 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
884 ( ! $conf->exists('require_cardname')
885 || $self->payby !~ /^(CARD|DCRD)$/ )
887 $self->payname( $self->first. " ". $self->getfield('last') );
889 $self->payname =~ /^([\w \,\.\-\']+)$/
890 or return gettext('illegal_name'). " payname: ". $self->payname;
894 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
897 $self->otaker(getotaker) unless $self->otaker;
899 #warn "AFTER: \n". $self->_dump;
906 Returns all packages (see L<FS::cust_pkg>) for this customer.
912 if ( $self->{'_pkgnum'} ) {
913 values %{ $self->{'_pkgnum'}->cache };
915 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
919 =item ncancelled_pkgs
921 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
925 sub ncancelled_pkgs {
927 if ( $self->{'_pkgnum'} ) {
928 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
930 @{ [ # force list context
931 qsearch( 'cust_pkg', {
932 'custnum' => $self->custnum,
935 qsearch( 'cust_pkg', {
936 'custnum' => $self->custnum,
945 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
951 grep { $_->susp } $self->ncancelled_pkgs;
954 =item unflagged_suspended_pkgs
956 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
957 customer (thouse packages without the `manual_flag' set).
961 sub unflagged_suspended_pkgs {
963 return $self->suspended_pkgs
964 unless dbdef->table('cust_pkg')->column('manual_flag');
965 grep { ! $_->manual_flag } $self->suspended_pkgs;
968 =item unsuspended_pkgs
970 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
975 sub unsuspended_pkgs {
977 grep { ! $_->susp } $self->ncancelled_pkgs;
982 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
983 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
984 on success or a list of errors.
990 grep { $_->unsuspend } $self->suspended_pkgs;
995 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
996 Always returns a list: an empty list on success or a list of errors.
1002 grep { $_->suspend } $self->unsuspended_pkgs;
1005 =item cancel [ OPTION => VALUE ... ]
1007 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1009 Available options are: I<quiet>
1011 I<quiet> can be set true to supress email cancellation notices.
1013 Always returns a list: an empty list on success or a list of errors.
1019 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1024 Returns the agent (see L<FS::agent>) for this customer.
1030 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1035 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1036 conjunction with the collect method.
1038 Options are passed as name-value pairs.
1040 Currently available options are:
1042 resetup - if set true, re-charges setup fees.
1044 time - bills the customer as if it were that time. Specified as a UNIX
1045 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1046 L<Date::Parse> for conversion functions. For example:
1050 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1053 If there is an error, returns the error, otherwise returns false.
1058 my( $self, %options ) = @_;
1059 my $time = $options{'time'} || time;
1064 local $SIG{HUP} = 'IGNORE';
1065 local $SIG{INT} = 'IGNORE';
1066 local $SIG{QUIT} = 'IGNORE';
1067 local $SIG{TERM} = 'IGNORE';
1068 local $SIG{TSTP} = 'IGNORE';
1069 local $SIG{PIPE} = 'IGNORE';
1071 my $oldAutoCommit = $FS::UID::AutoCommit;
1072 local $FS::UID::AutoCommit = 0;
1075 # find the packages which are due for billing, find out how much they are
1076 # & generate invoice database.
1078 my( $total_setup, $total_recur ) = ( 0, 0 );
1079 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1080 my @cust_bill_pkg = ();
1082 #my $taxable_charged = 0;##
1087 foreach my $cust_pkg (
1088 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1091 #NO!! next if $cust_pkg->cancel;
1092 next if $cust_pkg->getfield('cancel');
1094 #? to avoid use of uninitialized value errors... ?
1095 $cust_pkg->setfield('bill', '')
1096 unless defined($cust_pkg->bill);
1098 my $part_pkg = $cust_pkg->part_pkg;
1100 #so we don't modify cust_pkg record unnecessarily
1101 my $cust_pkg_mod_flag = 0;
1102 my %hash = $cust_pkg->hash;
1103 my $old_cust_pkg = new FS::cust_pkg \%hash;
1109 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1110 my $setup_prog = $part_pkg->getfield('setup');
1111 $setup_prog =~ /^(.*)$/ or do {
1112 $dbh->rollback if $oldAutoCommit;
1113 return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1117 $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1119 #my $cpt = new Safe;
1120 ##$cpt->permit(); #what is necessary?
1121 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1122 #$setup = $cpt->reval($setup_prog);
1123 $setup = eval $setup_prog;
1124 unless ( defined($setup) ) {
1125 $dbh->rollback if $oldAutoCommit;
1126 return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1127 "(expression $setup_prog): $@";
1129 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1130 $cust_pkg_mod_flag=1;
1136 if ( $part_pkg->getfield('freq') ne '0' &&
1137 ! $cust_pkg->getfield('susp') &&
1138 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1140 my $recur_prog = $part_pkg->getfield('recur');
1141 $recur_prog =~ /^(.*)$/ or do {
1142 $dbh->rollback if $oldAutoCommit;
1143 return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1147 $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1149 # shared with $recur_prog
1150 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1152 #my $cpt = new Safe;
1153 ##$cpt->permit(); #what is necessary?
1154 #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1155 #$recur = $cpt->reval($recur_prog);
1156 $recur = eval $recur_prog;
1157 unless ( defined($recur) ) {
1158 $dbh->rollback if $oldAutoCommit;
1159 return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
1160 "(expression $recur_prog): $@";
1162 #change this bit to use Date::Manip? CAREFUL with timezones (see
1163 # mailing list archive)
1164 my ($sec,$min,$hour,$mday,$mon,$year) =
1165 (localtime($sdate) )[0,1,2,3,4,5];
1167 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1168 # only for figuring next bill date, nothing else, so, reset $sdate again
1170 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1171 $cust_pkg->last_bill($sdate)
1172 if $cust_pkg->dbdef_table->column('last_bill');
1174 if ( $part_pkg->freq =~ /^\d+$/ ) {
1175 $mon += $part_pkg->freq;
1176 until ( $mon < 12 ) { $mon -= 12; $year++; }
1177 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1179 $mday += $weeks * 7;
1180 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "unparsable frequency: ". $part_pkg->freq;
1187 $cust_pkg->setfield('bill',
1188 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1189 $cust_pkg_mod_flag = 1;
1192 warn "\$setup is undefined" unless defined($setup);
1193 warn "\$recur is undefined" unless defined($recur);
1194 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1196 if ( $cust_pkg_mod_flag ) {
1197 $error=$cust_pkg->replace($old_cust_pkg);
1198 if ( $error ) { #just in case
1199 $dbh->rollback if $oldAutoCommit;
1200 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1202 $setup = sprintf( "%.2f", $setup );
1203 $recur = sprintf( "%.2f", $recur );
1204 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1205 $dbh->rollback if $oldAutoCommit;
1206 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1208 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1209 $dbh->rollback if $oldAutoCommit;
1210 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1212 if ( $setup != 0 || $recur != 0 ) {
1213 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1214 'pkgnum' => $cust_pkg->pkgnum,
1218 'edate' => $cust_pkg->bill,
1219 'details' => \@details,
1221 push @cust_bill_pkg, $cust_bill_pkg;
1222 $total_setup += $setup;
1223 $total_recur += $recur;
1225 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1227 my @taxes = qsearch( 'cust_main_county', {
1228 'state' => $self->state,
1229 'county' => $self->county,
1230 'country' => $self->country,
1231 'taxclass' => $part_pkg->taxclass,
1234 @taxes = qsearch( 'cust_main_county', {
1235 'state' => $self->state,
1236 'county' => $self->county,
1237 'country' => $self->country,
1242 #one more try at a whole-country tax rate
1244 @taxes = qsearch( 'cust_main_county', {
1247 'country' => $self->country,
1252 # maybe eliminate this entirely, along with all the 0% records
1254 $dbh->rollback if $oldAutoCommit;
1256 "fatal: can't find tax rate for state/county/country/taxclass ".
1257 join('/', ( map $self->$_(), qw(state county country) ),
1258 $part_pkg->taxclass ). "\n";
1261 foreach my $tax ( @taxes ) {
1263 my $taxable_charged = 0;
1264 $taxable_charged += $setup
1265 unless $part_pkg->setuptax =~ /^Y$/i
1266 || $tax->setuptax =~ /^Y$/i;
1267 $taxable_charged += $recur
1268 unless $part_pkg->recurtax =~ /^Y$/i
1269 || $tax->recurtax =~ /^Y$/i;
1270 next unless $taxable_charged;
1272 if ( $tax->exempt_amount > 0 ) {
1273 my ($mon,$year) = (localtime($sdate) )[4,5];
1275 my $freq = $part_pkg->freq || 1;
1276 if ( $freq !~ /(\d+)$/ ) {
1277 $dbh->rollback if $oldAutoCommit;
1278 return "daily/weekly package definitions not (yet?)".
1279 " compatible with monthly tax exemptions";
1281 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1282 foreach my $which_month ( 1 .. $freq ) {
1284 'custnum' => $self->custnum,
1285 'taxnum' => $tax->taxnum,
1286 'year' => 1900+$year,
1289 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1290 until ( $mon < 13 ) { $mon -= 12; $year++; }
1291 my $cust_tax_exempt =
1292 qsearchs('cust_tax_exempt', \%hash)
1293 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1294 my $remaining_exemption = sprintf("%.2f",
1295 $tax->exempt_amount - $cust_tax_exempt->amount );
1296 if ( $remaining_exemption > 0 ) {
1297 my $addl = $remaining_exemption > $taxable_per_month
1298 ? $taxable_per_month
1299 : $remaining_exemption;
1300 $taxable_charged -= $addl;
1301 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1302 $cust_tax_exempt->hash,
1304 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1306 $error = $new_cust_tax_exempt->exemptnum
1307 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1308 : $new_cust_tax_exempt->insert;
1310 $dbh->rollback if $oldAutoCommit;
1311 return "fatal: can't update cust_tax_exempt: $error";
1314 } # if $remaining_exemption > 0
1316 } #foreach $which_month
1318 } #if $tax->exempt_amount
1320 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1322 #$tax += $taxable_charged * $cust_main_county->tax / 100
1323 $tax{ $tax->taxname || 'Tax' } +=
1324 $taxable_charged * $tax->tax / 100
1326 } #foreach my $tax ( @taxes )
1328 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1330 } #if $setup != 0 || $recur != 0
1332 } #if $cust_pkg_mod_flag
1334 } #foreach my $cust_pkg
1336 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1337 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1339 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1340 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1344 # unless ( $self->tax =~ /Y/i
1345 # || $self->payby eq 'COMP'
1346 # || $taxable_charged == 0 ) {
1347 # my $cust_main_county = qsearchs('cust_main_county',{
1348 # 'state' => $self->state,
1349 # 'county' => $self->county,
1350 # 'country' => $self->country,
1351 # } ) or die "fatal: can't find tax rate for state/county/country ".
1352 # $self->state. "/". $self->county. "/". $self->country. "\n";
1353 # my $tax = sprintf( "%.2f",
1354 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1357 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1359 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1360 my $tax = sprintf("%.2f", $tax{$taxname} );
1361 $charged = sprintf( "%.2f", $charged+$tax );
1363 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1369 'itemdesc' => $taxname,
1371 push @cust_bill_pkg, $cust_bill_pkg;
1374 } else { #1.4 schema
1377 foreach ( values %tax ) { $tax += $_ };
1378 $tax = sprintf("%.2f", $tax);
1380 $charged = sprintf( "%.2f", $charged+$tax );
1382 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1389 push @cust_bill_pkg, $cust_bill_pkg;
1394 my $cust_bill = new FS::cust_bill ( {
1395 'custnum' => $self->custnum,
1397 'charged' => $charged,
1399 $error = $cust_bill->insert;
1401 $dbh->rollback if $oldAutoCommit;
1402 return "can't create invoice for customer #". $self->custnum. ": $error";
1405 my $invnum = $cust_bill->invnum;
1407 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1409 $cust_bill_pkg->invnum($invnum);
1410 $error = $cust_bill_pkg->insert;
1412 $dbh->rollback if $oldAutoCommit;
1413 return "can't create invoice line item for customer #". $self->custnum.
1418 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1422 =item collect OPTIONS
1424 (Attempt to) collect money for this customer's outstanding invoices (see
1425 L<FS::cust_bill>). Usually used after the bill method.
1427 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1428 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1429 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1431 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1432 and the invoice events web interface.
1434 If there is an error, returns the error, otherwise returns false.
1436 Options are passed as name-value pairs.
1438 Currently available options are:
1440 invoice_time - Use this time when deciding when to print invoices and
1441 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>
1442 for conversion functions.
1444 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1447 retry_card - Deprecated alias for 'retry'
1449 batch_card - This option is deprecated. See the invoice events web interface
1450 to control whether cards are batched or run against a realtime gateway.
1452 report_badcard - This option is deprecated.
1454 force_print - This option is deprecated; see the invoice events web interface.
1456 quiet - set true to surpress email card/ACH decline notices.
1461 my( $self, %options ) = @_;
1462 my $invoice_time = $options{'invoice_time'} || time;
1465 local $SIG{HUP} = 'IGNORE';
1466 local $SIG{INT} = 'IGNORE';
1467 local $SIG{QUIT} = 'IGNORE';
1468 local $SIG{TERM} = 'IGNORE';
1469 local $SIG{TSTP} = 'IGNORE';
1470 local $SIG{PIPE} = 'IGNORE';
1472 my $oldAutoCommit = $FS::UID::AutoCommit;
1473 local $FS::UID::AutoCommit = 0;
1476 my $balance = $self->balance;
1477 warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1478 unless ( $balance > 0 ) { #redundant?????
1479 $dbh->rollback if $oldAutoCommit; #hmm
1483 if ( exists($options{'retry_card'}) ) {
1484 carp 'retry_card option passed to collect is deprecated; use retry';
1485 $options{'retry'} ||= $options{'retry_card'};
1487 if ( exists($options{'retry'}) && $options{'retry'} ) {
1488 my $error = $self->retry_realtime;
1490 $dbh->rollback if $oldAutoCommit;
1495 foreach my $cust_bill ( $self->open_cust_bill ) {
1497 # don't try to charge for the same invoice if it's already in a batch
1498 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1500 last if $self->balance <= 0;
1502 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1505 foreach my $part_bill_event (
1506 sort { $a->seconds <=> $b->seconds
1507 || $a->weight <=> $b->weight
1508 || $a->eventpart <=> $b->eventpart }
1509 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1510 && ! qsearchs( 'cust_bill_event', {
1511 'invnum' => $cust_bill->invnum,
1512 'eventpart' => $_->eventpart,
1516 qsearch('part_bill_event', { 'payby' => $self->payby,
1517 'disabled' => '', } )
1520 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1521 || $self->balance <= 0; # or if balance<=0
1523 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1525 my $cust_main = $self; #for callback
1529 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1530 $error = eval $part_bill_event->eventcode;
1534 my $statustext = '';
1538 } elsif ( $error ) {
1540 $statustext = $error;
1545 #add cust_bill_event
1546 my $cust_bill_event = new FS::cust_bill_event {
1547 'invnum' => $cust_bill->invnum,
1548 'eventpart' => $part_bill_event->eventpart,
1549 #'_date' => $invoice_time,
1551 'status' => $status,
1552 'statustext' => $statustext,
1554 $error = $cust_bill_event->insert;
1556 #$dbh->rollback if $oldAutoCommit;
1557 #return "error: $error";
1559 # gah, even with transactions.
1560 $dbh->commit if $oldAutoCommit; #well.
1561 my $e = 'WARNING: Event run but database not updated - '.
1562 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1563 ', eventpart '. $part_bill_event->eventpart.
1574 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1579 =item retry_realtime
1581 Schedules realtime credit card / electronic check / LEC billing events for
1582 for retry. Useful if card information has changed or manual retry is desired.
1583 The 'collect' method must be called to actually retry the transaction.
1585 Implementation details: For each of this customer's open invoices, changes
1586 the status of the first "done" (with statustext error) realtime processing
1591 sub retry_realtime {
1594 local $SIG{HUP} = 'IGNORE';
1595 local $SIG{INT} = 'IGNORE';
1596 local $SIG{QUIT} = 'IGNORE';
1597 local $SIG{TERM} = 'IGNORE';
1598 local $SIG{TSTP} = 'IGNORE';
1599 local $SIG{PIPE} = 'IGNORE';
1601 my $oldAutoCommit = $FS::UID::AutoCommit;
1602 local $FS::UID::AutoCommit = 0;
1605 foreach my $cust_bill (
1606 grep { $_->cust_bill_event }
1607 $self->open_cust_bill
1609 my @cust_bill_event =
1610 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1612 #$_->part_bill_event->plan eq 'realtime-card'
1613 $_->part_bill_event->eventcode =~
1614 /\$cust_bill\->realtime_(card|ach|lec)/
1615 && $_->status eq 'done'
1618 $cust_bill->cust_bill_event;
1619 next unless @cust_bill_event;
1620 my $error = $cust_bill_event[0]->retry;
1622 $dbh->rollback if $oldAutoCommit;
1623 return "error scheduling invoice event for retry: $error";
1628 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1633 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1635 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1636 via a Business::OnlinePayment realtime gateway. See
1637 L<http://420.am/business-onlinepayment> for supported gateways.
1639 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1641 Available options are: I<description>, I<invnum>, I<quiet>
1643 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1644 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1645 if set, will override the value from the customer record.
1647 I<description> is a free-text field passed to the gateway. It defaults to
1648 "Internet services".
1650 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1651 specified invoice. If you don't specify an I<invnum> you might want to
1652 call the B<apply_payments> method.
1654 I<quiet> can be set true to surpress email decline notices.
1656 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1661 my( $self, $method, $amount, %options ) = @_;
1663 warn "$self $method $amount\n";
1664 warn " $_ => $options{$_}\n" foreach keys %options;
1667 $options{'description'} ||= 'Internet services';
1670 die "Real-time processing not enabled\n"
1671 unless $conf->exists('business-onlinepayment');
1672 eval "use Business::OnlinePayment";
1676 $self->set( $_ => $options{$_} )
1677 foreach grep { exists($options{$_}) }
1678 qw( payname address1 address2 city state zip payinfo paydate );
1681 my $bop_config = 'business-onlinepayment';
1682 $bop_config .= '-ach'
1683 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1684 my ( $processor, $login, $password, $action, @bop_options ) =
1685 $conf->config($bop_config);
1686 $action ||= 'normal authorization';
1687 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1691 my $address = $self->address1;
1692 $address .= ", ". $self->address2 if $self->address2;
1694 my($payname, $payfirst, $paylast);
1695 if ( $self->payname && $method ne 'ECHECK' ) {
1696 $payname = $self->payname;
1697 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1698 or return "Illegal payname $payname";
1699 ($payfirst, $paylast) = ($1, $2);
1701 $payfirst = $self->getfield('first');
1702 $paylast = $self->getfield('last');
1703 $payname = "$payfirst $paylast";
1706 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1707 if ( $conf->exists('emailinvoiceauto')
1708 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1709 push @invoicing_list, $self->all_emails;
1711 my $email = $invoicing_list[0];
1714 if ( $method eq 'CC' ) {
1716 $content{card_number} = $self->payinfo;
1717 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1718 $content{expiration} = "$2/$1";
1720 $content{cvv2} = $self->paycvv
1721 if defined $self->dbdef_table->column('paycvv')
1722 && length($self->paycvv);
1724 $content{recurring_billing} = 'YES'
1725 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1727 'payinfo' => $self->payinfo, } );
1729 } elsif ( $method eq 'ECHECK' ) {
1730 my($account_number,$routing_code) = $self->payinfo;
1731 ( $content{account_number}, $content{routing_code} ) =
1732 split('@', $self->payinfo);
1733 $content{bank_name} = $self->payname;
1734 $content{account_type} = 'CHECKING';
1735 $content{account_name} = $payname;
1736 $content{customer_org} = $self->company ? 'B' : 'I';
1737 $content{customer_ssn} = $self->ss;
1738 } elsif ( $method eq 'LEC' ) {
1739 $content{phone} = $self->payinfo;
1744 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1747 new Business::OnlinePayment( $processor, @bop_options );
1748 $transaction->content(
1751 'password' => $password,
1752 'action' => $action1,
1753 'description' => $options{'description'},
1754 'amount' => $amount,
1755 'invoice_number' => $options{'invnum'},
1756 'customer_id' => $self->custnum,
1757 'last_name' => $paylast,
1758 'first_name' => $payfirst,
1760 'address' => $address,
1761 'city' => $self->city,
1762 'state' => $self->state,
1763 'zip' => $self->zip,
1764 'country' => $self->country,
1765 'referer' => 'http://cleanwhisker.420.am/',
1767 'phone' => $self->daytime || $self->night,
1770 $transaction->submit();
1772 if ( $transaction->is_success() && $action2 ) {
1773 my $auth = $transaction->authorization;
1774 my $ordernum = $transaction->can('order_number')
1775 ? $transaction->order_number
1779 new Business::OnlinePayment( $processor, @bop_options );
1786 password => $password,
1787 order_number => $ordernum,
1789 authorization => $auth,
1790 description => $options{'description'},
1793 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
1794 transaction_sequence_num local_transaction_date
1795 local_transaction_time AVS_result_code )) {
1796 $capture{$field} = $transaction->$field() if $transaction->can($field);
1799 $capture->content( %capture );
1803 unless ( $capture->is_success ) {
1804 my $e = "Authorization sucessful but capture failed, custnum #".
1805 $self->custnum. ': '. $capture->result_code.
1806 ": ". $capture->error_message;
1813 #remove paycvv after initial transaction
1814 #make this disable-able via a config option if anyone insists?
1815 # (though that probably violates cardholder agreements)
1816 if ( defined $self->dbdef_table->column('paycvv')
1817 && length($self->paycvv)
1818 && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1820 my $new = new FS::cust_main { $self->hash };
1822 my $error = $new->replace($self);
1824 warn "error removing cvv: $error\n";
1829 if ( $transaction->is_success() ) {
1831 my %method2payby = (
1837 my $cust_pay = new FS::cust_pay ( {
1838 'custnum' => $self->custnum,
1839 'invnum' => $options{'invnum'},
1842 'payby' => $method2payby{$method},
1843 'payinfo' => $self->payinfo,
1844 'paybatch' => "$processor:". $transaction->authorization,
1846 my $error = $cust_pay->insert;
1848 # gah, even with transactions.
1849 my $e = 'WARNING: Card/ACH debited but database not updated - '.
1850 'error applying payment, invnum #' . $self->invnum.
1851 " ($processor): $error";
1860 my $perror = "$processor error: ". $transaction->error_message;
1862 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1863 && $conf->exists('emaildecline')
1864 && grep { $_ ne 'POST' } $self->invoicing_list
1865 && ! grep { $_ eq $transaction->error_message }
1866 $conf->config('emaildecline-exclude')
1868 my @templ = $conf->config('declinetemplate');
1869 my $template = new Text::Template (
1871 SOURCE => [ map "$_\n", @templ ],
1872 ) or return "($perror) can't create template: $Text::Template::ERROR";
1873 $template->compile()
1874 or return "($perror) can't compile template: $Text::Template::ERROR";
1876 my $templ_hash = { error => $transaction->error_message };
1878 my $error = send_email(
1879 'from' => $conf->config('invoice_from'),
1880 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1881 'subject' => 'Your payment could not be processed',
1882 'body' => [ $template->fill_in(HASH => $templ_hash) ],
1885 $perror .= " (also received error sending decline notification: $error)"
1897 Returns the total owed for this customer on all invoices
1898 (see L<FS::cust_bill/owed>).
1904 $self->total_owed_date(2145859200); #12/31/2037
1907 =item total_owed_date TIME
1909 Returns the total owed for this customer on all invoices with date earlier than
1910 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
1911 see L<Time::Local> and L<Date::Parse> for conversion functions.
1915 sub total_owed_date {
1919 foreach my $cust_bill (
1920 grep { $_->_date <= $time }
1921 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1923 $total_bill += $cust_bill->owed;
1925 sprintf( "%.2f", $total_bill );
1930 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1931 to outstanding invoice balances in chronological order and returns the value
1932 of any remaining unapplied credits available for refund
1933 (see L<FS::cust_refund>).
1940 return 0 unless $self->total_credited;
1942 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1943 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1945 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1946 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1950 foreach my $cust_bill ( @invoices ) {
1953 if ( !defined($credit) || $credit->credited == 0) {
1954 $credit = pop @credits or last;
1957 if ($cust_bill->owed >= $credit->credited) {
1958 $amount=$credit->credited;
1960 $amount=$cust_bill->owed;
1963 my $cust_credit_bill = new FS::cust_credit_bill ( {
1964 'crednum' => $credit->crednum,
1965 'invnum' => $cust_bill->invnum,
1966 'amount' => $amount,
1968 my $error = $cust_credit_bill->insert;
1969 die $error if $error;
1971 redo if ($cust_bill->owed > 0);
1975 return $self->total_credited;
1978 =item apply_payments
1980 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1981 to outstanding invoice balances in chronological order.
1983 #and returns the value of any remaining unapplied payments.
1987 sub apply_payments {
1992 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1993 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1995 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1996 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2000 foreach my $cust_bill ( @invoices ) {
2003 if ( !defined($payment) || $payment->unapplied == 0 ) {
2004 $payment = pop @payments or last;
2007 if ( $cust_bill->owed >= $payment->unapplied ) {
2008 $amount = $payment->unapplied;
2010 $amount = $cust_bill->owed;
2013 my $cust_bill_pay = new FS::cust_bill_pay ( {
2014 'paynum' => $payment->paynum,
2015 'invnum' => $cust_bill->invnum,
2016 'amount' => $amount,
2018 my $error = $cust_bill_pay->insert;
2019 die $error if $error;
2021 redo if ( $cust_bill->owed > 0);
2025 return $self->total_unapplied_payments;
2028 =item total_credited
2030 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2031 customer. See L<FS::cust_credit/credited>.
2035 sub total_credited {
2037 my $total_credit = 0;
2038 foreach my $cust_credit ( qsearch('cust_credit', {
2039 'custnum' => $self->custnum,
2041 $total_credit += $cust_credit->credited;
2043 sprintf( "%.2f", $total_credit );
2046 =item total_unapplied_payments
2048 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2049 See L<FS::cust_pay/unapplied>.
2053 sub total_unapplied_payments {
2055 my $total_unapplied = 0;
2056 foreach my $cust_pay ( qsearch('cust_pay', {
2057 'custnum' => $self->custnum,
2059 $total_unapplied += $cust_pay->unapplied;
2061 sprintf( "%.2f", $total_unapplied );
2066 Returns the balance for this customer (total_owed minus total_credited
2067 minus total_unapplied_payments).
2074 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2078 =item balance_date TIME
2080 Returns the balance for this customer, only considering invoices with date
2081 earlier than TIME (total_owed_date minus total_credited minus
2082 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2083 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2092 $self->total_owed_date($time)
2093 - $self->total_credited
2094 - $self->total_unapplied_payments
2098 =item invoicing_list [ ARRAYREF ]
2100 If an arguement is given, sets these email addresses as invoice recipients
2101 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2102 (except as warnings), so use check_invoicing_list first.
2104 Returns a list of email addresses (with svcnum entries expanded).
2106 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2107 check it without disturbing anything by passing nothing.
2109 This interface may change in the future.
2113 sub invoicing_list {
2114 my( $self, $arrayref ) = @_;
2116 my @cust_main_invoice;
2117 if ( $self->custnum ) {
2118 @cust_main_invoice =
2119 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2121 @cust_main_invoice = ();
2123 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2124 #warn $cust_main_invoice->destnum;
2125 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2126 #warn $cust_main_invoice->destnum;
2127 my $error = $cust_main_invoice->delete;
2128 warn $error if $error;
2131 if ( $self->custnum ) {
2132 @cust_main_invoice =
2133 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2135 @cust_main_invoice = ();
2137 my %seen = map { $_->address => 1 } @cust_main_invoice;
2138 foreach my $address ( @{$arrayref} ) {
2139 next if exists $seen{$address} && $seen{$address};
2140 $seen{$address} = 1;
2141 my $cust_main_invoice = new FS::cust_main_invoice ( {
2142 'custnum' => $self->custnum,
2145 my $error = $cust_main_invoice->insert;
2146 warn $error if $error;
2149 if ( $self->custnum ) {
2151 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2157 =item check_invoicing_list ARRAYREF
2159 Checks these arguements as valid input for the invoicing_list method. If there
2160 is an error, returns the error, otherwise returns false.
2164 sub check_invoicing_list {
2165 my( $self, $arrayref ) = @_;
2166 foreach my $address ( @{$arrayref} ) {
2167 my $cust_main_invoice = new FS::cust_main_invoice ( {
2168 'custnum' => $self->custnum,
2171 my $error = $self->custnum
2172 ? $cust_main_invoice->check
2173 : $cust_main_invoice->checkdest
2175 return $error if $error;
2180 =item set_default_invoicing_list
2182 Sets the invoicing list to all accounts associated with this customer,
2183 overwriting any previous invoicing list.
2187 sub set_default_invoicing_list {
2189 $self->invoicing_list($self->all_emails);
2194 Returns the email addresses of all accounts provisioned for this customer.
2201 foreach my $cust_pkg ( $self->all_pkgs ) {
2202 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2204 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2205 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2207 $list{$_}=1 foreach map { $_->email } @svc_acct;
2212 =item invoicing_list_addpost
2214 Adds postal invoicing to this customer. If this customer is already configured
2215 to receive postal invoices, does nothing.
2219 sub invoicing_list_addpost {
2221 return if grep { $_ eq 'POST' } $self->invoicing_list;
2222 my @invoicing_list = $self->invoicing_list;
2223 push @invoicing_list, 'POST';
2224 $self->invoicing_list(\@invoicing_list);
2227 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2229 Returns an array of customers referred by this customer (referral_custnum set
2230 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2231 customers referred by customers referred by this customer and so on, inclusive.
2232 The default behavior is DEPTH 1 (no recursion).
2236 sub referral_cust_main {
2238 my $depth = @_ ? shift : 1;
2239 my $exclude = @_ ? shift : {};
2242 map { $exclude->{$_->custnum}++; $_; }
2243 grep { ! $exclude->{ $_->custnum } }
2244 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2248 map { $_->referral_cust_main($depth-1, $exclude) }
2255 =item referral_cust_main_ncancelled
2257 Same as referral_cust_main, except only returns customers with uncancelled
2262 sub referral_cust_main_ncancelled {
2264 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2267 =item referral_cust_pkg [ DEPTH ]
2269 Like referral_cust_main, except returns a flat list of all unsuspended (and
2270 uncancelled) packages for each customer. The number of items in this list may
2271 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2275 sub referral_cust_pkg {
2277 my $depth = @_ ? shift : 1;
2279 map { $_->unsuspended_pkgs }
2280 grep { $_->unsuspended_pkgs }
2281 $self->referral_cust_main($depth);
2284 =item credit AMOUNT, REASON
2286 Applies a credit to this customer. If there is an error, returns the error,
2287 otherwise returns false.
2292 my( $self, $amount, $reason ) = @_;
2293 my $cust_credit = new FS::cust_credit {
2294 'custnum' => $self->custnum,
2295 'amount' => $amount,
2296 'reason' => $reason,
2298 $cust_credit->insert;
2301 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2303 Creates a one-time charge for this customer. If there is an error, returns
2304 the error, otherwise returns false.
2309 my ( $self, $amount ) = ( shift, shift );
2310 my $pkg = @_ ? shift : 'One-time charge';
2311 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2312 my $taxclass = @_ ? shift : '';
2314 local $SIG{HUP} = 'IGNORE';
2315 local $SIG{INT} = 'IGNORE';
2316 local $SIG{QUIT} = 'IGNORE';
2317 local $SIG{TERM} = 'IGNORE';
2318 local $SIG{TSTP} = 'IGNORE';
2319 local $SIG{PIPE} = 'IGNORE';
2321 my $oldAutoCommit = $FS::UID::AutoCommit;
2322 local $FS::UID::AutoCommit = 0;
2325 my $part_pkg = new FS::part_pkg ( {
2327 'comment' => $comment,
2332 'taxclass' => $taxclass,
2335 my $error = $part_pkg->insert;
2337 $dbh->rollback if $oldAutoCommit;
2341 my $pkgpart = $part_pkg->pkgpart;
2342 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2343 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2344 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2345 $error = $type_pkgs->insert;
2347 $dbh->rollback if $oldAutoCommit;
2352 my $cust_pkg = new FS::cust_pkg ( {
2353 'custnum' => $self->custnum,
2354 'pkgpart' => $pkgpart,
2357 $error = $cust_pkg->insert;
2359 $dbh->rollback if $oldAutoCommit;
2363 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2370 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2376 sort { $a->_date <=> $b->_date }
2377 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2380 =item open_cust_bill
2382 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2387 sub open_cust_bill {
2389 grep { $_->owed > 0 } $self->cust_bill;
2394 Returns all the credits (see L<FS::cust_credit>) for this customer.
2400 sort { $a->_date <=> $b->_date }
2401 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2406 Returns all the payments (see L<FS::cust_pay>) for this customer.
2412 sort { $a->_date <=> $b->_date }
2413 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2418 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2424 sort { $a->_date <=> $b->_date }
2425 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2434 =item check_and_rebuild_fuzzyfiles
2438 sub check_and_rebuild_fuzzyfiles {
2439 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2440 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2441 or &rebuild_fuzzyfiles;
2444 =item rebuild_fuzzyfiles
2448 sub rebuild_fuzzyfiles {
2450 use Fcntl qw(:flock);
2452 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2456 open(LASTLOCK,">>$dir/cust_main.last")
2457 or die "can't open $dir/cust_main.last: $!";
2458 flock(LASTLOCK,LOCK_EX)
2459 or die "can't lock $dir/cust_main.last: $!";
2461 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2463 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2464 if defined dbdef->table('cust_main')->column('ship_last');
2466 open (LASTCACHE,">$dir/cust_main.last.tmp")
2467 or die "can't open $dir/cust_main.last.tmp: $!";
2468 print LASTCACHE join("\n", @all_last), "\n";
2469 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2471 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2476 open(COMPANYLOCK,">>$dir/cust_main.company")
2477 or die "can't open $dir/cust_main.company: $!";
2478 flock(COMPANYLOCK,LOCK_EX)
2479 or die "can't lock $dir/cust_main.company: $!";
2481 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2483 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2484 if defined dbdef->table('cust_main')->column('ship_last');
2486 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2487 or die "can't open $dir/cust_main.company.tmp: $!";
2488 print COMPANYCACHE join("\n", @all_company), "\n";
2489 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2491 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2501 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2502 open(LASTCACHE,"<$dir/cust_main.last")
2503 or die "can't open $dir/cust_main.last: $!";
2504 my @array = map { chomp; $_; } <LASTCACHE>;
2514 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2515 open(COMPANYCACHE,"<$dir/cust_main.company")
2516 or die "can't open $dir/cust_main.last: $!";
2517 my @array = map { chomp; $_; } <COMPANYCACHE>;
2522 =item append_fuzzyfiles LASTNAME COMPANY
2526 sub append_fuzzyfiles {
2527 my( $last, $company ) = @_;
2529 &check_and_rebuild_fuzzyfiles;
2531 use Fcntl qw(:flock);
2533 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2537 open(LAST,">>$dir/cust_main.last")
2538 or die "can't open $dir/cust_main.last: $!";
2540 or die "can't lock $dir/cust_main.last: $!";
2542 print LAST "$last\n";
2545 or die "can't unlock $dir/cust_main.last: $!";
2551 open(COMPANY,">>$dir/cust_main.company")
2552 or die "can't open $dir/cust_main.company: $!";
2553 flock(COMPANY,LOCK_EX)
2554 or die "can't lock $dir/cust_main.company: $!";
2556 print COMPANY "$company\n";
2558 flock(COMPANY,LOCK_UN)
2559 or die "can't unlock $dir/cust_main.company: $!";
2573 #warn join('-',keys %$param);
2574 my $fh = $param->{filehandle};
2575 my $agentnum = $param->{agentnum};
2576 my $refnum = $param->{refnum};
2577 my $pkgpart = $param->{pkgpart};
2578 my @fields = @{$param->{fields}};
2580 eval "use Date::Parse;";
2582 eval "use Text::CSV_XS;";
2585 my $csv = new Text::CSV_XS;
2592 local $SIG{HUP} = 'IGNORE';
2593 local $SIG{INT} = 'IGNORE';
2594 local $SIG{QUIT} = 'IGNORE';
2595 local $SIG{TERM} = 'IGNORE';
2596 local $SIG{TSTP} = 'IGNORE';
2597 local $SIG{PIPE} = 'IGNORE';
2599 my $oldAutoCommit = $FS::UID::AutoCommit;
2600 local $FS::UID::AutoCommit = 0;
2603 #while ( $columns = $csv->getline($fh) ) {
2605 while ( defined($line=<$fh>) ) {
2607 $csv->parse($line) or do {
2608 $dbh->rollback if $oldAutoCommit;
2609 return "can't parse: ". $csv->error_input();
2612 my @columns = $csv->fields();
2613 #warn join('-',@columns);
2616 agentnum => $agentnum,
2618 country => 'US', #default
2619 payby => 'BILL', #default
2620 paydate => '12/2037', #default
2622 my $billtime = time;
2623 my %cust_pkg = ( pkgpart => $pkgpart );
2624 foreach my $field ( @fields ) {
2625 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2626 #$cust_pkg{$1} = str2time( shift @$columns );
2627 if ( $1 eq 'setup' ) {
2628 $billtime = str2time(shift @columns);
2630 $cust_pkg{$1} = str2time( shift @columns );
2633 #$cust_main{$field} = shift @$columns;
2634 $cust_main{$field} = shift @columns;
2638 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2639 my $cust_main = new FS::cust_main ( \%cust_main );
2641 tie my %hash, 'Tie::RefHash'; #this part is important
2642 $hash{$cust_pkg} = [] if $pkgpart;
2643 my $error = $cust_main->insert( \%hash );
2646 $dbh->rollback if $oldAutoCommit;
2647 return "can't insert customer for $line: $error";
2650 #false laziness w/bill.cgi
2651 $error = $cust_main->bill( 'time' => $billtime );
2653 $dbh->rollback if $oldAutoCommit;
2654 return "can't bill customer for $line: $error";
2657 $cust_main->apply_payments;
2658 $cust_main->apply_credits;
2660 $error = $cust_main->collect();
2662 $dbh->rollback if $oldAutoCommit;
2663 return "can't collect customer for $line: $error";
2669 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2671 return "Empty file!" unless $imported;
2683 #warn join('-',keys %$param);
2684 my $fh = $param->{filehandle};
2685 my @fields = @{$param->{fields}};
2687 eval "use Date::Parse;";
2689 eval "use Text::CSV_XS;";
2692 my $csv = new Text::CSV_XS;
2699 local $SIG{HUP} = 'IGNORE';
2700 local $SIG{INT} = 'IGNORE';
2701 local $SIG{QUIT} = 'IGNORE';
2702 local $SIG{TERM} = 'IGNORE';
2703 local $SIG{TSTP} = 'IGNORE';
2704 local $SIG{PIPE} = 'IGNORE';
2706 my $oldAutoCommit = $FS::UID::AutoCommit;
2707 local $FS::UID::AutoCommit = 0;
2710 #while ( $columns = $csv->getline($fh) ) {
2712 while ( defined($line=<$fh>) ) {
2714 $csv->parse($line) or do {
2715 $dbh->rollback if $oldAutoCommit;
2716 return "can't parse: ". $csv->error_input();
2719 my @columns = $csv->fields();
2720 #warn join('-',@columns);
2723 foreach my $field ( @fields ) {
2724 $row{$field} = shift @columns;
2727 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2728 unless ( $cust_main ) {
2729 $dbh->rollback if $oldAutoCommit;
2730 return "unknown custnum $row{'custnum'}";
2733 if ( $row{'amount'} > 0 ) {
2734 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2736 $dbh->rollback if $oldAutoCommit;
2740 } elsif ( $row{'amount'} < 0 ) {
2741 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2744 $dbh->rollback if $oldAutoCommit;
2754 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2756 return "Empty file!" unless $imported;
2768 The delete method should possibly take an FS::cust_main object reference
2769 instead of a scalar customer number.
2771 Bill and collect options should probably be passed as references instead of a
2774 There should probably be a configuration file with a list of allowed credit
2777 No multiple currency support (probably a larger project than just this module).
2781 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2782 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2783 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.