4 use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import @encrypted_fields);
5 use vars qw( $realtime_bop_decline_quiet ); #ugh
10 eval "use Time::Local;";
11 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
12 if $] < 5.006 && !defined($Time::Local::VERSION);
13 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
14 eval "use Time::Local qw(timelocal_nocheck);";
18 use String::Approx qw(amatch);
19 use Business::CreditCard;
20 use FS::UID qw( getotaker dbh );
21 use FS::Record qw( qsearchs qsearch dbdef );
22 use FS::Misc qw( send_email );
25 use FS::cust_bill_pkg;
27 use FS::cust_pay_void;
30 use FS::part_referral;
31 use FS::cust_main_county;
33 use FS::cust_main_invoice;
34 use FS::cust_credit_bill;
35 use FS::cust_bill_pay;
36 use FS::prepay_credit;
39 use FS::part_bill_event;
40 use FS::cust_bill_event;
41 use FS::cust_tax_exempt;
43 use FS::Msgcat qw(gettext);
45 @ISA = qw( FS::Record );
47 @EXPORT_OK = qw( smart_search );
49 $realtime_bop_decline_quiet = 0;
56 @encrypted_fields = ('payinfo', 'paycvv');
58 #ask FS::UID to run this stuff for us later
59 #$FS::UID::callback{'FS::cust_main'} = sub {
60 install_callback FS::UID sub {
62 #yes, need it for stuff below (prolly should be cached)
67 my ( $hashref, $cache ) = @_;
68 if ( exists $hashref->{'pkgnum'} ) {
69 # #@{ $self->{'_pkgnum'} } = ();
70 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
71 $self->{'_pkgnum'} = $subcache;
72 #push @{ $self->{'_pkgnum'} },
73 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
79 FS::cust_main - Object methods for cust_main records
85 $record = new FS::cust_main \%hash;
86 $record = new FS::cust_main { 'column' => 'value' };
88 $error = $record->insert;
90 $error = $new_record->replace($old_record);
92 $error = $record->delete;
94 $error = $record->check;
96 @cust_pkg = $record->all_pkgs;
98 @cust_pkg = $record->ncancelled_pkgs;
100 @cust_pkg = $record->suspended_pkgs;
102 $error = $record->bill;
103 $error = $record->bill %options;
104 $error = $record->bill 'time' => $time;
106 $error = $record->collect;
107 $error = $record->collect %options;
108 $error = $record->collect 'invoice_time' => $time,
109 'batch_card' => 'yes',
110 'report_badcard' => 'yes',
115 An FS::cust_main object represents a customer. FS::cust_main inherits from
116 FS::Record. The following fields are currently supported:
120 =item custnum - primary key (assigned automatically for new customers)
122 =item agentnum - agent (see L<FS::agent>)
124 =item refnum - Advertising source (see L<FS::part_referral>)
130 =item ss - social security number (optional)
132 =item company - (optional)
136 =item address2 - (optional)
140 =item county - (optional, see L<FS::cust_main_county>)
142 =item state - (see L<FS::cust_main_county>)
146 =item country - (see L<FS::cust_main_county>)
148 =item daytime - phone (optional)
150 =item night - phone (optional)
152 =item fax - phone (optional)
154 =item ship_first - name
156 =item ship_last - name
158 =item ship_company - (optional)
162 =item ship_address2 - (optional)
166 =item ship_county - (optional, see L<FS::cust_main_county>)
168 =item ship_state - (see L<FS::cust_main_county>)
172 =item ship_country - (see L<FS::cust_main_county>)
174 =item ship_daytime - phone (optional)
176 =item ship_night - phone (optional)
178 =item ship_fax - phone (optional)
182 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>)
186 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
191 my($self,$payinfo) = @_;
192 if ( defined($payinfo) ) {
193 $self->paymask($payinfo);
194 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
196 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
204 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
208 =item paymask - Masked payment type
214 Mask all but the last four characters.
218 Mask all but last 2 of account number and bank routing number.
222 Do nothing, return the unmasked string.
231 # If it doesn't exist then generate it
232 my $paymask=$self->getfield('paymask');
233 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
234 $value = $self->payinfo;
237 if ( defined($value) && !$self->is_encrypted($value)) {
238 my $payinfo = $value;
239 my $payby = $self->payby;
240 if ($payby eq 'CARD' || $payby eq 'DCARD') { # Credit Cards (Show last four)
241 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
242 } elsif ($payby eq 'CHEK' ||
243 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
244 my( $account, $aba ) = split('@', $payinfo );
245 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
246 } else { # Tie up loose ends
249 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
250 } elsif (defined($value) && $self->is_encrypted($value)) {
259 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
261 =item payname - name on card or billing name
263 =item tax - tax exempt, empty or `Y'
265 =item otaker - order taker (assigned automatically, see L<FS::UID>)
267 =item comments - comments (optional)
269 =item referral_custnum - referring customer number
279 Creates a new customer. To add the customer to the database, see L<"insert">.
281 Note that this stores the hash reference, not a distinct copy of the hash it
282 points to. You can ask the object for a copy with the I<hash> method.
286 sub table { 'cust_main'; }
288 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
290 Adds this customer to the database. If there is an error, returns the error,
291 otherwise returns false.
293 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
294 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
295 are inserted atomicly, or the transaction is rolled back. Passing an empty
296 hash reference is equivalent to not supplying this parameter. There should be
297 a better explanation of this, but until then, here's an example:
300 tie %hash, 'Tie::RefHash'; #this part is important
302 $cust_pkg => [ $svc_acct ],
305 $cust_main->insert( \%hash );
307 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
308 be set as the invoicing list (see L<"invoicing_list">). Errors return as
309 expected and rollback the entire transaction; it is not necessary to call
310 check_invoicing_list first. The invoicing_list is set after the records in the
311 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
312 invoicing_list destination to the newly-created svc_acct. Here's an example:
314 $cust_main->insert( {}, [ $email, 'POST' ] );
316 Currently available options are: I<depend_jobnum> and I<noexport>.
318 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
319 on the supplied jobnum (they will not run until the specific job completes).
320 This can be used to defer provisioning until some action completes (such
321 as running the customer's credit card sucessfully).
323 The I<noexport> option is deprecated. If I<noexport> is set true, no
324 provisioning jobs (exports) are scheduled. (You can schedule them later with
325 the B<reexport> method.)
331 my $cust_pkgs = @_ ? shift : {};
332 my $invoicing_list = @_ ? shift : '';
334 warn "FS::cust_main::insert called with options ".
335 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
338 local $SIG{HUP} = 'IGNORE';
339 local $SIG{INT} = 'IGNORE';
340 local $SIG{QUIT} = 'IGNORE';
341 local $SIG{TERM} = 'IGNORE';
342 local $SIG{TSTP} = 'IGNORE';
343 local $SIG{PIPE} = 'IGNORE';
345 my $oldAutoCommit = $FS::UID::AutoCommit;
346 local $FS::UID::AutoCommit = 0;
349 my $prepay_credit = '';
351 if ( $self->payby eq 'PREPAY' ) {
352 $self->payby('BILL');
353 $prepay_credit = qsearchs(
355 { 'identifier' => $self->payinfo },
359 unless ( $prepay_credit ) {
360 $dbh->rollback if $oldAutoCommit;
361 return "Invalid prepaid card: ". $self->payinfo;
363 $seconds = $prepay_credit->seconds;
364 if ( $prepay_credit->agentnum ) {
365 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
366 $dbh->rollback if $oldAutoCommit;
367 return "prepaid card not valid for agent ". $self->agentnum;
369 $self->agentnum($prepay_credit->agentnum);
371 my $error = $prepay_credit->delete;
373 $dbh->rollback if $oldAutoCommit;
374 return "removing prepay_credit (transaction rolled back): $error";
378 my $error = $self->SUPER::insert;
380 $dbh->rollback if $oldAutoCommit;
381 #return "inserting cust_main record (transaction rolled back): $error";
386 if ( $invoicing_list ) {
387 $error = $self->check_invoicing_list( $invoicing_list );
389 $dbh->rollback if $oldAutoCommit;
390 return "checking invoicing_list (transaction rolled back): $error";
392 $self->invoicing_list( $invoicing_list );
396 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
398 $dbh->rollback if $oldAutoCommit;
403 $dbh->rollback if $oldAutoCommit;
404 return "No svc_acct record to apply pre-paid time";
407 if ( $prepay_credit && $prepay_credit->amount ) {
408 my $cust_pay = new FS::cust_pay {
409 'custnum' => $self->custnum,
410 'paid' => $prepay_credit->amount,
411 #'_date' => #date the prepaid card was purchased???
413 'payinfo' => $prepay_credit->identifier,
415 $error = $cust_pay->insert;
417 $dbh->rollback if $oldAutoCommit;
418 return "inserting prepayment (transaction rolled back): $error";
422 $error = $self->queue_fuzzyfiles_update;
424 $dbh->rollback if $oldAutoCommit;
425 return "updating fuzzy search cache: $error";
428 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
433 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
435 Like the insert method on an existing record, this method orders a package
436 and included services atomicaly. Pass a Tie::RefHash data structure to this
437 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
438 be a better explanation of this, but until then, here's an example:
441 tie %hash, 'Tie::RefHash'; #this part is important
443 $cust_pkg => [ $svc_acct ],
446 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
448 Currently available options are: I<depend_jobnum> and I<noexport>.
450 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
451 on the supplied jobnum (they will not run until the specific job completes).
452 This can be used to defer provisioning until some action completes (such
453 as running the customer's credit card sucessfully).
455 The I<noexport> option is deprecated. If I<noexport> is set true, no
456 provisioning jobs (exports) are scheduled. (You can schedule them later with
457 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
458 on the cust_main object is not recommended, as existing services will also be
465 my $cust_pkgs = shift;
468 my %svc_options = ();
469 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
470 if exists $options{'depend_jobnum'};
471 warn "FS::cust_main::order_pkgs called with options ".
472 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
475 local $SIG{HUP} = 'IGNORE';
476 local $SIG{INT} = 'IGNORE';
477 local $SIG{QUIT} = 'IGNORE';
478 local $SIG{TERM} = 'IGNORE';
479 local $SIG{TSTP} = 'IGNORE';
480 local $SIG{PIPE} = 'IGNORE';
482 my $oldAutoCommit = $FS::UID::AutoCommit;
483 local $FS::UID::AutoCommit = 0;
486 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
488 foreach my $cust_pkg ( keys %$cust_pkgs ) {
489 $cust_pkg->custnum( $self->custnum );
490 my $error = $cust_pkg->insert;
492 $dbh->rollback if $oldAutoCommit;
493 return "inserting cust_pkg (transaction rolled back): $error";
495 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
496 $svc_something->pkgnum( $cust_pkg->pkgnum );
497 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
498 $svc_something->seconds( $svc_something->seconds + $$seconds );
501 $error = $svc_something->insert(%svc_options);
503 $dbh->rollback if $oldAutoCommit;
504 #return "inserting svc_ (transaction rolled back): $error";
510 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
516 This method is deprecated. See the I<depend_jobnum> option to the insert and
517 order_pkgs methods for a better way to defer provisioning.
519 Re-schedules all exports by calling the B<reexport> method of all associated
520 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
521 otherwise returns false.
528 carp "warning: FS::cust_main::reexport is deprectated; ".
529 "use the depend_jobnum option to insert or order_pkgs to delay export";
531 local $SIG{HUP} = 'IGNORE';
532 local $SIG{INT} = 'IGNORE';
533 local $SIG{QUIT} = 'IGNORE';
534 local $SIG{TERM} = 'IGNORE';
535 local $SIG{TSTP} = 'IGNORE';
536 local $SIG{PIPE} = 'IGNORE';
538 my $oldAutoCommit = $FS::UID::AutoCommit;
539 local $FS::UID::AutoCommit = 0;
542 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
543 my $error = $cust_pkg->reexport;
545 $dbh->rollback if $oldAutoCommit;
550 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
555 =item delete NEW_CUSTNUM
557 This deletes the customer. If there is an error, returns the error, otherwise
560 This will completely remove all traces of the customer record. This is not
561 what you want when a customer cancels service; for that, cancel all of the
562 customer's packages (see L</cancel>).
564 If the customer has any uncancelled packages, you need to pass a new (valid)
565 customer number for those packages to be transferred to. Cancelled packages
566 will be deleted. Did I mention that this is NOT what you want when a customer
567 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
569 You can't delete a customer with invoices (see L<FS::cust_bill>),
570 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
571 refunds (see L<FS::cust_refund>).
578 local $SIG{HUP} = 'IGNORE';
579 local $SIG{INT} = 'IGNORE';
580 local $SIG{QUIT} = 'IGNORE';
581 local $SIG{TERM} = 'IGNORE';
582 local $SIG{TSTP} = 'IGNORE';
583 local $SIG{PIPE} = 'IGNORE';
585 my $oldAutoCommit = $FS::UID::AutoCommit;
586 local $FS::UID::AutoCommit = 0;
589 if ( $self->cust_bill ) {
590 $dbh->rollback if $oldAutoCommit;
591 return "Can't delete a customer with invoices";
593 if ( $self->cust_credit ) {
594 $dbh->rollback if $oldAutoCommit;
595 return "Can't delete a customer with credits";
597 if ( $self->cust_pay ) {
598 $dbh->rollback if $oldAutoCommit;
599 return "Can't delete a customer with payments";
601 if ( $self->cust_refund ) {
602 $dbh->rollback if $oldAutoCommit;
603 return "Can't delete a customer with refunds";
606 my @cust_pkg = $self->ncancelled_pkgs;
608 my $new_custnum = shift;
609 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
610 $dbh->rollback if $oldAutoCommit;
611 return "Invalid new customer number: $new_custnum";
613 foreach my $cust_pkg ( @cust_pkg ) {
614 my %hash = $cust_pkg->hash;
615 $hash{'custnum'} = $new_custnum;
616 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
617 my $error = $new_cust_pkg->replace($cust_pkg);
619 $dbh->rollback if $oldAutoCommit;
624 my @cancelled_cust_pkg = $self->all_pkgs;
625 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
626 my $error = $cust_pkg->delete;
628 $dbh->rollback if $oldAutoCommit;
633 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
634 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
636 my $error = $cust_main_invoice->delete;
638 $dbh->rollback if $oldAutoCommit;
643 my $error = $self->SUPER::delete;
645 $dbh->rollback if $oldAutoCommit;
649 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
654 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
656 Replaces the OLD_RECORD with this one in the database. If there is an error,
657 returns the error, otherwise returns false.
659 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
660 be set as the invoicing list (see L<"invoicing_list">). Errors return as
661 expected and rollback the entire transaction; it is not necessary to call
662 check_invoicing_list first. Here's an example:
664 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
673 local $SIG{HUP} = 'IGNORE';
674 local $SIG{INT} = 'IGNORE';
675 local $SIG{QUIT} = 'IGNORE';
676 local $SIG{TERM} = 'IGNORE';
677 local $SIG{TSTP} = 'IGNORE';
678 local $SIG{PIPE} = 'IGNORE';
680 # If the mask is blank then try to set it - if we can...
681 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
682 $self->paymask($self->payinfo);
685 # We absolutely have to have an old vs. new record to make this work.
686 if (!defined($old)) {
687 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
690 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
691 && $conf->config('users-allow_comp') ) {
692 return "You are not permitted to create complimentary accounts."
693 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
696 my $oldAutoCommit = $FS::UID::AutoCommit;
697 local $FS::UID::AutoCommit = 0;
700 my $error = $self->SUPER::replace($old);
703 $dbh->rollback if $oldAutoCommit;
707 if ( @param ) { # INVOICING_LIST_ARYREF
708 my $invoicing_list = shift @param;
709 $error = $self->check_invoicing_list( $invoicing_list );
711 $dbh->rollback if $oldAutoCommit;
714 $self->invoicing_list( $invoicing_list );
717 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
718 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
719 # card/check/lec info has changed, want to retry realtime_ invoice events
720 my $error = $self->retry_realtime;
722 $dbh->rollback if $oldAutoCommit;
727 $error = $self->queue_fuzzyfiles_update;
729 $dbh->rollback if $oldAutoCommit;
730 return "updating fuzzy search cache: $error";
733 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
738 =item queue_fuzzyfiles_update
740 Used by insert & replace to update the fuzzy search cache
744 sub queue_fuzzyfiles_update {
747 local $SIG{HUP} = 'IGNORE';
748 local $SIG{INT} = 'IGNORE';
749 local $SIG{QUIT} = 'IGNORE';
750 local $SIG{TERM} = 'IGNORE';
751 local $SIG{TSTP} = 'IGNORE';
752 local $SIG{PIPE} = 'IGNORE';
754 my $oldAutoCommit = $FS::UID::AutoCommit;
755 local $FS::UID::AutoCommit = 0;
758 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
759 my $error = $queue->insert($self->getfield('last'), $self->company);
761 $dbh->rollback if $oldAutoCommit;
762 return "queueing job (transaction rolled back): $error";
765 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
766 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
767 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
769 $dbh->rollback if $oldAutoCommit;
770 return "queueing job (transaction rolled back): $error";
774 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
781 Checks all fields to make sure this is a valid customer record. If there is
782 an error, returns the error, otherwise returns false. Called by the insert
790 #warn "BEFORE: \n". $self->_dump;
793 $self->ut_numbern('custnum')
794 || $self->ut_number('agentnum')
795 || $self->ut_number('refnum')
796 || $self->ut_name('last')
797 || $self->ut_name('first')
798 || $self->ut_textn('company')
799 || $self->ut_text('address1')
800 || $self->ut_textn('address2')
801 || $self->ut_text('city')
802 || $self->ut_textn('county')
803 || $self->ut_textn('state')
804 || $self->ut_country('country')
805 || $self->ut_anything('comments')
806 || $self->ut_numbern('referral_custnum')
808 #barf. need message catalogs. i18n. etc.
809 $error .= "Please select an advertising source."
810 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
811 return $error if $error;
813 return "Unknown agent"
814 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
816 return "Unknown refnum"
817 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
819 return "Unknown referring custnum ". $self->referral_custnum
820 unless ! $self->referral_custnum
821 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
823 if ( $self->ss eq '' ) {
828 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
829 or return "Illegal social security number: ". $self->ss;
830 $self->ss("$1-$2-$3");
834 # bad idea to disable, causes billing to fail because of no tax rates later
835 # unless ( $import ) {
836 unless ( qsearch('cust_main_county', {
837 'country' => $self->country,
840 return "Unknown state/county/country: ".
841 $self->state. "/". $self->county. "/". $self->country
842 unless qsearch('cust_main_county',{
843 'state' => $self->state,
844 'county' => $self->county,
845 'country' => $self->country,
851 $self->ut_phonen('daytime', $self->country)
852 || $self->ut_phonen('night', $self->country)
853 || $self->ut_phonen('fax', $self->country)
854 || $self->ut_zip('zip', $self->country)
856 return $error if $error;
859 last first company address1 address2 city county state zip
860 country daytime night fax
863 if ( defined $self->dbdef_table->column('ship_last') ) {
864 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
866 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
870 $self->ut_name('ship_last')
871 || $self->ut_name('ship_first')
872 || $self->ut_textn('ship_company')
873 || $self->ut_text('ship_address1')
874 || $self->ut_textn('ship_address2')
875 || $self->ut_text('ship_city')
876 || $self->ut_textn('ship_county')
877 || $self->ut_textn('ship_state')
878 || $self->ut_country('ship_country')
880 return $error if $error;
882 #false laziness with above
883 unless ( qsearchs('cust_main_county', {
884 'country' => $self->ship_country,
887 return "Unknown ship_state/ship_county/ship_country: ".
888 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
889 unless qsearchs('cust_main_county',{
890 'state' => $self->ship_state,
891 'county' => $self->ship_county,
892 'country' => $self->ship_country,
898 $self->ut_phonen('ship_daytime', $self->ship_country)
899 || $self->ut_phonen('ship_night', $self->ship_country)
900 || $self->ut_phonen('ship_fax', $self->ship_country)
901 || $self->ut_zip('ship_zip', $self->ship_country)
903 return $error if $error;
905 } else { # ship_ info eq billing info, so don't store dup info in database
906 $self->setfield("ship_$_", '')
907 foreach qw( last first company address1 address2 city county state zip
908 country daytime night fax );
912 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
913 or return "Illegal payby: ". $self->payby;
915 # If it is encrypted and the private key is not availaible then we can't
916 # check the credit card.
918 my $check_payinfo = 1;
920 if ($self->is_encrypted($self->payinfo)) {
926 if ( $check_payinfo && ($self->payby eq 'CARD' || $self->payby eq 'DCRD')) {
928 my $payinfo = $self->payinfo;
930 $payinfo =~ /^(\d{13,16})$/
931 or return gettext('invalid_card'); # . ": ". $self->payinfo;
933 $self->payinfo($payinfo);
935 or return gettext('invalid_card'); # . ": ". $self->payinfo;
936 return gettext('unknown_card_type')
937 if cardtype($self->payinfo) eq "Unknown";
938 if ( defined $self->dbdef_table->column('paycvv') ) {
939 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
940 if ( cardtype($self->payinfo) eq 'American Express card' ) {
941 $self->paycvv =~ /^(\d{4})$/
942 or return "CVV2 (CID) for American Express cards is four digits.";
945 $self->paycvv =~ /^(\d{3})$/
946 or return "CVV2 (CVC2/CID) is three digits.";
954 } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) {
956 my $payinfo = $self->payinfo;
957 $payinfo =~ s/[^\d\@]//g;
958 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
960 $self->payinfo($payinfo);
961 $self->paycvv('') if $self->dbdef_table->column('paycvv');
963 } elsif ( $self->payby eq 'LECB' ) {
965 my $payinfo = $self->payinfo;
967 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
969 $self->payinfo($payinfo);
970 $self->paycvv('') if $self->dbdef_table->column('paycvv');
972 } elsif ( $self->payby eq 'BILL' ) {
974 $error = $self->ut_textn('payinfo');
975 return "Illegal P.O. number: ". $self->payinfo if $error;
976 $self->paycvv('') if $self->dbdef_table->column('paycvv');
978 } elsif ( $self->payby eq 'COMP' ) {
980 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
981 return "You are not permitted to create complimentary accounts."
982 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
985 $error = $self->ut_textn('payinfo');
986 return "Illegal comp account issuer: ". $self->payinfo if $error;
987 $self->paycvv('') if $self->dbdef_table->column('paycvv');
989 } elsif ( $self->payby eq 'PREPAY' ) {
991 my $payinfo = $self->payinfo;
992 $payinfo =~ s/\W//g; #anything else would just confuse things
993 $self->payinfo($payinfo);
994 $error = $self->ut_alpha('payinfo');
995 return "Illegal prepayment identifier: ". $self->payinfo if $error;
996 return "Unknown prepayment identifier"
997 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
998 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1002 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1003 return "Expriation date required"
1004 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
1008 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1009 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1010 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1011 ( $m, $y ) = ( $3, "20$2" );
1013 return "Illegal expiration date: ". $self->paydate;
1015 $self->paydate("$y-$m-01");
1016 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1017 return gettext('expired_card')
1018 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1021 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1022 ( ! $conf->exists('require_cardname')
1023 || $self->payby !~ /^(CARD|DCRD)$/ )
1025 $self->payname( $self->first. " ". $self->getfield('last') );
1027 $self->payname =~ /^([\w \,\.\-\']+)$/
1028 or return gettext('illegal_name'). " payname: ". $self->payname;
1032 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1035 $self->otaker(getotaker) unless $self->otaker;
1037 #warn "AFTER: \n". $self->_dump;
1039 $self->SUPER::check;
1044 Returns all packages (see L<FS::cust_pkg>) for this customer.
1050 if ( $self->{'_pkgnum'} ) {
1051 values %{ $self->{'_pkgnum'}->cache };
1053 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1057 =item ncancelled_pkgs
1059 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1063 sub ncancelled_pkgs {
1065 if ( $self->{'_pkgnum'} ) {
1066 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1068 @{ [ # force list context
1069 qsearch( 'cust_pkg', {
1070 'custnum' => $self->custnum,
1073 qsearch( 'cust_pkg', {
1074 'custnum' => $self->custnum,
1081 =item suspended_pkgs
1083 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1087 sub suspended_pkgs {
1089 grep { $_->susp } $self->ncancelled_pkgs;
1092 =item unflagged_suspended_pkgs
1094 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1095 customer (thouse packages without the `manual_flag' set).
1099 sub unflagged_suspended_pkgs {
1101 return $self->suspended_pkgs
1102 unless dbdef->table('cust_pkg')->column('manual_flag');
1103 grep { ! $_->manual_flag } $self->suspended_pkgs;
1106 =item unsuspended_pkgs
1108 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1113 sub unsuspended_pkgs {
1115 grep { ! $_->susp } $self->ncancelled_pkgs;
1118 =item num_cancelled_pkgs
1120 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1125 sub num_cancelled_pkgs {
1127 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1131 my( $self, $sql ) = @_;
1132 my $sth = dbh->prepare(
1133 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1134 ) or die dbh->errstr;
1135 $sth->execute($self->custnum) or die $sth->errstr;
1136 $sth->fetchrow_arrayref->[0];
1141 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1142 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1143 on success or a list of errors.
1149 grep { $_->unsuspend } $self->suspended_pkgs;
1154 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1155 Always returns a list: an empty list on success or a list of errors.
1161 grep { $_->suspend } $self->unsuspended_pkgs;
1164 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1166 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1167 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1168 success or a list of errors.
1172 sub suspend_if_pkgpart {
1175 grep { $_->suspend }
1176 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1177 $self->unsuspended_pkgs;
1180 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1182 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1183 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1184 on success or a list of errors.
1188 sub suspend_unless_pkgpart {
1191 grep { $_->suspend }
1192 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1193 $self->unsuspended_pkgs;
1196 =item cancel [ OPTION => VALUE ... ]
1198 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1200 Available options are: I<quiet>
1202 I<quiet> can be set true to supress email cancellation notices.
1204 Always returns a list: an empty list on success or a list of errors.
1210 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1215 Returns the agent (see L<FS::agent>) for this customer.
1221 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1226 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1227 conjunction with the collect method.
1229 Options are passed as name-value pairs.
1231 Currently available options are:
1233 resetup - if set true, re-charges setup fees.
1235 time - bills the customer as if it were that time. Specified as a UNIX
1236 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1237 L<Date::Parse> for conversion functions. For example:
1241 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1244 If there is an error, returns the error, otherwise returns false.
1249 my( $self, %options ) = @_;
1250 return '' if $self->payby eq 'COMP';
1251 warn "bill customer ". $self->custnum if $DEBUG;
1253 my $time = $options{'time'} || time;
1258 local $SIG{HUP} = 'IGNORE';
1259 local $SIG{INT} = 'IGNORE';
1260 local $SIG{QUIT} = 'IGNORE';
1261 local $SIG{TERM} = 'IGNORE';
1262 local $SIG{TSTP} = 'IGNORE';
1263 local $SIG{PIPE} = 'IGNORE';
1265 my $oldAutoCommit = $FS::UID::AutoCommit;
1266 local $FS::UID::AutoCommit = 0;
1269 $self->select_for_update; #mutex
1271 # find the packages which are due for billing, find out how much they are
1272 # & generate invoice database.
1274 my( $total_setup, $total_recur ) = ( 0, 0 );
1275 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1276 my @cust_bill_pkg = ();
1278 #my $taxable_charged = 0;##
1283 foreach my $cust_pkg (
1284 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1287 #NO!! next if $cust_pkg->cancel;
1288 next if $cust_pkg->getfield('cancel');
1290 warn " bill package ". $cust_pkg->pkgnum if $DEBUG;
1292 #? to avoid use of uninitialized value errors... ?
1293 $cust_pkg->setfield('bill', '')
1294 unless defined($cust_pkg->bill);
1296 my $part_pkg = $cust_pkg->part_pkg;
1298 my %hash = $cust_pkg->hash;
1299 my $old_cust_pkg = new FS::cust_pkg \%hash;
1305 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1307 warn " bill setup" if $DEBUG;
1309 $setup = eval { $cust_pkg->calc_setup( $time ) };
1311 $dbh->rollback if $oldAutoCommit;
1315 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1321 if ( $part_pkg->getfield('freq') ne '0' &&
1322 ! $cust_pkg->getfield('susp') &&
1323 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1326 warn " bill recur" if $DEBUG;
1328 # XXX shared with $recur_prog
1329 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1331 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1333 $dbh->rollback if $oldAutoCommit;
1337 #change this bit to use Date::Manip? CAREFUL with timezones (see
1338 # mailing list archive)
1339 my ($sec,$min,$hour,$mday,$mon,$year) =
1340 (localtime($sdate) )[0,1,2,3,4,5];
1342 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1343 # only for figuring next bill date, nothing else, so, reset $sdate again
1345 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1346 $cust_pkg->last_bill($sdate)
1347 if $cust_pkg->dbdef_table->column('last_bill');
1349 if ( $part_pkg->freq =~ /^\d+$/ ) {
1350 $mon += $part_pkg->freq;
1351 until ( $mon < 12 ) { $mon -= 12; $year++; }
1352 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1354 $mday += $weeks * 7;
1355 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1359 $dbh->rollback if $oldAutoCommit;
1360 return "unparsable frequency: ". $part_pkg->freq;
1362 $cust_pkg->setfield('bill',
1363 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1366 warn "\$setup is undefined" unless defined($setup);
1367 warn "\$recur is undefined" unless defined($recur);
1368 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1370 if ( $cust_pkg->modified ) {
1372 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1374 $error=$cust_pkg->replace($old_cust_pkg);
1375 if ( $error ) { #just in case
1376 $dbh->rollback if $oldAutoCommit;
1377 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1380 $setup = sprintf( "%.2f", $setup );
1381 $recur = sprintf( "%.2f", $recur );
1382 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1383 $dbh->rollback if $oldAutoCommit;
1384 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1386 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1387 $dbh->rollback if $oldAutoCommit;
1388 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1390 if ( $setup != 0 || $recur != 0 ) {
1391 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1393 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1394 'pkgnum' => $cust_pkg->pkgnum,
1398 'edate' => $cust_pkg->bill,
1399 'details' => \@details,
1401 push @cust_bill_pkg, $cust_bill_pkg;
1402 $total_setup += $setup;
1403 $total_recur += $recur;
1405 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1407 my @taxes = qsearch( 'cust_main_county', {
1408 'state' => $self->state,
1409 'county' => $self->county,
1410 'country' => $self->country,
1411 'taxclass' => $part_pkg->taxclass,
1414 @taxes = qsearch( 'cust_main_county', {
1415 'state' => $self->state,
1416 'county' => $self->county,
1417 'country' => $self->country,
1422 #one more try at a whole-country tax rate
1424 @taxes = qsearch( 'cust_main_county', {
1427 'country' => $self->country,
1432 # maybe eliminate this entirely, along with all the 0% records
1434 $dbh->rollback if $oldAutoCommit;
1436 "fatal: can't find tax rate for state/county/country/taxclass ".
1437 join('/', ( map $self->$_(), qw(state county country) ),
1438 $part_pkg->taxclass ). "\n";
1441 foreach my $tax ( @taxes ) {
1443 my $taxable_charged = 0;
1444 $taxable_charged += $setup
1445 unless $part_pkg->setuptax =~ /^Y$/i
1446 || $tax->setuptax =~ /^Y$/i;
1447 $taxable_charged += $recur
1448 unless $part_pkg->recurtax =~ /^Y$/i
1449 || $tax->recurtax =~ /^Y$/i;
1450 next unless $taxable_charged;
1452 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1453 my ($mon,$year) = (localtime($sdate) )[4,5];
1455 my $freq = $part_pkg->freq || 1;
1456 if ( $freq !~ /(\d+)$/ ) {
1457 $dbh->rollback if $oldAutoCommit;
1458 return "daily/weekly package definitions not (yet?)".
1459 " compatible with monthly tax exemptions";
1461 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1462 foreach my $which_month ( 1 .. $freq ) {
1464 'custnum' => $self->custnum,
1465 'taxnum' => $tax->taxnum,
1466 'year' => 1900+$year,
1469 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1470 until ( $mon < 13 ) { $mon -= 12; $year++; }
1471 my $cust_tax_exempt =
1472 qsearchs('cust_tax_exempt', \%hash)
1473 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1474 my $remaining_exemption = sprintf("%.2f",
1475 $tax->exempt_amount - $cust_tax_exempt->amount );
1476 if ( $remaining_exemption > 0 ) {
1477 my $addl = $remaining_exemption > $taxable_per_month
1478 ? $taxable_per_month
1479 : $remaining_exemption;
1480 $taxable_charged -= $addl;
1481 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1482 $cust_tax_exempt->hash,
1484 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1486 $error = $new_cust_tax_exempt->exemptnum
1487 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1488 : $new_cust_tax_exempt->insert;
1490 $dbh->rollback if $oldAutoCommit;
1491 return "fatal: can't update cust_tax_exempt: $error";
1494 } # if $remaining_exemption > 0
1496 } #foreach $which_month
1498 } #if $tax->exempt_amount
1500 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1502 #$tax += $taxable_charged * $cust_main_county->tax / 100
1503 $tax{ $tax->taxname || 'Tax' } +=
1504 $taxable_charged * $tax->tax / 100
1506 } #foreach my $tax ( @taxes )
1508 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1510 } #if $setup != 0 || $recur != 0
1512 } #if $cust_pkg->modified
1514 } #foreach my $cust_pkg
1516 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1517 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1519 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1520 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1524 # unless ( $self->tax =~ /Y/i
1525 # || $self->payby eq 'COMP'
1526 # || $taxable_charged == 0 ) {
1527 # my $cust_main_county = qsearchs('cust_main_county',{
1528 # 'state' => $self->state,
1529 # 'county' => $self->county,
1530 # 'country' => $self->country,
1531 # } ) or die "fatal: can't find tax rate for state/county/country ".
1532 # $self->state. "/". $self->county. "/". $self->country. "\n";
1533 # my $tax = sprintf( "%.2f",
1534 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1537 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1539 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1540 my $tax = sprintf("%.2f", $tax{$taxname} );
1541 $charged = sprintf( "%.2f", $charged+$tax );
1543 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1549 'itemdesc' => $taxname,
1551 push @cust_bill_pkg, $cust_bill_pkg;
1554 } else { #1.4 schema
1557 foreach ( values %tax ) { $tax += $_ };
1558 $tax = sprintf("%.2f", $tax);
1560 $charged = sprintf( "%.2f", $charged+$tax );
1562 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1569 push @cust_bill_pkg, $cust_bill_pkg;
1574 my $cust_bill = new FS::cust_bill ( {
1575 'custnum' => $self->custnum,
1577 'charged' => $charged,
1579 $error = $cust_bill->insert;
1581 $dbh->rollback if $oldAutoCommit;
1582 return "can't create invoice for customer #". $self->custnum. ": $error";
1585 my $invnum = $cust_bill->invnum;
1587 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1589 $cust_bill_pkg->invnum($invnum);
1590 $error = $cust_bill_pkg->insert;
1592 $dbh->rollback if $oldAutoCommit;
1593 return "can't create invoice line item for customer #". $self->custnum.
1598 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1602 =item collect OPTIONS
1604 (Attempt to) collect money for this customer's outstanding invoices (see
1605 L<FS::cust_bill>). Usually used after the bill method.
1607 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1608 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1609 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1611 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1612 and the invoice events web interface.
1614 If there is an error, returns the error, otherwise returns false.
1616 Options are passed as name-value pairs.
1618 Currently available options are:
1620 invoice_time - Use this time when deciding when to print invoices and
1621 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>
1622 for conversion functions.
1624 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1627 retry_card - Deprecated alias for 'retry'
1629 batch_card - This option is deprecated. See the invoice events web interface
1630 to control whether cards are batched or run against a realtime gateway.
1632 report_badcard - This option is deprecated.
1634 force_print - This option is deprecated; see the invoice events web interface.
1636 quiet - set true to surpress email card/ACH decline notices.
1641 my( $self, %options ) = @_;
1642 my $invoice_time = $options{'invoice_time'} || time;
1645 local $SIG{HUP} = 'IGNORE';
1646 local $SIG{INT} = 'IGNORE';
1647 local $SIG{QUIT} = 'IGNORE';
1648 local $SIG{TERM} = 'IGNORE';
1649 local $SIG{TSTP} = 'IGNORE';
1650 local $SIG{PIPE} = 'IGNORE';
1652 my $oldAutoCommit = $FS::UID::AutoCommit;
1653 local $FS::UID::AutoCommit = 0;
1656 $self->select_for_update; #mutex
1658 my $balance = $self->balance;
1659 warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1660 unless ( $balance > 0 ) { #redundant?????
1661 $dbh->rollback if $oldAutoCommit; #hmm
1665 if ( exists($options{'retry_card'}) ) {
1666 carp 'retry_card option passed to collect is deprecated; use retry';
1667 $options{'retry'} ||= $options{'retry_card'};
1669 if ( exists($options{'retry'}) && $options{'retry'} ) {
1670 my $error = $self->retry_realtime;
1672 $dbh->rollback if $oldAutoCommit;
1677 foreach my $cust_bill ( $self->open_cust_bill ) {
1679 # don't try to charge for the same invoice if it's already in a batch
1680 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1682 last if $self->balance <= 0;
1684 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1687 foreach my $part_bill_event (
1688 sort { $a->seconds <=> $b->seconds
1689 || $a->weight <=> $b->weight
1690 || $a->eventpart <=> $b->eventpart }
1691 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1692 && ! qsearch( 'cust_bill_event', {
1693 'invnum' => $cust_bill->invnum,
1694 'eventpart' => $_->eventpart,
1698 qsearch('part_bill_event', { 'payby' => $self->payby,
1699 'disabled' => '', } )
1702 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1703 || $self->balance <= 0; # or if balance<=0
1705 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1707 my $cust_main = $self; #for callback
1711 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1712 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1713 $error = eval $part_bill_event->eventcode;
1717 my $statustext = '';
1721 } elsif ( $error ) {
1723 $statustext = $error;
1728 #add cust_bill_event
1729 my $cust_bill_event = new FS::cust_bill_event {
1730 'invnum' => $cust_bill->invnum,
1731 'eventpart' => $part_bill_event->eventpart,
1732 #'_date' => $invoice_time,
1734 'status' => $status,
1735 'statustext' => $statustext,
1737 $error = $cust_bill_event->insert;
1739 #$dbh->rollback if $oldAutoCommit;
1740 #return "error: $error";
1742 # gah, even with transactions.
1743 $dbh->commit if $oldAutoCommit; #well.
1744 my $e = 'WARNING: Event run but database not updated - '.
1745 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1746 ', eventpart '. $part_bill_event->eventpart.
1757 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1762 =item retry_realtime
1764 Schedules realtime credit card / electronic check / LEC billing events for
1765 for retry. Useful if card information has changed or manual retry is desired.
1766 The 'collect' method must be called to actually retry the transaction.
1768 Implementation details: For each of this customer's open invoices, changes
1769 the status of the first "done" (with statustext error) realtime processing
1774 sub retry_realtime {
1777 local $SIG{HUP} = 'IGNORE';
1778 local $SIG{INT} = 'IGNORE';
1779 local $SIG{QUIT} = 'IGNORE';
1780 local $SIG{TERM} = 'IGNORE';
1781 local $SIG{TSTP} = 'IGNORE';
1782 local $SIG{PIPE} = 'IGNORE';
1784 my $oldAutoCommit = $FS::UID::AutoCommit;
1785 local $FS::UID::AutoCommit = 0;
1788 foreach my $cust_bill (
1789 grep { $_->cust_bill_event }
1790 $self->open_cust_bill
1792 my @cust_bill_event =
1793 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1795 #$_->part_bill_event->plan eq 'realtime-card'
1796 $_->part_bill_event->eventcode =~
1797 /\$cust_bill\->realtime_(card|ach|lec)/
1798 && $_->status eq 'done'
1801 $cust_bill->cust_bill_event;
1802 next unless @cust_bill_event;
1803 my $error = $cust_bill_event[0]->retry;
1805 $dbh->rollback if $oldAutoCommit;
1806 return "error scheduling invoice event for retry: $error";
1811 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1816 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1818 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1819 via a Business::OnlinePayment realtime gateway. See
1820 L<http://420.am/business-onlinepayment> for supported gateways.
1822 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1824 Available options are: I<description>, I<invnum>, I<quiet>
1826 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1827 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1828 if set, will override the value from the customer record.
1830 I<description> is a free-text field passed to the gateway. It defaults to
1831 "Internet services".
1833 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1834 specified invoice. If you don't specify an I<invnum> you might want to
1835 call the B<apply_payments> method.
1837 I<quiet> can be set true to surpress email decline notices.
1839 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1844 my( $self, $method, $amount, %options ) = @_;
1846 warn "$self $method $amount\n";
1847 warn " $_ => $options{$_}\n" foreach keys %options;
1850 $options{'description'} ||= 'Internet services';
1853 die "Real-time processing not enabled\n"
1854 unless $conf->exists('business-onlinepayment');
1855 eval "use Business::OnlinePayment";
1859 my $bop_config = 'business-onlinepayment';
1860 $bop_config .= '-ach'
1861 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1862 my ( $processor, $login, $password, $action, @bop_options ) =
1863 $conf->config($bop_config);
1864 $action ||= 'normal authorization';
1865 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1866 die "No real-time processor is enabled - ".
1867 "did you set the business-onlinepayment configuration value?\n"
1872 my $address = exists($options{'address1'})
1873 ? $options{'address1'}
1875 my $address2 = exists($options{'address2'})
1876 ? $options{'address2'}
1878 $address .= ", ". $address2 if length($address2);
1880 my $o_payname = exists($options{'payname'})
1881 ? $options{'payname'}
1883 my($payname, $payfirst, $paylast);
1884 if ( $o_payname && $method ne 'ECHECK' ) {
1885 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1886 or return "Illegal payname $payname";
1887 ($payfirst, $paylast) = ($1, $2);
1889 $payfirst = $self->getfield('first');
1890 $paylast = $self->getfield('last');
1891 $payname = "$payfirst $paylast";
1894 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1895 if ( $conf->exists('emailinvoiceauto')
1896 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1897 push @invoicing_list, $self->all_emails;
1899 my $email = $invoicing_list[0];
1901 my $payinfo = exists($options{'payinfo'})
1902 ? $options{'payinfo'}
1906 if ( $method eq 'CC' ) {
1908 $content{card_number} = $payinfo;
1909 my $paydate = exists($options{'paydate'})
1910 ? $options{'paydate'}
1912 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1913 $content{expiration} = "$2/$1";
1915 if ( defined $self->dbdef_table->column('paycvv') ) {
1916 my $paycvv = exists($options{'paycvv'})
1917 ? $options{'paycvv'}
1919 $content{cvv2} = $self->paycvv
1923 $content{recurring_billing} = 'YES'
1924 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1926 'payinfo' => $payinfo,
1929 } elsif ( $method eq 'ECHECK' ) {
1930 ( $content{account_number}, $content{routing_code} ) =
1931 split('@', $payinfo);
1932 $content{bank_name} = $o_payname;
1933 $content{account_type} = 'CHECKING';
1934 $content{account_name} = $payname;
1935 $content{customer_org} = $self->company ? 'B' : 'I';
1936 $content{customer_ssn} = exists($options{'ss'})
1939 } elsif ( $method eq 'LEC' ) {
1940 $content{phone} = $payinfo;
1945 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1947 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1948 $transaction->content(
1951 'password' => $password,
1952 'action' => $action1,
1953 'description' => $options{'description'},
1954 'amount' => $amount,
1955 'invoice_number' => $options{'invnum'},
1956 'customer_id' => $self->custnum,
1957 'last_name' => $paylast,
1958 'first_name' => $payfirst,
1960 'address' => $address,
1961 'city' => ( exists($options{'city'})
1964 'state' => ( exists($options{'state'})
1967 'zip' => ( exists($options{'zip'})
1970 'country' => ( exists($options{'country'})
1971 ? $options{'country'}
1973 'referer' => 'http://cleanwhisker.420.am/',
1975 'phone' => $self->daytime || $self->night,
1978 $transaction->submit();
1980 if ( $transaction->is_success() && $action2 ) {
1981 my $auth = $transaction->authorization;
1982 my $ordernum = $transaction->can('order_number')
1983 ? $transaction->order_number
1987 new Business::OnlinePayment( $processor, @bop_options );
1994 password => $password,
1995 order_number => $ordernum,
1997 authorization => $auth,
1998 description => $options{'description'},
2001 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2002 transaction_sequence_num local_transaction_date
2003 local_transaction_time AVS_result_code )) {
2004 $capture{$field} = $transaction->$field() if $transaction->can($field);
2007 $capture->content( %capture );
2011 unless ( $capture->is_success ) {
2012 my $e = "Authorization sucessful but capture failed, custnum #".
2013 $self->custnum. ': '. $capture->result_code.
2014 ": ". $capture->error_message;
2021 #remove paycvv after initial transaction
2022 #false laziness w/misc/process/payment.cgi - check both to make sure working
2024 if ( defined $self->dbdef_table->column('paycvv')
2025 && length($self->paycvv)
2026 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2028 my $error = $self->remove_cvv;
2030 warn "error removing cvv: $error\n";
2035 if ( $transaction->is_success() ) {
2037 my %method2payby = (
2043 my $paybatch = "$processor:". $transaction->authorization;
2044 $paybatch .= ':'. $transaction->order_number
2045 if $transaction->can('order_number')
2046 && length($transaction->order_number);
2048 my $cust_pay = new FS::cust_pay ( {
2049 'custnum' => $self->custnum,
2050 'invnum' => $options{'invnum'},
2053 'payby' => $method2payby{$method},
2054 'payinfo' => $payinfo,
2055 'paybatch' => $paybatch,
2057 my $error = $cust_pay->insert;
2059 $cust_pay->invnum(''); #try again with no specific invnum
2060 my $error2 = $cust_pay->insert;
2062 # gah, even with transactions.
2063 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2064 "error inserting payment ($processor): $error2".
2065 " (previously tried insert with invnum #$options{'invnum'}" .
2071 return ''; #no error
2075 my $perror = "$processor error: ". $transaction->error_message;
2077 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2078 && $conf->exists('emaildecline')
2079 && grep { $_ ne 'POST' } $self->invoicing_list
2080 && ! grep { $transaction->error_message =~ /$_/ }
2081 $conf->config('emaildecline-exclude')
2083 my @templ = $conf->config('declinetemplate');
2084 my $template = new Text::Template (
2086 SOURCE => [ map "$_\n", @templ ],
2087 ) or return "($perror) can't create template: $Text::Template::ERROR";
2088 $template->compile()
2089 or return "($perror) can't compile template: $Text::Template::ERROR";
2091 my $templ_hash = { error => $transaction->error_message };
2093 my $error = send_email(
2094 'from' => $conf->config('invoice_from'),
2095 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2096 'subject' => 'Your payment could not be processed',
2097 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2100 $perror .= " (also received error sending decline notification: $error)"
2112 Removes the I<paycvv> field from the database directly.
2114 If there is an error, returns the error, otherwise returns false.
2120 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2121 or return dbh->errstr;
2122 $sth->execute($self->custnum)
2123 or return $sth->errstr;
2128 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2130 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2131 via a Business::OnlinePayment realtime gateway. See
2132 L<http://420.am/business-onlinepayment> for supported gateways.
2134 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2136 Available options are: I<amount>, I<reason>, I<paynum>
2138 Most gateways require a reference to an original payment transaction to refund,
2139 so you probably need to specify a I<paynum>.
2141 I<amount> defaults to the original amount of the payment if not specified.
2143 I<reason> specifies a reason for the refund.
2145 Implementation note: If I<amount> is unspecified or equal to the amount of the
2146 orignal payment, first an attempt is made to "void" the transaction via
2147 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2148 the normal attempt is made to "refund" ("credit") the transaction via the
2149 gateway is attempted.
2151 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2152 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2153 #if set, will override the value from the customer record.
2155 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2156 #specified invoice. If you don't specify an I<invnum> you might want to
2157 #call the B<apply_payments> method.
2161 #some false laziness w/realtime_bop, not enough to make it worth merging
2162 #but some useful small subs should be pulled out
2163 sub realtime_refund_bop {
2164 my( $self, $method, %options ) = @_;
2166 warn "$self $method refund\n";
2167 warn " $_ => $options{$_}\n" foreach keys %options;
2171 die "Real-time processing not enabled\n"
2172 unless $conf->exists('business-onlinepayment');
2173 eval "use Business::OnlinePayment";
2177 my $bop_config = 'business-onlinepayment';
2178 $bop_config .= '-ach'
2179 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2180 my ( $processor, $login, $password, $unused_action, @bop_options ) =
2181 $conf->config($bop_config);
2182 #$action ||= 'normal authorization';
2183 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2184 die "No real-time processor is enabled - ".
2185 "did you set the business-onlinepayment configuration value?\n"
2189 my $amount = $options{'amount'};
2190 my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2191 if ( $options{'paynum'} ) {
2192 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2193 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2194 or return "Unknown paynum $options{'paynum'}";
2195 $amount ||= $cust_pay->paid;
2196 $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/
2197 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2198 $cust_pay->paybatch;
2199 ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2200 return "processor of payment $options{'paynum'} $pay_processor does not".
2201 " match current processor $processor"
2202 unless $pay_processor eq $processor;
2204 return "neither amount nor paynum specified" unless $amount;
2209 'password' => $password,
2210 'order_number' => $order_number,
2211 'amount' => $amount,
2212 'referer' => 'http://cleanwhisker.420.am/',
2214 $content{authorization} = $auth
2215 if length($auth); #echeck/ACH transactions have an order # but no auth
2216 #(at least with authorize.net)
2218 #first try void if applicable
2219 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2220 warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2221 my $void = new Business::OnlinePayment( $processor, @bop_options );
2222 $void->content( 'action' => 'void', %content );
2224 if ( $void->is_success ) {
2225 my $error = $cust_pay->void($options{'reason'});
2227 # gah, even with transactions.
2228 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2229 "error voiding payment: $error";
2233 warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2238 warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2242 my $address = $self->address1;
2243 $address .= ", ". $self->address2 if $self->address2;
2245 my($payname, $payfirst, $paylast);
2246 if ( $self->payname && $method ne 'ECHECK' ) {
2247 $payname = $self->payname;
2248 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2249 or return "Illegal payname $payname";
2250 ($payfirst, $paylast) = ($1, $2);
2252 $payfirst = $self->getfield('first');
2253 $paylast = $self->getfield('last');
2254 $payname = "$payfirst $paylast";
2258 if ( $method eq 'CC' ) {
2261 $content{card_number} = $payinfo = $cust_pay->payinfo;
2262 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2263 #$content{expiration} = "$2/$1";
2265 $content{card_number} = $payinfo = $self->payinfo;
2266 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2267 $content{expiration} = "$2/$1";
2270 } elsif ( $method eq 'ECHECK' ) {
2271 ( $content{account_number}, $content{routing_code} ) =
2272 split('@', $payinfo = $self->payinfo);
2273 $content{bank_name} = $self->payname;
2274 $content{account_type} = 'CHECKING';
2275 $content{account_name} = $payname;
2276 $content{customer_org} = $self->company ? 'B' : 'I';
2277 $content{customer_ssn} = $self->ss;
2278 } elsif ( $method eq 'LEC' ) {
2279 $content{phone} = $payinfo = $self->payinfo;
2283 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2284 my %sub_content = $refund->content(
2285 'action' => 'credit',
2286 'customer_id' => $self->custnum,
2287 'last_name' => $paylast,
2288 'first_name' => $payfirst,
2290 'address' => $address,
2291 'city' => $self->city,
2292 'state' => $self->state,
2293 'zip' => $self->zip,
2294 'country' => $self->country,
2297 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2301 return "$processor error: ". $refund->error_message
2302 unless $refund->is_success();
2304 my %method2payby = (
2310 my $paybatch = "$processor:". $refund->authorization;
2311 $paybatch .= ':'. $refund->order_number
2312 if $refund->can('order_number') && $refund->order_number;
2314 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2315 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2316 last unless @cust_bill_pay;
2317 my $cust_bill_pay = pop @cust_bill_pay;
2318 my $error = $cust_bill_pay->delete;
2322 my $cust_refund = new FS::cust_refund ( {
2323 'custnum' => $self->custnum,
2324 'paynum' => $options{'paynum'},
2325 'refund' => $amount,
2327 'payby' => $method2payby{$method},
2328 'payinfo' => $payinfo,
2329 'paybatch' => $paybatch,
2330 'reason' => $options{'reason'} || 'card or ACH refund',
2332 my $error = $cust_refund->insert;
2334 $cust_refund->paynum(''); #try again with no specific paynum
2335 my $error2 = $cust_refund->insert;
2337 # gah, even with transactions.
2338 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2339 "error inserting refund ($processor): $error2".
2340 " (previously tried insert with paynum #$options{'paynum'}" .
2353 Returns the total owed for this customer on all invoices
2354 (see L<FS::cust_bill/owed>).
2360 $self->total_owed_date(2145859200); #12/31/2037
2363 =item total_owed_date TIME
2365 Returns the total owed for this customer on all invoices with date earlier than
2366 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2367 see L<Time::Local> and L<Date::Parse> for conversion functions.
2371 sub total_owed_date {
2375 foreach my $cust_bill (
2376 grep { $_->_date <= $time }
2377 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2379 $total_bill += $cust_bill->owed;
2381 sprintf( "%.2f", $total_bill );
2384 =item apply_credits OPTION => VALUE ...
2386 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2387 to outstanding invoice balances in chronological order (or reverse
2388 chronological order if the I<order> option is set to B<newest>) and returns the
2389 value of any remaining unapplied credits available for refund (see
2390 L<FS::cust_refund>).
2398 return 0 unless $self->total_credited;
2400 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2401 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2403 my @invoices = $self->open_cust_bill;
2404 @invoices = sort { $b->_date <=> $a->_date } @invoices
2405 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2408 foreach my $cust_bill ( @invoices ) {
2411 if ( !defined($credit) || $credit->credited == 0) {
2412 $credit = pop @credits or last;
2415 if ($cust_bill->owed >= $credit->credited) {
2416 $amount=$credit->credited;
2418 $amount=$cust_bill->owed;
2421 my $cust_credit_bill = new FS::cust_credit_bill ( {
2422 'crednum' => $credit->crednum,
2423 'invnum' => $cust_bill->invnum,
2424 'amount' => $amount,
2426 my $error = $cust_credit_bill->insert;
2427 die $error if $error;
2429 redo if ($cust_bill->owed > 0);
2433 return $self->total_credited;
2436 =item apply_payments
2438 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2439 to outstanding invoice balances in chronological order.
2441 #and returns the value of any remaining unapplied payments.
2445 sub apply_payments {
2450 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2451 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2453 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2454 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2458 foreach my $cust_bill ( @invoices ) {
2461 if ( !defined($payment) || $payment->unapplied == 0 ) {
2462 $payment = pop @payments or last;
2465 if ( $cust_bill->owed >= $payment->unapplied ) {
2466 $amount = $payment->unapplied;
2468 $amount = $cust_bill->owed;
2471 my $cust_bill_pay = new FS::cust_bill_pay ( {
2472 'paynum' => $payment->paynum,
2473 'invnum' => $cust_bill->invnum,
2474 'amount' => $amount,
2476 my $error = $cust_bill_pay->insert;
2477 die $error if $error;
2479 redo if ( $cust_bill->owed > 0);
2483 return $self->total_unapplied_payments;
2486 =item total_credited
2488 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2489 customer. See L<FS::cust_credit/credited>.
2493 sub total_credited {
2495 my $total_credit = 0;
2496 foreach my $cust_credit ( qsearch('cust_credit', {
2497 'custnum' => $self->custnum,
2499 $total_credit += $cust_credit->credited;
2501 sprintf( "%.2f", $total_credit );
2504 =item total_unapplied_payments
2506 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2507 See L<FS::cust_pay/unapplied>.
2511 sub total_unapplied_payments {
2513 my $total_unapplied = 0;
2514 foreach my $cust_pay ( qsearch('cust_pay', {
2515 'custnum' => $self->custnum,
2517 $total_unapplied += $cust_pay->unapplied;
2519 sprintf( "%.2f", $total_unapplied );
2524 Returns the balance for this customer (total_owed minus total_credited
2525 minus total_unapplied_payments).
2532 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2536 =item balance_date TIME
2538 Returns the balance for this customer, only considering invoices with date
2539 earlier than TIME (total_owed_date minus total_credited minus
2540 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2541 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2550 $self->total_owed_date($time)
2551 - $self->total_credited
2552 - $self->total_unapplied_payments
2556 =item paydate_monthyear
2558 Returns a two-element list consisting of the month and year of this customer's
2559 paydate (credit card expiration date for CARD customers)
2563 sub paydate_monthyear {
2565 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2567 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2574 =item payinfo_masked
2576 Returns a "masked" payinfo field appropriate to the payment type. Masked characters are replaced by 'x'es. Use this to display publicly accessable account Information.
2578 Credit Cards - Mask all but the last four characters.
2579 Checks - Mask all but last 2 of account number and bank routing number.
2580 Others - Do nothing, return the unmasked string.
2584 sub payinfo_masked {
2586 return $self->paymask;
2589 =item invoicing_list [ ARRAYREF ]
2591 If an arguement is given, sets these email addresses as invoice recipients
2592 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2593 (except as warnings), so use check_invoicing_list first.
2595 Returns a list of email addresses (with svcnum entries expanded).
2597 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2598 check it without disturbing anything by passing nothing.
2600 This interface may change in the future.
2604 sub invoicing_list {
2605 my( $self, $arrayref ) = @_;
2607 my @cust_main_invoice;
2608 if ( $self->custnum ) {
2609 @cust_main_invoice =
2610 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2612 @cust_main_invoice = ();
2614 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2615 #warn $cust_main_invoice->destnum;
2616 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2617 #warn $cust_main_invoice->destnum;
2618 my $error = $cust_main_invoice->delete;
2619 warn $error if $error;
2622 if ( $self->custnum ) {
2623 @cust_main_invoice =
2624 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2626 @cust_main_invoice = ();
2628 my %seen = map { $_->address => 1 } @cust_main_invoice;
2629 foreach my $address ( @{$arrayref} ) {
2630 next if exists $seen{$address} && $seen{$address};
2631 $seen{$address} = 1;
2632 my $cust_main_invoice = new FS::cust_main_invoice ( {
2633 'custnum' => $self->custnum,
2636 my $error = $cust_main_invoice->insert;
2637 warn $error if $error;
2640 if ( $self->custnum ) {
2642 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2648 =item check_invoicing_list ARRAYREF
2650 Checks these arguements as valid input for the invoicing_list method. If there
2651 is an error, returns the error, otherwise returns false.
2655 sub check_invoicing_list {
2656 my( $self, $arrayref ) = @_;
2657 foreach my $address ( @{$arrayref} ) {
2658 my $cust_main_invoice = new FS::cust_main_invoice ( {
2659 'custnum' => $self->custnum,
2662 my $error = $self->custnum
2663 ? $cust_main_invoice->check
2664 : $cust_main_invoice->checkdest
2666 return $error if $error;
2671 =item set_default_invoicing_list
2673 Sets the invoicing list to all accounts associated with this customer,
2674 overwriting any previous invoicing list.
2678 sub set_default_invoicing_list {
2680 $self->invoicing_list($self->all_emails);
2685 Returns the email addresses of all accounts provisioned for this customer.
2692 foreach my $cust_pkg ( $self->all_pkgs ) {
2693 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2695 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2696 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2698 $list{$_}=1 foreach map { $_->email } @svc_acct;
2703 =item invoicing_list_addpost
2705 Adds postal invoicing to this customer. If this customer is already configured
2706 to receive postal invoices, does nothing.
2710 sub invoicing_list_addpost {
2712 return if grep { $_ eq 'POST' } $self->invoicing_list;
2713 my @invoicing_list = $self->invoicing_list;
2714 push @invoicing_list, 'POST';
2715 $self->invoicing_list(\@invoicing_list);
2718 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2720 Returns an array of customers referred by this customer (referral_custnum set
2721 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2722 customers referred by customers referred by this customer and so on, inclusive.
2723 The default behavior is DEPTH 1 (no recursion).
2727 sub referral_cust_main {
2729 my $depth = @_ ? shift : 1;
2730 my $exclude = @_ ? shift : {};
2733 map { $exclude->{$_->custnum}++; $_; }
2734 grep { ! $exclude->{ $_->custnum } }
2735 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2739 map { $_->referral_cust_main($depth-1, $exclude) }
2746 =item referral_cust_main_ncancelled
2748 Same as referral_cust_main, except only returns customers with uncancelled
2753 sub referral_cust_main_ncancelled {
2755 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2758 =item referral_cust_pkg [ DEPTH ]
2760 Like referral_cust_main, except returns a flat list of all unsuspended (and
2761 uncancelled) packages for each customer. The number of items in this list may
2762 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2766 sub referral_cust_pkg {
2768 my $depth = @_ ? shift : 1;
2770 map { $_->unsuspended_pkgs }
2771 grep { $_->unsuspended_pkgs }
2772 $self->referral_cust_main($depth);
2775 =item referring_cust_main
2777 Returns the single cust_main record for the customer who referred this customer
2778 (referral_custnum), or false.
2782 sub referring_cust_main {
2784 return '' unless $self->referral_custnum;
2785 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2788 =item credit AMOUNT, REASON
2790 Applies a credit to this customer. If there is an error, returns the error,
2791 otherwise returns false.
2796 my( $self, $amount, $reason ) = @_;
2797 my $cust_credit = new FS::cust_credit {
2798 'custnum' => $self->custnum,
2799 'amount' => $amount,
2800 'reason' => $reason,
2802 $cust_credit->insert;
2805 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2807 Creates a one-time charge for this customer. If there is an error, returns
2808 the error, otherwise returns false.
2813 my ( $self, $amount ) = ( shift, shift );
2814 my $pkg = @_ ? shift : 'One-time charge';
2815 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2816 my $taxclass = @_ ? shift : '';
2818 local $SIG{HUP} = 'IGNORE';
2819 local $SIG{INT} = 'IGNORE';
2820 local $SIG{QUIT} = 'IGNORE';
2821 local $SIG{TERM} = 'IGNORE';
2822 local $SIG{TSTP} = 'IGNORE';
2823 local $SIG{PIPE} = 'IGNORE';
2825 my $oldAutoCommit = $FS::UID::AutoCommit;
2826 local $FS::UID::AutoCommit = 0;
2829 my $part_pkg = new FS::part_pkg ( {
2831 'comment' => $comment,
2832 #'setup' => $amount,
2835 'plandata' => "setup_fee=$amount",
2838 'taxclass' => $taxclass,
2841 my $error = $part_pkg->insert;
2843 $dbh->rollback if $oldAutoCommit;
2847 my $pkgpart = $part_pkg->pkgpart;
2848 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2849 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2850 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2851 $error = $type_pkgs->insert;
2853 $dbh->rollback if $oldAutoCommit;
2858 my $cust_pkg = new FS::cust_pkg ( {
2859 'custnum' => $self->custnum,
2860 'pkgpart' => $pkgpart,
2863 $error = $cust_pkg->insert;
2865 $dbh->rollback if $oldAutoCommit;
2869 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2876 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2882 sort { $a->_date <=> $b->_date }
2883 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2886 =item open_cust_bill
2888 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2893 sub open_cust_bill {
2895 grep { $_->owed > 0 } $self->cust_bill;
2900 Returns all the credits (see L<FS::cust_credit>) for this customer.
2906 sort { $a->_date <=> $b->_date }
2907 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2912 Returns all the payments (see L<FS::cust_pay>) for this customer.
2918 sort { $a->_date <=> $b->_date }
2919 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2924 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2930 sort { $a->_date <=> $b->_date }
2931 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2937 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2943 sort { $a->_date <=> $b->_date }
2944 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2947 =item select_for_update
2949 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2954 sub select_for_update {
2956 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2961 Returns a name string for this customer, either "Company (Last, First)" or
2968 my $name = $self->get('last'). ', '. $self->first;
2969 $name = $self->company. " ($name)" if $self->company;
2975 Returns a status string for this customer, currently:
2979 =item prospect - No packages have ever been ordered
2981 =item active - One or more recurring packages is active
2983 =item suspended - All non-cancelled recurring packages are suspended
2985 =item cancelled - All recurring packages are cancelled
2993 for my $status (qw( prospect active suspended cancelled )) {
2994 my $method = $status.'_sql';
2995 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2996 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2997 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2998 return $status if $sth->fetchrow_arrayref->[0];
3004 Returns a hex triplet color string for this customer's status.
3009 'prospect' => '000000',
3010 'active' => '00CC00',
3011 'suspended' => 'FF9900',
3012 'cancelled' => 'FF0000',
3016 $statuscolor{$self->status};
3021 =head1 CLASS METHODS
3027 Returns an SQL expression identifying prospective cust_main records (customers
3028 with no packages ever ordered)
3032 sub prospect_sql { "
3033 0 = ( SELECT COUNT(*) FROM cust_pkg
3034 WHERE cust_pkg.custnum = cust_main.custnum
3040 Returns an SQL expression identifying active cust_main records.
3045 0 < ( SELECT COUNT(*) FROM cust_pkg
3046 WHERE cust_pkg.custnum = cust_main.custnum
3047 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3048 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3055 Returns an SQL expression identifying suspended cust_main records.
3059 sub suspended_sql { susp_sql(@_); }
3061 0 < ( SELECT COUNT(*) FROM cust_pkg
3062 WHERE cust_pkg.custnum = cust_main.custnum
3063 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3065 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3066 WHERE cust_pkg.custnum = cust_main.custnum
3067 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3068 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3075 Returns an SQL expression identifying cancelled cust_main records.
3079 sub cancelled_sql { cancel_sql(@_); }
3081 0 < ( SELECT COUNT(*) FROM cust_pkg
3082 WHERE cust_pkg.custnum = cust_main.custnum
3084 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3085 WHERE cust_pkg.custnum = cust_main.custnum
3086 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3090 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3092 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3093 records. Currently, only I<last> or I<company> may be specified (the
3094 appropriate ship_ field is also searched if applicable).
3096 Additional options are the same as FS::Record::qsearch
3101 my( $self, $fuzzy, $hash, @opt) = @_;
3106 check_and_rebuild_fuzzyfiles();
3107 foreach my $field ( keys %$fuzzy ) {
3108 my $sub = \&{"all_$field"};
3110 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3112 foreach ( keys %match ) {
3113 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3114 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3115 if defined dbdef->table('cust_main')->column('ship_last');
3120 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3132 =item smart_search OPTION => VALUE ...
3134 Accepts the following options: I<search>, the string to search for. The string
3135 will be searched for as a customer number, last name or company name, first
3136 searching for an exact match then fuzzy and substring matches.
3138 Any additional options treated as an additional qualifier on the search
3141 Returns a (possibly empty) array of FS::cust_main objects.
3147 my $search = delete $options{'search'};
3150 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3152 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3154 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3157 my $q_value = dbh->quote($value);
3160 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3161 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3162 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3163 if defined dbdef->table('cust_main')->column('ship_last');
3166 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3168 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3170 #still some false laziness w/ search/cust_main.cgi
3173 push @cust_main, qsearch( 'cust_main',
3174 { 'last' => { 'op' => 'ILIKE',
3175 'value' => "%$q_value%" },
3179 push @cust_main, qsearch( 'cust_main',
3180 { 'ship_last' => { 'op' => 'ILIKE',
3181 'value' => "%$q_value%" },
3186 if defined dbdef->table('cust_main')->column('ship_last');
3188 push @cust_main, qsearch( 'cust_main',
3189 { 'company' => { 'op' => 'ILIKE',
3190 'value' => "%$q_value%" },
3194 push @cust_main, qsearch( 'cust_main',
3195 { 'ship_company' => { 'op' => 'ILIKE',
3196 'value' => "%$q_value%" },
3200 if defined dbdef->table('cust_main')->column('ship_last');
3203 push @cust_main, FS::cust_main->fuzzy_search(
3204 { 'last' => $value },
3207 push @cust_main, FS::cust_main->fuzzy_search(
3208 { 'company' => $value },
3220 =item check_and_rebuild_fuzzyfiles
3224 sub check_and_rebuild_fuzzyfiles {
3225 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3226 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3227 or &rebuild_fuzzyfiles;
3230 =item rebuild_fuzzyfiles
3234 sub rebuild_fuzzyfiles {
3236 use Fcntl qw(:flock);
3238 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3242 open(LASTLOCK,">>$dir/cust_main.last")
3243 or die "can't open $dir/cust_main.last: $!";
3244 flock(LASTLOCK,LOCK_EX)
3245 or die "can't lock $dir/cust_main.last: $!";
3247 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3249 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3250 if defined dbdef->table('cust_main')->column('ship_last');
3252 open (LASTCACHE,">$dir/cust_main.last.tmp")
3253 or die "can't open $dir/cust_main.last.tmp: $!";
3254 print LASTCACHE join("\n", @all_last), "\n";
3255 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3257 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3262 open(COMPANYLOCK,">>$dir/cust_main.company")
3263 or die "can't open $dir/cust_main.company: $!";
3264 flock(COMPANYLOCK,LOCK_EX)
3265 or die "can't lock $dir/cust_main.company: $!";
3267 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3269 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3270 if defined dbdef->table('cust_main')->column('ship_last');
3272 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3273 or die "can't open $dir/cust_main.company.tmp: $!";
3274 print COMPANYCACHE join("\n", @all_company), "\n";
3275 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3277 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3287 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3288 open(LASTCACHE,"<$dir/cust_main.last")
3289 or die "can't open $dir/cust_main.last: $!";
3290 my @array = map { chomp; $_; } <LASTCACHE>;
3300 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3301 open(COMPANYCACHE,"<$dir/cust_main.company")
3302 or die "can't open $dir/cust_main.last: $!";
3303 my @array = map { chomp; $_; } <COMPANYCACHE>;
3308 =item append_fuzzyfiles LASTNAME COMPANY
3312 sub append_fuzzyfiles {
3313 my( $last, $company ) = @_;
3315 &check_and_rebuild_fuzzyfiles;
3317 use Fcntl qw(:flock);
3319 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3323 open(LAST,">>$dir/cust_main.last")
3324 or die "can't open $dir/cust_main.last: $!";
3326 or die "can't lock $dir/cust_main.last: $!";
3328 print LAST "$last\n";
3331 or die "can't unlock $dir/cust_main.last: $!";
3337 open(COMPANY,">>$dir/cust_main.company")
3338 or die "can't open $dir/cust_main.company: $!";
3339 flock(COMPANY,LOCK_EX)
3340 or die "can't lock $dir/cust_main.company: $!";
3342 print COMPANY "$company\n";
3344 flock(COMPANY,LOCK_UN)
3345 or die "can't unlock $dir/cust_main.company: $!";
3359 #warn join('-',keys %$param);
3360 my $fh = $param->{filehandle};
3361 my $agentnum = $param->{agentnum};
3362 my $refnum = $param->{refnum};
3363 my $pkgpart = $param->{pkgpart};
3364 my @fields = @{$param->{fields}};
3366 eval "use Date::Parse;";
3368 eval "use Text::CSV_XS;";
3371 my $csv = new Text::CSV_XS;
3378 local $SIG{HUP} = 'IGNORE';
3379 local $SIG{INT} = 'IGNORE';
3380 local $SIG{QUIT} = 'IGNORE';
3381 local $SIG{TERM} = 'IGNORE';
3382 local $SIG{TSTP} = 'IGNORE';
3383 local $SIG{PIPE} = 'IGNORE';
3385 my $oldAutoCommit = $FS::UID::AutoCommit;
3386 local $FS::UID::AutoCommit = 0;
3389 #while ( $columns = $csv->getline($fh) ) {
3391 while ( defined($line=<$fh>) ) {
3393 $csv->parse($line) or do {
3394 $dbh->rollback if $oldAutoCommit;
3395 return "can't parse: ". $csv->error_input();
3398 my @columns = $csv->fields();
3399 #warn join('-',@columns);
3402 agentnum => $agentnum,
3404 country => $conf->config('countrydefault') || 'US',
3405 payby => 'BILL', #default
3406 paydate => '12/2037', #default
3408 my $billtime = time;
3409 my %cust_pkg = ( pkgpart => $pkgpart );
3410 foreach my $field ( @fields ) {
3411 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3412 #$cust_pkg{$1} = str2time( shift @$columns );
3413 if ( $1 eq 'setup' ) {
3414 $billtime = str2time(shift @columns);
3416 $cust_pkg{$1} = str2time( shift @columns );
3419 #$cust_main{$field} = shift @$columns;
3420 $cust_main{$field} = shift @columns;
3424 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3425 my $cust_main = new FS::cust_main ( \%cust_main );
3427 tie my %hash, 'Tie::RefHash'; #this part is important
3428 $hash{$cust_pkg} = [] if $pkgpart;
3429 my $error = $cust_main->insert( \%hash );
3432 $dbh->rollback if $oldAutoCommit;
3433 return "can't insert customer for $line: $error";
3436 #false laziness w/bill.cgi
3437 $error = $cust_main->bill( 'time' => $billtime );
3439 $dbh->rollback if $oldAutoCommit;
3440 return "can't bill customer for $line: $error";
3443 $cust_main->apply_payments;
3444 $cust_main->apply_credits;
3446 $error = $cust_main->collect();
3448 $dbh->rollback if $oldAutoCommit;
3449 return "can't collect customer for $line: $error";
3455 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3457 return "Empty file!" unless $imported;
3469 #warn join('-',keys %$param);
3470 my $fh = $param->{filehandle};
3471 my @fields = @{$param->{fields}};
3473 eval "use Date::Parse;";
3475 eval "use Text::CSV_XS;";
3478 my $csv = new Text::CSV_XS;
3485 local $SIG{HUP} = 'IGNORE';
3486 local $SIG{INT} = 'IGNORE';
3487 local $SIG{QUIT} = 'IGNORE';
3488 local $SIG{TERM} = 'IGNORE';
3489 local $SIG{TSTP} = 'IGNORE';
3490 local $SIG{PIPE} = 'IGNORE';
3492 my $oldAutoCommit = $FS::UID::AutoCommit;
3493 local $FS::UID::AutoCommit = 0;
3496 #while ( $columns = $csv->getline($fh) ) {
3498 while ( defined($line=<$fh>) ) {
3500 $csv->parse($line) or do {
3501 $dbh->rollback if $oldAutoCommit;
3502 return "can't parse: ". $csv->error_input();
3505 my @columns = $csv->fields();
3506 #warn join('-',@columns);
3509 foreach my $field ( @fields ) {
3510 $row{$field} = shift @columns;
3513 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3514 unless ( $cust_main ) {
3515 $dbh->rollback if $oldAutoCommit;
3516 return "unknown custnum $row{'custnum'}";
3519 if ( $row{'amount'} > 0 ) {
3520 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3522 $dbh->rollback if $oldAutoCommit;
3526 } elsif ( $row{'amount'} < 0 ) {
3527 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3530 $dbh->rollback if $oldAutoCommit;
3540 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3542 return "Empty file!" unless $imported;
3554 The delete method should possibly take an FS::cust_main object reference
3555 instead of a scalar customer number.
3557 Bill and collect options should probably be passed as references instead of a
3560 There should probably be a configuration file with a list of allowed credit
3563 No multiple currency support (probably a larger project than just this module).
3565 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3569 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3570 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3571 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.