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} ) {
2659 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2660 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2663 my $cust_main_invoice = new FS::cust_main_invoice ( {
2664 'custnum' => $self->custnum,
2667 my $error = $self->custnum
2668 ? $cust_main_invoice->check
2669 : $cust_main_invoice->checkdest
2671 return $error if $error;
2676 =item set_default_invoicing_list
2678 Sets the invoicing list to all accounts associated with this customer,
2679 overwriting any previous invoicing list.
2683 sub set_default_invoicing_list {
2685 $self->invoicing_list($self->all_emails);
2690 Returns the email addresses of all accounts provisioned for this customer.
2697 foreach my $cust_pkg ( $self->all_pkgs ) {
2698 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2700 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2701 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2703 $list{$_}=1 foreach map { $_->email } @svc_acct;
2708 =item invoicing_list_addpost
2710 Adds postal invoicing to this customer. If this customer is already configured
2711 to receive postal invoices, does nothing.
2715 sub invoicing_list_addpost {
2717 return if grep { $_ eq 'POST' } $self->invoicing_list;
2718 my @invoicing_list = $self->invoicing_list;
2719 push @invoicing_list, 'POST';
2720 $self->invoicing_list(\@invoicing_list);
2723 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2725 Returns an array of customers referred by this customer (referral_custnum set
2726 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2727 customers referred by customers referred by this customer and so on, inclusive.
2728 The default behavior is DEPTH 1 (no recursion).
2732 sub referral_cust_main {
2734 my $depth = @_ ? shift : 1;
2735 my $exclude = @_ ? shift : {};
2738 map { $exclude->{$_->custnum}++; $_; }
2739 grep { ! $exclude->{ $_->custnum } }
2740 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2744 map { $_->referral_cust_main($depth-1, $exclude) }
2751 =item referral_cust_main_ncancelled
2753 Same as referral_cust_main, except only returns customers with uncancelled
2758 sub referral_cust_main_ncancelled {
2760 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2763 =item referral_cust_pkg [ DEPTH ]
2765 Like referral_cust_main, except returns a flat list of all unsuspended (and
2766 uncancelled) packages for each customer. The number of items in this list may
2767 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2771 sub referral_cust_pkg {
2773 my $depth = @_ ? shift : 1;
2775 map { $_->unsuspended_pkgs }
2776 grep { $_->unsuspended_pkgs }
2777 $self->referral_cust_main($depth);
2780 =item referring_cust_main
2782 Returns the single cust_main record for the customer who referred this customer
2783 (referral_custnum), or false.
2787 sub referring_cust_main {
2789 return '' unless $self->referral_custnum;
2790 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2793 =item credit AMOUNT, REASON
2795 Applies a credit to this customer. If there is an error, returns the error,
2796 otherwise returns false.
2801 my( $self, $amount, $reason ) = @_;
2802 my $cust_credit = new FS::cust_credit {
2803 'custnum' => $self->custnum,
2804 'amount' => $amount,
2805 'reason' => $reason,
2807 $cust_credit->insert;
2810 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2812 Creates a one-time charge for this customer. If there is an error, returns
2813 the error, otherwise returns false.
2818 my ( $self, $amount ) = ( shift, shift );
2819 my $pkg = @_ ? shift : 'One-time charge';
2820 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2821 my $taxclass = @_ ? shift : '';
2823 local $SIG{HUP} = 'IGNORE';
2824 local $SIG{INT} = 'IGNORE';
2825 local $SIG{QUIT} = 'IGNORE';
2826 local $SIG{TERM} = 'IGNORE';
2827 local $SIG{TSTP} = 'IGNORE';
2828 local $SIG{PIPE} = 'IGNORE';
2830 my $oldAutoCommit = $FS::UID::AutoCommit;
2831 local $FS::UID::AutoCommit = 0;
2834 my $part_pkg = new FS::part_pkg ( {
2836 'comment' => $comment,
2837 #'setup' => $amount,
2840 'plandata' => "setup_fee=$amount",
2843 'taxclass' => $taxclass,
2846 my $error = $part_pkg->insert;
2848 $dbh->rollback if $oldAutoCommit;
2852 my $pkgpart = $part_pkg->pkgpart;
2853 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2854 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2855 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2856 $error = $type_pkgs->insert;
2858 $dbh->rollback if $oldAutoCommit;
2863 my $cust_pkg = new FS::cust_pkg ( {
2864 'custnum' => $self->custnum,
2865 'pkgpart' => $pkgpart,
2868 $error = $cust_pkg->insert;
2870 $dbh->rollback if $oldAutoCommit;
2874 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2881 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2887 sort { $a->_date <=> $b->_date }
2888 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2891 =item open_cust_bill
2893 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2898 sub open_cust_bill {
2900 grep { $_->owed > 0 } $self->cust_bill;
2905 Returns all the credits (see L<FS::cust_credit>) for this customer.
2911 sort { $a->_date <=> $b->_date }
2912 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2917 Returns all the payments (see L<FS::cust_pay>) for this customer.
2923 sort { $a->_date <=> $b->_date }
2924 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2929 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2935 sort { $a->_date <=> $b->_date }
2936 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2942 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2948 sort { $a->_date <=> $b->_date }
2949 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2952 =item select_for_update
2954 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2959 sub select_for_update {
2961 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2966 Returns a name string for this customer, either "Company (Last, First)" or
2973 my $name = $self->get('last'). ', '. $self->first;
2974 $name = $self->company. " ($name)" if $self->company;
2980 Returns a status string for this customer, currently:
2984 =item prospect - No packages have ever been ordered
2986 =item active - One or more recurring packages is active
2988 =item suspended - All non-cancelled recurring packages are suspended
2990 =item cancelled - All recurring packages are cancelled
2998 for my $status (qw( prospect active suspended cancelled )) {
2999 my $method = $status.'_sql';
3000 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3001 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3002 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3003 return $status if $sth->fetchrow_arrayref->[0];
3009 Returns a hex triplet color string for this customer's status.
3014 'prospect' => '000000',
3015 'active' => '00CC00',
3016 'suspended' => 'FF9900',
3017 'cancelled' => 'FF0000',
3021 $statuscolor{$self->status};
3026 =head1 CLASS METHODS
3032 Returns an SQL expression identifying prospective cust_main records (customers
3033 with no packages ever ordered)
3037 sub prospect_sql { "
3038 0 = ( SELECT COUNT(*) FROM cust_pkg
3039 WHERE cust_pkg.custnum = cust_main.custnum
3045 Returns an SQL expression identifying active cust_main records.
3050 0 < ( SELECT COUNT(*) FROM cust_pkg
3051 WHERE cust_pkg.custnum = cust_main.custnum
3052 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3053 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3060 Returns an SQL expression identifying suspended cust_main records.
3064 sub suspended_sql { susp_sql(@_); }
3066 0 < ( SELECT COUNT(*) FROM cust_pkg
3067 WHERE cust_pkg.custnum = cust_main.custnum
3068 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3070 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3071 WHERE cust_pkg.custnum = cust_main.custnum
3072 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3073 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3080 Returns an SQL expression identifying cancelled cust_main records.
3084 sub cancelled_sql { cancel_sql(@_); }
3086 0 < ( SELECT COUNT(*) FROM cust_pkg
3087 WHERE cust_pkg.custnum = cust_main.custnum
3089 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3090 WHERE cust_pkg.custnum = cust_main.custnum
3091 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3095 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3097 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3098 records. Currently, only I<last> or I<company> may be specified (the
3099 appropriate ship_ field is also searched if applicable).
3101 Additional options are the same as FS::Record::qsearch
3106 my( $self, $fuzzy, $hash, @opt) = @_;
3111 check_and_rebuild_fuzzyfiles();
3112 foreach my $field ( keys %$fuzzy ) {
3113 my $sub = \&{"all_$field"};
3115 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3117 foreach ( keys %match ) {
3118 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3119 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3120 if defined dbdef->table('cust_main')->column('ship_last');
3125 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3137 =item smart_search OPTION => VALUE ...
3139 Accepts the following options: I<search>, the string to search for. The string
3140 will be searched for as a customer number, last name or company name, first
3141 searching for an exact match then fuzzy and substring matches.
3143 Any additional options treated as an additional qualifier on the search
3146 Returns a (possibly empty) array of FS::cust_main objects.
3152 my $search = delete $options{'search'};
3155 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3157 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3159 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3162 my $q_value = dbh->quote($value);
3165 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3166 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3167 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3168 if defined dbdef->table('cust_main')->column('ship_last');
3171 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3173 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3175 #still some false laziness w/ search/cust_main.cgi
3178 push @cust_main, qsearch( 'cust_main',
3179 { 'last' => { 'op' => 'ILIKE',
3180 'value' => "%$q_value%" },
3184 push @cust_main, qsearch( 'cust_main',
3185 { 'ship_last' => { 'op' => 'ILIKE',
3186 'value' => "%$q_value%" },
3191 if defined dbdef->table('cust_main')->column('ship_last');
3193 push @cust_main, qsearch( 'cust_main',
3194 { 'company' => { 'op' => 'ILIKE',
3195 'value' => "%$q_value%" },
3199 push @cust_main, qsearch( 'cust_main',
3200 { 'ship_company' => { 'op' => 'ILIKE',
3201 'value' => "%$q_value%" },
3205 if defined dbdef->table('cust_main')->column('ship_last');
3208 push @cust_main, FS::cust_main->fuzzy_search(
3209 { 'last' => $value },
3212 push @cust_main, FS::cust_main->fuzzy_search(
3213 { 'company' => $value },
3225 =item check_and_rebuild_fuzzyfiles
3229 sub check_and_rebuild_fuzzyfiles {
3230 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3231 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3232 or &rebuild_fuzzyfiles;
3235 =item rebuild_fuzzyfiles
3239 sub rebuild_fuzzyfiles {
3241 use Fcntl qw(:flock);
3243 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3247 open(LASTLOCK,">>$dir/cust_main.last")
3248 or die "can't open $dir/cust_main.last: $!";
3249 flock(LASTLOCK,LOCK_EX)
3250 or die "can't lock $dir/cust_main.last: $!";
3252 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3254 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3255 if defined dbdef->table('cust_main')->column('ship_last');
3257 open (LASTCACHE,">$dir/cust_main.last.tmp")
3258 or die "can't open $dir/cust_main.last.tmp: $!";
3259 print LASTCACHE join("\n", @all_last), "\n";
3260 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3262 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3267 open(COMPANYLOCK,">>$dir/cust_main.company")
3268 or die "can't open $dir/cust_main.company: $!";
3269 flock(COMPANYLOCK,LOCK_EX)
3270 or die "can't lock $dir/cust_main.company: $!";
3272 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3274 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3275 if defined dbdef->table('cust_main')->column('ship_last');
3277 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3278 or die "can't open $dir/cust_main.company.tmp: $!";
3279 print COMPANYCACHE join("\n", @all_company), "\n";
3280 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3282 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3292 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3293 open(LASTCACHE,"<$dir/cust_main.last")
3294 or die "can't open $dir/cust_main.last: $!";
3295 my @array = map { chomp; $_; } <LASTCACHE>;
3305 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3306 open(COMPANYCACHE,"<$dir/cust_main.company")
3307 or die "can't open $dir/cust_main.last: $!";
3308 my @array = map { chomp; $_; } <COMPANYCACHE>;
3313 =item append_fuzzyfiles LASTNAME COMPANY
3317 sub append_fuzzyfiles {
3318 my( $last, $company ) = @_;
3320 &check_and_rebuild_fuzzyfiles;
3322 use Fcntl qw(:flock);
3324 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3328 open(LAST,">>$dir/cust_main.last")
3329 or die "can't open $dir/cust_main.last: $!";
3331 or die "can't lock $dir/cust_main.last: $!";
3333 print LAST "$last\n";
3336 or die "can't unlock $dir/cust_main.last: $!";
3342 open(COMPANY,">>$dir/cust_main.company")
3343 or die "can't open $dir/cust_main.company: $!";
3344 flock(COMPANY,LOCK_EX)
3345 or die "can't lock $dir/cust_main.company: $!";
3347 print COMPANY "$company\n";
3349 flock(COMPANY,LOCK_UN)
3350 or die "can't unlock $dir/cust_main.company: $!";
3364 #warn join('-',keys %$param);
3365 my $fh = $param->{filehandle};
3366 my $agentnum = $param->{agentnum};
3367 my $refnum = $param->{refnum};
3368 my $pkgpart = $param->{pkgpart};
3369 my @fields = @{$param->{fields}};
3371 eval "use Date::Parse;";
3373 eval "use Text::CSV_XS;";
3376 my $csv = new Text::CSV_XS;
3383 local $SIG{HUP} = 'IGNORE';
3384 local $SIG{INT} = 'IGNORE';
3385 local $SIG{QUIT} = 'IGNORE';
3386 local $SIG{TERM} = 'IGNORE';
3387 local $SIG{TSTP} = 'IGNORE';
3388 local $SIG{PIPE} = 'IGNORE';
3390 my $oldAutoCommit = $FS::UID::AutoCommit;
3391 local $FS::UID::AutoCommit = 0;
3394 #while ( $columns = $csv->getline($fh) ) {
3396 while ( defined($line=<$fh>) ) {
3398 $csv->parse($line) or do {
3399 $dbh->rollback if $oldAutoCommit;
3400 return "can't parse: ". $csv->error_input();
3403 my @columns = $csv->fields();
3404 #warn join('-',@columns);
3407 agentnum => $agentnum,
3409 country => $conf->config('countrydefault') || 'US',
3410 payby => 'BILL', #default
3411 paydate => '12/2037', #default
3413 my $billtime = time;
3414 my %cust_pkg = ( pkgpart => $pkgpart );
3415 foreach my $field ( @fields ) {
3416 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3417 #$cust_pkg{$1} = str2time( shift @$columns );
3418 if ( $1 eq 'setup' ) {
3419 $billtime = str2time(shift @columns);
3421 $cust_pkg{$1} = str2time( shift @columns );
3424 #$cust_main{$field} = shift @$columns;
3425 $cust_main{$field} = shift @columns;
3429 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3430 my $cust_main = new FS::cust_main ( \%cust_main );
3432 tie my %hash, 'Tie::RefHash'; #this part is important
3433 $hash{$cust_pkg} = [] if $pkgpart;
3434 my $error = $cust_main->insert( \%hash );
3437 $dbh->rollback if $oldAutoCommit;
3438 return "can't insert customer for $line: $error";
3441 #false laziness w/bill.cgi
3442 $error = $cust_main->bill( 'time' => $billtime );
3444 $dbh->rollback if $oldAutoCommit;
3445 return "can't bill customer for $line: $error";
3448 $cust_main->apply_payments;
3449 $cust_main->apply_credits;
3451 $error = $cust_main->collect();
3453 $dbh->rollback if $oldAutoCommit;
3454 return "can't collect customer for $line: $error";
3460 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3462 return "Empty file!" unless $imported;
3474 #warn join('-',keys %$param);
3475 my $fh = $param->{filehandle};
3476 my @fields = @{$param->{fields}};
3478 eval "use Date::Parse;";
3480 eval "use Text::CSV_XS;";
3483 my $csv = new Text::CSV_XS;
3490 local $SIG{HUP} = 'IGNORE';
3491 local $SIG{INT} = 'IGNORE';
3492 local $SIG{QUIT} = 'IGNORE';
3493 local $SIG{TERM} = 'IGNORE';
3494 local $SIG{TSTP} = 'IGNORE';
3495 local $SIG{PIPE} = 'IGNORE';
3497 my $oldAutoCommit = $FS::UID::AutoCommit;
3498 local $FS::UID::AutoCommit = 0;
3501 #while ( $columns = $csv->getline($fh) ) {
3503 while ( defined($line=<$fh>) ) {
3505 $csv->parse($line) or do {
3506 $dbh->rollback if $oldAutoCommit;
3507 return "can't parse: ". $csv->error_input();
3510 my @columns = $csv->fields();
3511 #warn join('-',@columns);
3514 foreach my $field ( @fields ) {
3515 $row{$field} = shift @columns;
3518 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3519 unless ( $cust_main ) {
3520 $dbh->rollback if $oldAutoCommit;
3521 return "unknown custnum $row{'custnum'}";
3524 if ( $row{'amount'} > 0 ) {
3525 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3527 $dbh->rollback if $oldAutoCommit;
3531 } elsif ( $row{'amount'} < 0 ) {
3532 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3535 $dbh->rollback if $oldAutoCommit;
3545 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3547 return "Empty file!" unless $imported;
3559 The delete method should possibly take an FS::cust_main object reference
3560 instead of a scalar customer number.
3562 Bill and collect options should probably be passed as references instead of a
3565 There should probably be a configuration file with a list of allowed credit
3568 No multiple currency support (probably a larger project than just this module).
3570 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3574 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3575 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3576 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.