4 use vars qw( @ISA @EXPORT_OK $DEBUG $conf @encrypted_fields
5 $import $skip_fuzzyfiles );
6 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 eval "use Time::Local;";
12 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
13 if $] < 5.006 && !defined($Time::Local::VERSION);
14 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 eval "use Time::Local qw(timelocal_nocheck);";
19 use String::Approx qw(amatch);
20 use Business::CreditCard;
21 use FS::UID qw( getotaker dbh );
22 use FS::Record qw( qsearchs qsearch dbdef );
23 use FS::Misc qw( send_email );
27 use FS::cust_bill_pkg;
29 use FS::cust_pay_void;
32 use FS::part_referral;
33 use FS::cust_main_county;
35 use FS::cust_main_invoice;
36 use FS::cust_credit_bill;
37 use FS::cust_bill_pay;
38 use FS::prepay_credit;
41 use FS::part_bill_event;
42 use FS::cust_bill_event;
43 use FS::cust_tax_exempt;
45 use FS::Msgcat qw(gettext);
47 @ISA = qw( FS::Record );
49 @EXPORT_OK = qw( smart_search );
51 $realtime_bop_decline_quiet = 0;
59 @encrypted_fields = ('payinfo', 'paycvv');
61 #ask FS::UID to run this stuff for us later
62 #$FS::UID::callback{'FS::cust_main'} = sub {
63 install_callback FS::UID sub {
65 #yes, need it for stuff below (prolly should be cached)
70 my ( $hashref, $cache ) = @_;
71 if ( exists $hashref->{'pkgnum'} ) {
72 # #@{ $self->{'_pkgnum'} } = ();
73 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
74 $self->{'_pkgnum'} = $subcache;
75 #push @{ $self->{'_pkgnum'} },
76 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
82 FS::cust_main - Object methods for cust_main records
88 $record = new FS::cust_main \%hash;
89 $record = new FS::cust_main { 'column' => 'value' };
91 $error = $record->insert;
93 $error = $new_record->replace($old_record);
95 $error = $record->delete;
97 $error = $record->check;
99 @cust_pkg = $record->all_pkgs;
101 @cust_pkg = $record->ncancelled_pkgs;
103 @cust_pkg = $record->suspended_pkgs;
105 $error = $record->bill;
106 $error = $record->bill %options;
107 $error = $record->bill 'time' => $time;
109 $error = $record->collect;
110 $error = $record->collect %options;
111 $error = $record->collect 'invoice_time' => $time,
112 'batch_card' => 'yes',
113 'report_badcard' => 'yes',
118 An FS::cust_main object represents a customer. FS::cust_main inherits from
119 FS::Record. The following fields are currently supported:
123 =item custnum - primary key (assigned automatically for new customers)
125 =item agentnum - agent (see L<FS::agent>)
127 =item refnum - Advertising source (see L<FS::part_referral>)
133 =item ss - social security number (optional)
135 =item company - (optional)
139 =item address2 - (optional)
143 =item county - (optional, see L<FS::cust_main_county>)
145 =item state - (see L<FS::cust_main_county>)
149 =item country - (see L<FS::cust_main_county>)
151 =item daytime - phone (optional)
153 =item night - phone (optional)
155 =item fax - phone (optional)
157 =item ship_first - name
159 =item ship_last - name
161 =item ship_company - (optional)
165 =item ship_address2 - (optional)
169 =item ship_county - (optional, see L<FS::cust_main_county>)
171 =item ship_state - (see L<FS::cust_main_county>)
175 =item ship_country - (see L<FS::cust_main_county>)
177 =item ship_daytime - phone (optional)
179 =item ship_night - phone (optional)
181 =item ship_fax - phone (optional)
185 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>)
189 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
194 my($self,$payinfo) = @_;
195 if ( defined($payinfo) ) {
196 $self->paymask($payinfo);
197 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
199 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
207 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
211 =item paymask - Masked payment type
217 Mask all but the last four characters.
221 Mask all but last 2 of account number and bank routing number.
225 Do nothing, return the unmasked string.
234 # If it doesn't exist then generate it
235 my $paymask=$self->getfield('paymask');
236 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
237 $value = $self->payinfo;
240 if ( defined($value) && !$self->is_encrypted($value)) {
241 my $payinfo = $value;
242 my $payby = $self->payby;
243 if ($payby eq 'CARD' || $payby eq 'DCARD') { # Credit Cards (Show last four)
244 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
245 } elsif ($payby eq 'CHEK' ||
246 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
247 my( $account, $aba ) = split('@', $payinfo );
248 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
249 } else { # Tie up loose ends
252 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
253 } elsif (defined($value) && $self->is_encrypted($value)) {
262 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
264 =item payname - name on card or billing name
266 =item tax - tax exempt, empty or `Y'
268 =item otaker - order taker (assigned automatically, see L<FS::UID>)
270 =item comments - comments (optional)
272 =item referral_custnum - referring customer number
282 Creates a new customer. To add the customer to the database, see L<"insert">.
284 Note that this stores the hash reference, not a distinct copy of the hash it
285 points to. You can ask the object for a copy with the I<hash> method.
289 sub table { 'cust_main'; }
291 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
293 Adds this customer to the database. If there is an error, returns the error,
294 otherwise returns false.
296 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
297 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
298 are inserted atomicly, or the transaction is rolled back. Passing an empty
299 hash reference is equivalent to not supplying this parameter. There should be
300 a better explanation of this, but until then, here's an example:
303 tie %hash, 'Tie::RefHash'; #this part is important
305 $cust_pkg => [ $svc_acct ],
308 $cust_main->insert( \%hash );
310 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
311 be set as the invoicing list (see L<"invoicing_list">). Errors return as
312 expected and rollback the entire transaction; it is not necessary to call
313 check_invoicing_list first. The invoicing_list is set after the records in the
314 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
315 invoicing_list destination to the newly-created svc_acct. Here's an example:
317 $cust_main->insert( {}, [ $email, 'POST' ] );
319 Currently available options are: I<depend_jobnum> and I<noexport>.
321 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
322 on the supplied jobnum (they will not run until the specific job completes).
323 This can be used to defer provisioning until some action completes (such
324 as running the customer's credit card sucessfully).
326 The I<noexport> option is deprecated. If I<noexport> is set true, no
327 provisioning jobs (exports) are scheduled. (You can schedule them later with
328 the B<reexport> method.)
334 my $cust_pkgs = @_ ? shift : {};
335 my $invoicing_list = @_ ? shift : '';
337 warn "FS::cust_main::insert called with options ".
338 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
341 local $SIG{HUP} = 'IGNORE';
342 local $SIG{INT} = 'IGNORE';
343 local $SIG{QUIT} = 'IGNORE';
344 local $SIG{TERM} = 'IGNORE';
345 local $SIG{TSTP} = 'IGNORE';
346 local $SIG{PIPE} = 'IGNORE';
348 my $oldAutoCommit = $FS::UID::AutoCommit;
349 local $FS::UID::AutoCommit = 0;
352 my $prepay_credit = '';
354 if ( $self->payby eq 'PREPAY' ) {
355 $self->payby('BILL');
356 $prepay_credit = qsearchs(
358 { 'identifier' => $self->payinfo },
362 unless ( $prepay_credit ) {
363 $dbh->rollback if $oldAutoCommit;
364 return "Invalid prepaid card: ". $self->payinfo;
366 $seconds = $prepay_credit->seconds;
367 if ( $prepay_credit->agentnum ) {
368 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
369 $dbh->rollback if $oldAutoCommit;
370 return "prepaid card not valid for agent ". $self->agentnum;
372 $self->agentnum($prepay_credit->agentnum);
374 my $error = $prepay_credit->delete;
376 $dbh->rollback if $oldAutoCommit;
377 return "removing prepay_credit (transaction rolled back): $error";
381 my $error = $self->SUPER::insert;
383 $dbh->rollback if $oldAutoCommit;
384 #return "inserting cust_main record (transaction rolled back): $error";
389 if ( $invoicing_list ) {
390 $error = $self->check_invoicing_list( $invoicing_list );
392 $dbh->rollback if $oldAutoCommit;
393 return "checking invoicing_list (transaction rolled back): $error";
395 $self->invoicing_list( $invoicing_list );
399 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
401 $dbh->rollback if $oldAutoCommit;
406 $dbh->rollback if $oldAutoCommit;
407 return "No svc_acct record to apply pre-paid time";
410 if ( $prepay_credit && $prepay_credit->amount ) {
411 my $cust_pay = new FS::cust_pay {
412 'custnum' => $self->custnum,
413 'paid' => $prepay_credit->amount,
414 #'_date' => #date the prepaid card was purchased???
416 'payinfo' => $prepay_credit->identifier,
418 $error = $cust_pay->insert;
420 $dbh->rollback if $oldAutoCommit;
421 return "inserting prepayment (transaction rolled back): $error";
425 unless ( $import || $skip_fuzzyfiles ) {
426 $error = $self->queue_fuzzyfiles_update;
428 $dbh->rollback if $oldAutoCommit;
429 return "updating fuzzy search cache: $error";
433 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
438 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
440 Like the insert method on an existing record, this method orders a package
441 and included services atomicaly. Pass a Tie::RefHash data structure to this
442 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
443 be a better explanation of this, but until then, here's an example:
446 tie %hash, 'Tie::RefHash'; #this part is important
448 $cust_pkg => [ $svc_acct ],
451 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
453 Services can be new, in which case they are inserted, or existing unaudited
454 services, in which case they are linked to the newly-created package.
456 Currently available options are: I<depend_jobnum> and I<noexport>.
458 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
459 on the supplied jobnum (they will not run until the specific job completes).
460 This can be used to defer provisioning until some action completes (such
461 as running the customer's credit card sucessfully).
463 The I<noexport> option is deprecated. If I<noexport> is set true, no
464 provisioning jobs (exports) are scheduled. (You can schedule them later with
465 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
466 on the cust_main object is not recommended, as existing services will also be
473 my $cust_pkgs = shift;
476 my %svc_options = ();
477 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
478 if exists $options{'depend_jobnum'};
479 warn "FS::cust_main::order_pkgs called with options ".
480 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
483 local $SIG{HUP} = 'IGNORE';
484 local $SIG{INT} = 'IGNORE';
485 local $SIG{QUIT} = 'IGNORE';
486 local $SIG{TERM} = 'IGNORE';
487 local $SIG{TSTP} = 'IGNORE';
488 local $SIG{PIPE} = 'IGNORE';
490 my $oldAutoCommit = $FS::UID::AutoCommit;
491 local $FS::UID::AutoCommit = 0;
494 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
496 foreach my $cust_pkg ( keys %$cust_pkgs ) {
497 $cust_pkg->custnum( $self->custnum );
498 my $error = $cust_pkg->insert;
500 $dbh->rollback if $oldAutoCommit;
501 return "inserting cust_pkg (transaction rolled back): $error";
503 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
504 if ( $svc_something->svcnum ) {
505 my $old_cust_svc = $svc_something->cust_svc;
506 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
507 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
508 $error = $new_cust_svc->replace($old_cust_svc);
510 $svc_something->pkgnum( $cust_pkg->pkgnum );
511 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
512 $svc_something->seconds( $svc_something->seconds + $$seconds );
515 $error = $svc_something->insert(%svc_options);
518 $dbh->rollback if $oldAutoCommit;
519 #return "inserting svc_ (transaction rolled back): $error";
525 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
531 This method is deprecated. See the I<depend_jobnum> option to the insert and
532 order_pkgs methods for a better way to defer provisioning.
534 Re-schedules all exports by calling the B<reexport> method of all associated
535 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
536 otherwise returns false.
543 carp "warning: FS::cust_main::reexport is deprectated; ".
544 "use the depend_jobnum option to insert or order_pkgs to delay export";
546 local $SIG{HUP} = 'IGNORE';
547 local $SIG{INT} = 'IGNORE';
548 local $SIG{QUIT} = 'IGNORE';
549 local $SIG{TERM} = 'IGNORE';
550 local $SIG{TSTP} = 'IGNORE';
551 local $SIG{PIPE} = 'IGNORE';
553 my $oldAutoCommit = $FS::UID::AutoCommit;
554 local $FS::UID::AutoCommit = 0;
557 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
558 my $error = $cust_pkg->reexport;
560 $dbh->rollback if $oldAutoCommit;
565 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
570 =item delete NEW_CUSTNUM
572 This deletes the customer. If there is an error, returns the error, otherwise
575 This will completely remove all traces of the customer record. This is not
576 what you want when a customer cancels service; for that, cancel all of the
577 customer's packages (see L</cancel>).
579 If the customer has any uncancelled packages, you need to pass a new (valid)
580 customer number for those packages to be transferred to. Cancelled packages
581 will be deleted. Did I mention that this is NOT what you want when a customer
582 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
584 You can't delete a customer with invoices (see L<FS::cust_bill>),
585 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
586 refunds (see L<FS::cust_refund>).
593 local $SIG{HUP} = 'IGNORE';
594 local $SIG{INT} = 'IGNORE';
595 local $SIG{QUIT} = 'IGNORE';
596 local $SIG{TERM} = 'IGNORE';
597 local $SIG{TSTP} = 'IGNORE';
598 local $SIG{PIPE} = 'IGNORE';
600 my $oldAutoCommit = $FS::UID::AutoCommit;
601 local $FS::UID::AutoCommit = 0;
604 if ( $self->cust_bill ) {
605 $dbh->rollback if $oldAutoCommit;
606 return "Can't delete a customer with invoices";
608 if ( $self->cust_credit ) {
609 $dbh->rollback if $oldAutoCommit;
610 return "Can't delete a customer with credits";
612 if ( $self->cust_pay ) {
613 $dbh->rollback if $oldAutoCommit;
614 return "Can't delete a customer with payments";
616 if ( $self->cust_refund ) {
617 $dbh->rollback if $oldAutoCommit;
618 return "Can't delete a customer with refunds";
621 my @cust_pkg = $self->ncancelled_pkgs;
623 my $new_custnum = shift;
624 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
625 $dbh->rollback if $oldAutoCommit;
626 return "Invalid new customer number: $new_custnum";
628 foreach my $cust_pkg ( @cust_pkg ) {
629 my %hash = $cust_pkg->hash;
630 $hash{'custnum'} = $new_custnum;
631 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
632 my $error = $new_cust_pkg->replace($cust_pkg);
634 $dbh->rollback if $oldAutoCommit;
639 my @cancelled_cust_pkg = $self->all_pkgs;
640 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
641 my $error = $cust_pkg->delete;
643 $dbh->rollback if $oldAutoCommit;
648 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
649 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
651 my $error = $cust_main_invoice->delete;
653 $dbh->rollback if $oldAutoCommit;
658 my $error = $self->SUPER::delete;
660 $dbh->rollback if $oldAutoCommit;
664 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
669 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
671 Replaces the OLD_RECORD with this one in the database. If there is an error,
672 returns the error, otherwise returns false.
674 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
675 be set as the invoicing list (see L<"invoicing_list">). Errors return as
676 expected and rollback the entire transaction; it is not necessary to call
677 check_invoicing_list first. Here's an example:
679 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
688 local $SIG{HUP} = 'IGNORE';
689 local $SIG{INT} = 'IGNORE';
690 local $SIG{QUIT} = 'IGNORE';
691 local $SIG{TERM} = 'IGNORE';
692 local $SIG{TSTP} = 'IGNORE';
693 local $SIG{PIPE} = 'IGNORE';
695 # If the mask is blank then try to set it - if we can...
696 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
697 $self->paymask($self->payinfo);
700 # We absolutely have to have an old vs. new record to make this work.
701 if (!defined($old)) {
702 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
705 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
706 && $conf->config('users-allow_comp') ) {
707 return "You are not permitted to create complimentary accounts."
708 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
711 my $oldAutoCommit = $FS::UID::AutoCommit;
712 local $FS::UID::AutoCommit = 0;
715 my $error = $self->SUPER::replace($old);
718 $dbh->rollback if $oldAutoCommit;
722 if ( @param ) { # INVOICING_LIST_ARYREF
723 my $invoicing_list = shift @param;
724 $error = $self->check_invoicing_list( $invoicing_list );
726 $dbh->rollback if $oldAutoCommit;
729 $self->invoicing_list( $invoicing_list );
732 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
733 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
734 # card/check/lec info has changed, want to retry realtime_ invoice events
735 my $error = $self->retry_realtime;
737 $dbh->rollback if $oldAutoCommit;
742 unless ( $import || $skip_fuzzyfiles ) {
743 $error = $self->queue_fuzzyfiles_update;
745 $dbh->rollback if $oldAutoCommit;
746 return "updating fuzzy search cache: $error";
750 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
755 =item queue_fuzzyfiles_update
757 Used by insert & replace to update the fuzzy search cache
761 sub queue_fuzzyfiles_update {
764 local $SIG{HUP} = 'IGNORE';
765 local $SIG{INT} = 'IGNORE';
766 local $SIG{QUIT} = 'IGNORE';
767 local $SIG{TERM} = 'IGNORE';
768 local $SIG{TSTP} = 'IGNORE';
769 local $SIG{PIPE} = 'IGNORE';
771 my $oldAutoCommit = $FS::UID::AutoCommit;
772 local $FS::UID::AutoCommit = 0;
775 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
776 my $error = $queue->insert($self->getfield('last'), $self->company);
778 $dbh->rollback if $oldAutoCommit;
779 return "queueing job (transaction rolled back): $error";
782 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
783 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
784 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
786 $dbh->rollback if $oldAutoCommit;
787 return "queueing job (transaction rolled back): $error";
791 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
798 Checks all fields to make sure this is a valid customer record. If there is
799 an error, returns the error, otherwise returns false. Called by the insert
807 #warn "BEFORE: \n". $self->_dump;
810 $self->ut_numbern('custnum')
811 || $self->ut_number('agentnum')
812 || $self->ut_number('refnum')
813 || $self->ut_name('last')
814 || $self->ut_name('first')
815 || $self->ut_textn('company')
816 || $self->ut_text('address1')
817 || $self->ut_textn('address2')
818 || $self->ut_text('city')
819 || $self->ut_textn('county')
820 || $self->ut_textn('state')
821 || $self->ut_country('country')
822 || $self->ut_anything('comments')
823 || $self->ut_numbern('referral_custnum')
825 #barf. need message catalogs. i18n. etc.
826 $error .= "Please select an advertising source."
827 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
828 return $error if $error;
830 return "Unknown agent"
831 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
833 return "Unknown refnum"
834 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
836 return "Unknown referring custnum ". $self->referral_custnum
837 unless ! $self->referral_custnum
838 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
840 if ( $self->ss eq '' ) {
845 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
846 or return "Illegal social security number: ". $self->ss;
847 $self->ss("$1-$2-$3");
851 # bad idea to disable, causes billing to fail because of no tax rates later
852 # unless ( $import ) {
853 unless ( qsearch('cust_main_county', {
854 'country' => $self->country,
857 return "Unknown state/county/country: ".
858 $self->state. "/". $self->county. "/". $self->country
859 unless qsearch('cust_main_county',{
860 'state' => $self->state,
861 'county' => $self->county,
862 'country' => $self->country,
868 $self->ut_phonen('daytime', $self->country)
869 || $self->ut_phonen('night', $self->country)
870 || $self->ut_phonen('fax', $self->country)
871 || $self->ut_zip('zip', $self->country)
873 return $error if $error;
876 last first company address1 address2 city county state zip
877 country daytime night fax
880 if ( defined $self->dbdef_table->column('ship_last') ) {
881 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
883 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
887 $self->ut_name('ship_last')
888 || $self->ut_name('ship_first')
889 || $self->ut_textn('ship_company')
890 || $self->ut_text('ship_address1')
891 || $self->ut_textn('ship_address2')
892 || $self->ut_text('ship_city')
893 || $self->ut_textn('ship_county')
894 || $self->ut_textn('ship_state')
895 || $self->ut_country('ship_country')
897 return $error if $error;
899 #false laziness with above
900 unless ( qsearchs('cust_main_county', {
901 'country' => $self->ship_country,
904 return "Unknown ship_state/ship_county/ship_country: ".
905 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
906 unless qsearchs('cust_main_county',{
907 'state' => $self->ship_state,
908 'county' => $self->ship_county,
909 'country' => $self->ship_country,
915 $self->ut_phonen('ship_daytime', $self->ship_country)
916 || $self->ut_phonen('ship_night', $self->ship_country)
917 || $self->ut_phonen('ship_fax', $self->ship_country)
918 || $self->ut_zip('ship_zip', $self->ship_country)
920 return $error if $error;
922 } else { # ship_ info eq billing info, so don't store dup info in database
923 $self->setfield("ship_$_", '')
924 foreach qw( last first company address1 address2 city county state zip
925 country daytime night fax );
929 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
930 or return "Illegal payby: ". $self->payby;
932 # If it is encrypted and the private key is not availaible then we can't
933 # check the credit card.
935 my $check_payinfo = 1;
937 if ($self->is_encrypted($self->payinfo)) {
943 if ( $check_payinfo && ($self->payby eq 'CARD' || $self->payby eq 'DCRD')) {
945 my $payinfo = $self->payinfo;
947 $payinfo =~ /^(\d{13,16})$/
948 or return gettext('invalid_card'); # . ": ". $self->payinfo;
950 $self->payinfo($payinfo);
952 or return gettext('invalid_card'); # . ": ". $self->payinfo;
953 return gettext('unknown_card_type')
954 if cardtype($self->payinfo) eq "Unknown";
955 if ( defined $self->dbdef_table->column('paycvv') ) {
956 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
957 if ( cardtype($self->payinfo) eq 'American Express card' ) {
958 $self->paycvv =~ /^(\d{4})$/
959 or return "CVV2 (CID) for American Express cards is four digits.";
962 $self->paycvv =~ /^(\d{3})$/
963 or return "CVV2 (CVC2/CID) is three digits.";
971 } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) {
973 my $payinfo = $self->payinfo;
974 $payinfo =~ s/[^\d\@]//g;
975 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
977 $self->payinfo($payinfo);
978 $self->paycvv('') if $self->dbdef_table->column('paycvv');
980 } elsif ( $self->payby eq 'LECB' ) {
982 my $payinfo = $self->payinfo;
984 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
986 $self->payinfo($payinfo);
987 $self->paycvv('') if $self->dbdef_table->column('paycvv');
989 } elsif ( $self->payby eq 'BILL' ) {
991 $error = $self->ut_textn('payinfo');
992 return "Illegal P.O. number: ". $self->payinfo if $error;
993 $self->paycvv('') if $self->dbdef_table->column('paycvv');
995 } elsif ( $self->payby eq 'COMP' ) {
997 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
998 return "You are not permitted to create complimentary accounts."
999 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1002 $error = $self->ut_textn('payinfo');
1003 return "Illegal comp account issuer: ". $self->payinfo if $error;
1004 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1006 } elsif ( $self->payby eq 'PREPAY' ) {
1008 my $payinfo = $self->payinfo;
1009 $payinfo =~ s/\W//g; #anything else would just confuse things
1010 $self->payinfo($payinfo);
1011 $error = $self->ut_alpha('payinfo');
1012 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1013 return "Unknown prepayment identifier"
1014 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1015 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1019 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1020 return "Expriation date required"
1021 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
1025 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1026 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1027 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1028 ( $m, $y ) = ( $3, "20$2" );
1030 return "Illegal expiration date: ". $self->paydate;
1032 $self->paydate("$y-$m-01");
1033 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1034 return gettext('expired_card')
1035 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1038 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1039 ( ! $conf->exists('require_cardname')
1040 || $self->payby !~ /^(CARD|DCRD)$/ )
1042 $self->payname( $self->first. " ". $self->getfield('last') );
1044 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1045 or return gettext('illegal_name'). " payname: ". $self->payname;
1049 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1052 $self->otaker(getotaker) unless $self->otaker;
1054 #warn "AFTER: \n". $self->_dump;
1056 $self->SUPER::check;
1061 Returns all packages (see L<FS::cust_pkg>) for this customer.
1067 if ( $self->{'_pkgnum'} ) {
1068 values %{ $self->{'_pkgnum'}->cache };
1070 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1074 =item ncancelled_pkgs
1076 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1080 sub ncancelled_pkgs {
1082 if ( $self->{'_pkgnum'} ) {
1083 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1085 @{ [ # force list context
1086 qsearch( 'cust_pkg', {
1087 'custnum' => $self->custnum,
1090 qsearch( 'cust_pkg', {
1091 'custnum' => $self->custnum,
1098 =item suspended_pkgs
1100 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1104 sub suspended_pkgs {
1106 grep { $_->susp } $self->ncancelled_pkgs;
1109 =item unflagged_suspended_pkgs
1111 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1112 customer (thouse packages without the `manual_flag' set).
1116 sub unflagged_suspended_pkgs {
1118 return $self->suspended_pkgs
1119 unless dbdef->table('cust_pkg')->column('manual_flag');
1120 grep { ! $_->manual_flag } $self->suspended_pkgs;
1123 =item unsuspended_pkgs
1125 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1130 sub unsuspended_pkgs {
1132 grep { ! $_->susp } $self->ncancelled_pkgs;
1135 =item num_cancelled_pkgs
1137 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1142 sub num_cancelled_pkgs {
1144 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1148 my( $self, $sql ) = @_;
1149 my $sth = dbh->prepare(
1150 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1151 ) or die dbh->errstr;
1152 $sth->execute($self->custnum) or die $sth->errstr;
1153 $sth->fetchrow_arrayref->[0];
1158 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1159 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1160 on success or a list of errors.
1166 grep { $_->unsuspend } $self->suspended_pkgs;
1171 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1172 Always returns a list: an empty list on success or a list of errors.
1178 grep { $_->suspend } $self->unsuspended_pkgs;
1181 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1183 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1184 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1185 success or a list of errors.
1189 sub suspend_if_pkgpart {
1192 grep { $_->suspend }
1193 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1194 $self->unsuspended_pkgs;
1197 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1199 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1200 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1201 on success or a list of errors.
1205 sub suspend_unless_pkgpart {
1208 grep { $_->suspend }
1209 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1210 $self->unsuspended_pkgs;
1213 =item cancel [ OPTION => VALUE ... ]
1215 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1217 Available options are: I<quiet>
1219 I<quiet> can be set true to supress email cancellation notices.
1221 Always returns a list: an empty list on success or a list of errors.
1227 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1232 Returns the agent (see L<FS::agent>) for this customer.
1238 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1243 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1244 conjunction with the collect method.
1246 Options are passed as name-value pairs.
1248 Currently available options are:
1250 resetup - if set true, re-charges setup fees.
1252 time - bills the customer as if it were that time. Specified as a UNIX
1253 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1254 L<Date::Parse> for conversion functions. For example:
1258 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1261 If there is an error, returns the error, otherwise returns false.
1266 my( $self, %options ) = @_;
1267 return '' if $self->payby eq 'COMP';
1268 warn "bill customer ". $self->custnum if $DEBUG;
1270 my $time = $options{'time'} || time;
1275 local $SIG{HUP} = 'IGNORE';
1276 local $SIG{INT} = 'IGNORE';
1277 local $SIG{QUIT} = 'IGNORE';
1278 local $SIG{TERM} = 'IGNORE';
1279 local $SIG{TSTP} = 'IGNORE';
1280 local $SIG{PIPE} = 'IGNORE';
1282 my $oldAutoCommit = $FS::UID::AutoCommit;
1283 local $FS::UID::AutoCommit = 0;
1286 $self->select_for_update; #mutex
1288 # find the packages which are due for billing, find out how much they are
1289 # & generate invoice database.
1291 my( $total_setup, $total_recur ) = ( 0, 0 );
1292 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1293 my @cust_bill_pkg = ();
1295 #my $taxable_charged = 0;##
1300 foreach my $cust_pkg (
1301 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1304 #NO!! next if $cust_pkg->cancel;
1305 next if $cust_pkg->getfield('cancel');
1307 warn " bill package ". $cust_pkg->pkgnum if $DEBUG;
1309 #? to avoid use of uninitialized value errors... ?
1310 $cust_pkg->setfield('bill', '')
1311 unless defined($cust_pkg->bill);
1313 my $part_pkg = $cust_pkg->part_pkg;
1315 my %hash = $cust_pkg->hash;
1316 my $old_cust_pkg = new FS::cust_pkg \%hash;
1322 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1324 warn " bill setup" if $DEBUG;
1326 $setup = eval { $cust_pkg->calc_setup( $time ) };
1328 $dbh->rollback if $oldAutoCommit;
1332 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1338 if ( $part_pkg->getfield('freq') ne '0' &&
1339 ! $cust_pkg->getfield('susp') &&
1340 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1343 warn " bill recur" if $DEBUG;
1345 # XXX shared with $recur_prog
1346 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1348 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1350 $dbh->rollback if $oldAutoCommit;
1354 #change this bit to use Date::Manip? CAREFUL with timezones (see
1355 # mailing list archive)
1356 my ($sec,$min,$hour,$mday,$mon,$year) =
1357 (localtime($sdate) )[0,1,2,3,4,5];
1359 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1360 # only for figuring next bill date, nothing else, so, reset $sdate again
1362 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1363 $cust_pkg->last_bill($sdate)
1364 if $cust_pkg->dbdef_table->column('last_bill');
1366 if ( $part_pkg->freq =~ /^\d+$/ ) {
1367 $mon += $part_pkg->freq;
1368 until ( $mon < 12 ) { $mon -= 12; $year++; }
1369 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1371 $mday += $weeks * 7;
1372 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1376 $dbh->rollback if $oldAutoCommit;
1377 return "unparsable frequency: ". $part_pkg->freq;
1379 $cust_pkg->setfield('bill',
1380 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1383 warn "\$setup is undefined" unless defined($setup);
1384 warn "\$recur is undefined" unless defined($recur);
1385 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1387 if ( $cust_pkg->modified ) {
1389 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1391 $error=$cust_pkg->replace($old_cust_pkg);
1392 if ( $error ) { #just in case
1393 $dbh->rollback if $oldAutoCommit;
1394 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1397 $setup = sprintf( "%.2f", $setup );
1398 $recur = sprintf( "%.2f", $recur );
1399 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1400 $dbh->rollback if $oldAutoCommit;
1401 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1403 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1404 $dbh->rollback if $oldAutoCommit;
1405 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1407 if ( $setup != 0 || $recur != 0 ) {
1408 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1410 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1411 'pkgnum' => $cust_pkg->pkgnum,
1415 'edate' => $cust_pkg->bill,
1416 'details' => \@details,
1418 push @cust_bill_pkg, $cust_bill_pkg;
1419 $total_setup += $setup;
1420 $total_recur += $recur;
1422 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1424 my @taxes = qsearch( 'cust_main_county', {
1425 'state' => $self->state,
1426 'county' => $self->county,
1427 'country' => $self->country,
1428 'taxclass' => $part_pkg->taxclass,
1431 @taxes = qsearch( 'cust_main_county', {
1432 'state' => $self->state,
1433 'county' => $self->county,
1434 'country' => $self->country,
1439 #one more try at a whole-country tax rate
1441 @taxes = qsearch( 'cust_main_county', {
1444 'country' => $self->country,
1449 # maybe eliminate this entirely, along with all the 0% records
1451 $dbh->rollback if $oldAutoCommit;
1453 "fatal: can't find tax rate for state/county/country/taxclass ".
1454 join('/', ( map $self->$_(), qw(state county country) ),
1455 $part_pkg->taxclass ). "\n";
1458 foreach my $tax ( @taxes ) {
1460 my $taxable_charged = 0;
1461 $taxable_charged += $setup
1462 unless $part_pkg->setuptax =~ /^Y$/i
1463 || $tax->setuptax =~ /^Y$/i;
1464 $taxable_charged += $recur
1465 unless $part_pkg->recurtax =~ /^Y$/i
1466 || $tax->recurtax =~ /^Y$/i;
1467 next unless $taxable_charged;
1469 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1470 my ($mon,$year) = (localtime($sdate) )[4,5];
1472 my $freq = $part_pkg->freq || 1;
1473 if ( $freq !~ /(\d+)$/ ) {
1474 $dbh->rollback if $oldAutoCommit;
1475 return "daily/weekly package definitions not (yet?)".
1476 " compatible with monthly tax exemptions";
1478 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1479 foreach my $which_month ( 1 .. $freq ) {
1481 'custnum' => $self->custnum,
1482 'taxnum' => $tax->taxnum,
1483 'year' => 1900+$year,
1486 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1487 until ( $mon < 13 ) { $mon -= 12; $year++; }
1488 my $cust_tax_exempt =
1489 qsearchs('cust_tax_exempt', \%hash)
1490 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1491 my $remaining_exemption = sprintf("%.2f",
1492 $tax->exempt_amount - $cust_tax_exempt->amount );
1493 if ( $remaining_exemption > 0 ) {
1494 my $addl = $remaining_exemption > $taxable_per_month
1495 ? $taxable_per_month
1496 : $remaining_exemption;
1497 $taxable_charged -= $addl;
1498 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1499 $cust_tax_exempt->hash,
1501 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1503 $error = $new_cust_tax_exempt->exemptnum
1504 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1505 : $new_cust_tax_exempt->insert;
1507 $dbh->rollback if $oldAutoCommit;
1508 return "fatal: can't update cust_tax_exempt: $error";
1511 } # if $remaining_exemption > 0
1513 } #foreach $which_month
1515 } #if $tax->exempt_amount
1517 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1519 #$tax += $taxable_charged * $cust_main_county->tax / 100
1520 $tax{ $tax->taxname || 'Tax' } +=
1521 $taxable_charged * $tax->tax / 100
1523 } #foreach my $tax ( @taxes )
1525 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1527 } #if $setup != 0 || $recur != 0
1529 } #if $cust_pkg->modified
1531 } #foreach my $cust_pkg
1533 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1534 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1536 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1537 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1541 # unless ( $self->tax =~ /Y/i
1542 # || $self->payby eq 'COMP'
1543 # || $taxable_charged == 0 ) {
1544 # my $cust_main_county = qsearchs('cust_main_county',{
1545 # 'state' => $self->state,
1546 # 'county' => $self->county,
1547 # 'country' => $self->country,
1548 # } ) or die "fatal: can't find tax rate for state/county/country ".
1549 # $self->state. "/". $self->county. "/". $self->country. "\n";
1550 # my $tax = sprintf( "%.2f",
1551 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1554 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1556 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1557 my $tax = sprintf("%.2f", $tax{$taxname} );
1558 $charged = sprintf( "%.2f", $charged+$tax );
1560 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1566 'itemdesc' => $taxname,
1568 push @cust_bill_pkg, $cust_bill_pkg;
1571 } else { #1.4 schema
1574 foreach ( values %tax ) { $tax += $_ };
1575 $tax = sprintf("%.2f", $tax);
1577 $charged = sprintf( "%.2f", $charged+$tax );
1579 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1586 push @cust_bill_pkg, $cust_bill_pkg;
1591 my $cust_bill = new FS::cust_bill ( {
1592 'custnum' => $self->custnum,
1594 'charged' => $charged,
1596 $error = $cust_bill->insert;
1598 $dbh->rollback if $oldAutoCommit;
1599 return "can't create invoice for customer #". $self->custnum. ": $error";
1602 my $invnum = $cust_bill->invnum;
1604 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1606 $cust_bill_pkg->invnum($invnum);
1607 $error = $cust_bill_pkg->insert;
1609 $dbh->rollback if $oldAutoCommit;
1610 return "can't create invoice line item for customer #". $self->custnum.
1615 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1619 =item collect OPTIONS
1621 (Attempt to) collect money for this customer's outstanding invoices (see
1622 L<FS::cust_bill>). Usually used after the bill method.
1624 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1625 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1626 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1628 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1629 and the invoice events web interface.
1631 If there is an error, returns the error, otherwise returns false.
1633 Options are passed as name-value pairs.
1635 Currently available options are:
1637 invoice_time - Use this time when deciding when to print invoices and
1638 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>
1639 for conversion functions.
1641 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1644 retry_card - Deprecated alias for 'retry'
1646 batch_card - This option is deprecated. See the invoice events web interface
1647 to control whether cards are batched or run against a realtime gateway.
1649 report_badcard - This option is deprecated.
1651 force_print - This option is deprecated; see the invoice events web interface.
1653 quiet - set true to surpress email card/ACH decline notices.
1658 my( $self, %options ) = @_;
1659 my $invoice_time = $options{'invoice_time'} || time;
1662 local $SIG{HUP} = 'IGNORE';
1663 local $SIG{INT} = 'IGNORE';
1664 local $SIG{QUIT} = 'IGNORE';
1665 local $SIG{TERM} = 'IGNORE';
1666 local $SIG{TSTP} = 'IGNORE';
1667 local $SIG{PIPE} = 'IGNORE';
1669 my $oldAutoCommit = $FS::UID::AutoCommit;
1670 local $FS::UID::AutoCommit = 0;
1673 $self->select_for_update; #mutex
1675 my $balance = $self->balance;
1676 warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1677 unless ( $balance > 0 ) { #redundant?????
1678 $dbh->rollback if $oldAutoCommit; #hmm
1682 if ( exists($options{'retry_card'}) ) {
1683 carp 'retry_card option passed to collect is deprecated; use retry';
1684 $options{'retry'} ||= $options{'retry_card'};
1686 if ( exists($options{'retry'}) && $options{'retry'} ) {
1687 my $error = $self->retry_realtime;
1689 $dbh->rollback if $oldAutoCommit;
1694 foreach my $cust_bill ( $self->open_cust_bill ) {
1696 # don't try to charge for the same invoice if it's already in a batch
1697 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1699 last if $self->balance <= 0;
1701 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1704 foreach my $part_bill_event (
1705 sort { $a->seconds <=> $b->seconds
1706 || $a->weight <=> $b->weight
1707 || $a->eventpart <=> $b->eventpart }
1708 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1709 && ! qsearch( 'cust_bill_event', {
1710 'invnum' => $cust_bill->invnum,
1711 'eventpart' => $_->eventpart,
1715 qsearch('part_bill_event', { 'payby' => $self->payby,
1716 'disabled' => '', } )
1719 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1720 || $self->balance <= 0; # or if balance<=0
1722 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1724 my $cust_main = $self; #for callback
1728 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1729 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1730 $error = eval $part_bill_event->eventcode;
1734 my $statustext = '';
1738 } elsif ( $error ) {
1740 $statustext = $error;
1745 #add cust_bill_event
1746 my $cust_bill_event = new FS::cust_bill_event {
1747 'invnum' => $cust_bill->invnum,
1748 'eventpart' => $part_bill_event->eventpart,
1749 #'_date' => $invoice_time,
1751 'status' => $status,
1752 'statustext' => $statustext,
1754 $error = $cust_bill_event->insert;
1756 #$dbh->rollback if $oldAutoCommit;
1757 #return "error: $error";
1759 # gah, even with transactions.
1760 $dbh->commit if $oldAutoCommit; #well.
1761 my $e = 'WARNING: Event run but database not updated - '.
1762 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1763 ', eventpart '. $part_bill_event->eventpart.
1774 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1779 =item retry_realtime
1781 Schedules realtime credit card / electronic check / LEC billing events for
1782 for retry. Useful if card information has changed or manual retry is desired.
1783 The 'collect' method must be called to actually retry the transaction.
1785 Implementation details: For each of this customer's open invoices, changes
1786 the status of the first "done" (with statustext error) realtime processing
1791 sub retry_realtime {
1794 local $SIG{HUP} = 'IGNORE';
1795 local $SIG{INT} = 'IGNORE';
1796 local $SIG{QUIT} = 'IGNORE';
1797 local $SIG{TERM} = 'IGNORE';
1798 local $SIG{TSTP} = 'IGNORE';
1799 local $SIG{PIPE} = 'IGNORE';
1801 my $oldAutoCommit = $FS::UID::AutoCommit;
1802 local $FS::UID::AutoCommit = 0;
1805 foreach my $cust_bill (
1806 grep { $_->cust_bill_event }
1807 $self->open_cust_bill
1809 my @cust_bill_event =
1810 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1812 #$_->part_bill_event->plan eq 'realtime-card'
1813 $_->part_bill_event->eventcode =~
1814 /\$cust_bill\->realtime_(card|ach|lec)/
1815 && $_->status eq 'done'
1818 $cust_bill->cust_bill_event;
1819 next unless @cust_bill_event;
1820 my $error = $cust_bill_event[0]->retry;
1822 $dbh->rollback if $oldAutoCommit;
1823 return "error scheduling invoice event for retry: $error";
1828 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1833 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1835 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1836 via a Business::OnlinePayment realtime gateway. See
1837 L<http://420.am/business-onlinepayment> for supported gateways.
1839 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1841 Available options are: I<description>, I<invnum>, I<quiet>
1843 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1844 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
1845 if set, will override the value from the customer record.
1847 I<description> is a free-text field passed to the gateway. It defaults to
1848 "Internet services".
1850 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1851 specified invoice. If you don't specify an I<invnum> you might want to
1852 call the B<apply_payments> method.
1854 I<quiet> can be set true to surpress email decline notices.
1856 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1861 my( $self, $method, $amount, %options ) = @_;
1863 warn "$self $method $amount\n";
1864 warn " $_ => $options{$_}\n" foreach keys %options;
1867 $options{'description'} ||= 'Internet services';
1870 die "Real-time processing not enabled\n"
1871 unless $conf->exists('business-onlinepayment');
1872 eval "use Business::OnlinePayment";
1876 my $bop_config = 'business-onlinepayment';
1877 $bop_config .= '-ach'
1878 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1879 my ( $processor, $login, $password, $action, @bop_options ) =
1880 $conf->config($bop_config);
1881 $action ||= 'normal authorization';
1882 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1883 die "No real-time processor is enabled - ".
1884 "did you set the business-onlinepayment configuration value?\n"
1889 my $address = exists($options{'address1'})
1890 ? $options{'address1'}
1892 my $address2 = exists($options{'address2'})
1893 ? $options{'address2'}
1895 $address .= ", ". $address2 if length($address2);
1897 my $o_payname = exists($options{'payname'})
1898 ? $options{'payname'}
1900 my($payname, $payfirst, $paylast);
1901 if ( $o_payname && $method ne 'ECHECK' ) {
1902 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1903 or return "Illegal payname $payname";
1904 ($payfirst, $paylast) = ($1, $2);
1906 $payfirst = $self->getfield('first');
1907 $paylast = $self->getfield('last');
1908 $payname = "$payfirst $paylast";
1911 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1912 if ( $conf->exists('emailinvoiceauto')
1913 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1914 push @invoicing_list, $self->all_emails;
1917 my $email = ($conf->exists('business-onlinepayment-email-override'))
1918 ? $conf->config('business-onlinepayment-email-override')
1919 : $invoicing_list[0];
1921 my $payinfo = exists($options{'payinfo'})
1922 ? $options{'payinfo'}
1926 if ( $method eq 'CC' ) {
1928 $content{card_number} = $payinfo;
1929 my $paydate = exists($options{'paydate'})
1930 ? $options{'paydate'}
1932 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1933 $content{expiration} = "$2/$1";
1935 if ( defined $self->dbdef_table->column('paycvv') ) {
1936 my $paycvv = exists($options{'paycvv'})
1937 ? $options{'paycvv'}
1939 $content{cvv2} = $self->paycvv
1943 $content{recurring_billing} = 'YES'
1944 if qsearch('cust_pay', { 'custnum' => $self->custnum,
1946 'payinfo' => $payinfo,
1949 } elsif ( $method eq 'ECHECK' ) {
1950 ( $content{account_number}, $content{routing_code} ) =
1951 split('@', $payinfo);
1952 $content{bank_name} = $o_payname;
1953 $content{account_type} = 'CHECKING';
1954 $content{account_name} = $payname;
1955 $content{customer_org} = $self->company ? 'B' : 'I';
1956 $content{customer_ssn} = exists($options{'ss'})
1959 } elsif ( $method eq 'LEC' ) {
1960 $content{phone} = $payinfo;
1965 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1967 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1968 $transaction->content(
1971 'password' => $password,
1972 'action' => $action1,
1973 'description' => $options{'description'},
1974 'amount' => $amount,
1975 'invoice_number' => $options{'invnum'},
1976 'customer_id' => $self->custnum,
1977 'last_name' => $paylast,
1978 'first_name' => $payfirst,
1980 'address' => $address,
1981 'city' => ( exists($options{'city'})
1984 'state' => ( exists($options{'state'})
1987 'zip' => ( exists($options{'zip'})
1990 'country' => ( exists($options{'country'})
1991 ? $options{'country'}
1993 'referer' => 'http://cleanwhisker.420.am/',
1995 'phone' => $self->daytime || $self->night,
1998 $transaction->submit();
2000 if ( $transaction->is_success() && $action2 ) {
2001 my $auth = $transaction->authorization;
2002 my $ordernum = $transaction->can('order_number')
2003 ? $transaction->order_number
2007 new Business::OnlinePayment( $processor, @bop_options );
2014 password => $password,
2015 order_number => $ordernum,
2017 authorization => $auth,
2018 description => $options{'description'},
2021 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2022 transaction_sequence_num local_transaction_date
2023 local_transaction_time AVS_result_code )) {
2024 $capture{$field} = $transaction->$field() if $transaction->can($field);
2027 $capture->content( %capture );
2031 unless ( $capture->is_success ) {
2032 my $e = "Authorization sucessful but capture failed, custnum #".
2033 $self->custnum. ': '. $capture->result_code.
2034 ": ". $capture->error_message;
2041 #remove paycvv after initial transaction
2042 #false laziness w/misc/process/payment.cgi - check both to make sure working
2044 if ( defined $self->dbdef_table->column('paycvv')
2045 && length($self->paycvv)
2046 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2048 my $error = $self->remove_cvv;
2050 warn "error removing cvv: $error\n";
2055 if ( $transaction->is_success() ) {
2057 my %method2payby = (
2063 my $paybatch = "$processor:". $transaction->authorization;
2064 $paybatch .= ':'. $transaction->order_number
2065 if $transaction->can('order_number')
2066 && length($transaction->order_number);
2068 my $cust_pay = new FS::cust_pay ( {
2069 'custnum' => $self->custnum,
2070 'invnum' => $options{'invnum'},
2073 'payby' => $method2payby{$method},
2074 'payinfo' => $payinfo,
2075 'paybatch' => $paybatch,
2077 my $error = $cust_pay->insert;
2079 $cust_pay->invnum(''); #try again with no specific invnum
2080 my $error2 = $cust_pay->insert;
2082 # gah, even with transactions.
2083 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2084 "error inserting payment ($processor): $error2".
2085 " (previously tried insert with invnum #$options{'invnum'}" .
2091 return ''; #no error
2095 my $perror = "$processor error: ". $transaction->error_message;
2097 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2098 && $conf->exists('emaildecline')
2099 && grep { $_ ne 'POST' } $self->invoicing_list
2100 && ! grep { $transaction->error_message =~ /$_/ }
2101 $conf->config('emaildecline-exclude')
2103 my @templ = $conf->config('declinetemplate');
2104 my $template = new Text::Template (
2106 SOURCE => [ map "$_\n", @templ ],
2107 ) or return "($perror) can't create template: $Text::Template::ERROR";
2108 $template->compile()
2109 or return "($perror) can't compile template: $Text::Template::ERROR";
2111 my $templ_hash = { error => $transaction->error_message };
2113 my $error = send_email(
2114 'from' => $conf->config('invoice_from'),
2115 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2116 'subject' => 'Your payment could not be processed',
2117 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2120 $perror .= " (also received error sending decline notification: $error)"
2132 Removes the I<paycvv> field from the database directly.
2134 If there is an error, returns the error, otherwise returns false.
2140 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2141 or return dbh->errstr;
2142 $sth->execute($self->custnum)
2143 or return $sth->errstr;
2148 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2150 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2151 via a Business::OnlinePayment realtime gateway. See
2152 L<http://420.am/business-onlinepayment> for supported gateways.
2154 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2156 Available options are: I<amount>, I<reason>, I<paynum>
2158 Most gateways require a reference to an original payment transaction to refund,
2159 so you probably need to specify a I<paynum>.
2161 I<amount> defaults to the original amount of the payment if not specified.
2163 I<reason> specifies a reason for the refund.
2165 Implementation note: If I<amount> is unspecified or equal to the amount of the
2166 orignal payment, first an attempt is made to "void" the transaction via
2167 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2168 the normal attempt is made to "refund" ("credit") the transaction via the
2169 gateway is attempted.
2171 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2172 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2173 #if set, will override the value from the customer record.
2175 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2176 #specified invoice. If you don't specify an I<invnum> you might want to
2177 #call the B<apply_payments> method.
2181 #some false laziness w/realtime_bop, not enough to make it worth merging
2182 #but some useful small subs should be pulled out
2183 sub realtime_refund_bop {
2184 my( $self, $method, %options ) = @_;
2186 warn "$self $method refund\n";
2187 warn " $_ => $options{$_}\n" foreach keys %options;
2191 die "Real-time processing not enabled\n"
2192 unless $conf->exists('business-onlinepayment');
2193 eval "use Business::OnlinePayment";
2197 my $bop_config = 'business-onlinepayment';
2198 $bop_config .= '-ach'
2199 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2200 my ( $processor, $login, $password, $unused_action, @bop_options ) =
2201 $conf->config($bop_config);
2202 #$action ||= 'normal authorization';
2203 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2204 die "No real-time processor is enabled - ".
2205 "did you set the business-onlinepayment configuration value?\n"
2209 my $amount = $options{'amount'};
2210 my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2211 if ( $options{'paynum'} ) {
2212 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2213 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2214 or return "Unknown paynum $options{'paynum'}";
2215 $amount ||= $cust_pay->paid;
2216 $cust_pay->paybatch =~ /^(\w+):([\w-]*)(:(\w+))?$/
2217 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2218 $cust_pay->paybatch;
2219 ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2220 return "processor of payment $options{'paynum'} $pay_processor does not".
2221 " match current processor $processor"
2222 unless $pay_processor eq $processor;
2224 return "neither amount nor paynum specified" unless $amount;
2229 'password' => $password,
2230 'order_number' => $order_number,
2231 'amount' => $amount,
2232 'referer' => 'http://cleanwhisker.420.am/',
2234 $content{authorization} = $auth
2235 if length($auth); #echeck/ACH transactions have an order # but no auth
2236 #(at least with authorize.net)
2238 #first try void if applicable
2239 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2240 warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2241 my $void = new Business::OnlinePayment( $processor, @bop_options );
2242 $void->content( 'action' => 'void', %content );
2244 if ( $void->is_success ) {
2245 my $error = $cust_pay->void($options{'reason'});
2247 # gah, even with transactions.
2248 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2249 "error voiding payment: $error";
2253 warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2258 warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2262 my $address = $self->address1;
2263 $address .= ", ". $self->address2 if $self->address2;
2265 my($payname, $payfirst, $paylast);
2266 if ( $self->payname && $method ne 'ECHECK' ) {
2267 $payname = $self->payname;
2268 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2269 or return "Illegal payname $payname";
2270 ($payfirst, $paylast) = ($1, $2);
2272 $payfirst = $self->getfield('first');
2273 $paylast = $self->getfield('last');
2274 $payname = "$payfirst $paylast";
2278 if ( $method eq 'CC' ) {
2281 $content{card_number} = $payinfo = $cust_pay->payinfo;
2282 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2283 #$content{expiration} = "$2/$1";
2285 $content{card_number} = $payinfo = $self->payinfo;
2286 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2287 $content{expiration} = "$2/$1";
2290 } elsif ( $method eq 'ECHECK' ) {
2291 ( $content{account_number}, $content{routing_code} ) =
2292 split('@', $payinfo = $self->payinfo);
2293 $content{bank_name} = $self->payname;
2294 $content{account_type} = 'CHECKING';
2295 $content{account_name} = $payname;
2296 $content{customer_org} = $self->company ? 'B' : 'I';
2297 $content{customer_ssn} = $self->ss;
2298 } elsif ( $method eq 'LEC' ) {
2299 $content{phone} = $payinfo = $self->payinfo;
2303 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2304 my %sub_content = $refund->content(
2305 'action' => 'credit',
2306 'customer_id' => $self->custnum,
2307 'last_name' => $paylast,
2308 'first_name' => $payfirst,
2310 'address' => $address,
2311 'city' => $self->city,
2312 'state' => $self->state,
2313 'zip' => $self->zip,
2314 'country' => $self->country,
2317 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2321 return "$processor error: ". $refund->error_message
2322 unless $refund->is_success();
2324 my %method2payby = (
2330 my $paybatch = "$processor:". $refund->authorization;
2331 $paybatch .= ':'. $refund->order_number
2332 if $refund->can('order_number') && $refund->order_number;
2334 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2335 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2336 last unless @cust_bill_pay;
2337 my $cust_bill_pay = pop @cust_bill_pay;
2338 my $error = $cust_bill_pay->delete;
2342 my $cust_refund = new FS::cust_refund ( {
2343 'custnum' => $self->custnum,
2344 'paynum' => $options{'paynum'},
2345 'refund' => $amount,
2347 'payby' => $method2payby{$method},
2348 'payinfo' => $payinfo,
2349 'paybatch' => $paybatch,
2350 'reason' => $options{'reason'} || 'card or ACH refund',
2352 my $error = $cust_refund->insert;
2354 $cust_refund->paynum(''); #try again with no specific paynum
2355 my $error2 = $cust_refund->insert;
2357 # gah, even with transactions.
2358 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2359 "error inserting refund ($processor): $error2".
2360 " (previously tried insert with paynum #$options{'paynum'}" .
2373 Returns the total owed for this customer on all invoices
2374 (see L<FS::cust_bill/owed>).
2380 $self->total_owed_date(2145859200); #12/31/2037
2383 =item total_owed_date TIME
2385 Returns the total owed for this customer on all invoices with date earlier than
2386 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2387 see L<Time::Local> and L<Date::Parse> for conversion functions.
2391 sub total_owed_date {
2395 foreach my $cust_bill (
2396 grep { $_->_date <= $time }
2397 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2399 $total_bill += $cust_bill->owed;
2401 sprintf( "%.2f", $total_bill );
2404 =item apply_credits OPTION => VALUE ...
2406 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2407 to outstanding invoice balances in chronological order (or reverse
2408 chronological order if the I<order> option is set to B<newest>) and returns the
2409 value of any remaining unapplied credits available for refund (see
2410 L<FS::cust_refund>).
2418 return 0 unless $self->total_credited;
2420 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2421 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2423 my @invoices = $self->open_cust_bill;
2424 @invoices = sort { $b->_date <=> $a->_date } @invoices
2425 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2428 foreach my $cust_bill ( @invoices ) {
2431 if ( !defined($credit) || $credit->credited == 0) {
2432 $credit = pop @credits or last;
2435 if ($cust_bill->owed >= $credit->credited) {
2436 $amount=$credit->credited;
2438 $amount=$cust_bill->owed;
2441 my $cust_credit_bill = new FS::cust_credit_bill ( {
2442 'crednum' => $credit->crednum,
2443 'invnum' => $cust_bill->invnum,
2444 'amount' => $amount,
2446 my $error = $cust_credit_bill->insert;
2447 die $error if $error;
2449 redo if ($cust_bill->owed > 0);
2453 return $self->total_credited;
2456 =item apply_payments
2458 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2459 to outstanding invoice balances in chronological order.
2461 #and returns the value of any remaining unapplied payments.
2465 sub apply_payments {
2470 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2471 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2473 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2474 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2478 foreach my $cust_bill ( @invoices ) {
2481 if ( !defined($payment) || $payment->unapplied == 0 ) {
2482 $payment = pop @payments or last;
2485 if ( $cust_bill->owed >= $payment->unapplied ) {
2486 $amount = $payment->unapplied;
2488 $amount = $cust_bill->owed;
2491 my $cust_bill_pay = new FS::cust_bill_pay ( {
2492 'paynum' => $payment->paynum,
2493 'invnum' => $cust_bill->invnum,
2494 'amount' => $amount,
2496 my $error = $cust_bill_pay->insert;
2497 die $error if $error;
2499 redo if ( $cust_bill->owed > 0);
2503 return $self->total_unapplied_payments;
2506 =item total_credited
2508 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2509 customer. See L<FS::cust_credit/credited>.
2513 sub total_credited {
2515 my $total_credit = 0;
2516 foreach my $cust_credit ( qsearch('cust_credit', {
2517 'custnum' => $self->custnum,
2519 $total_credit += $cust_credit->credited;
2521 sprintf( "%.2f", $total_credit );
2524 =item total_unapplied_payments
2526 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2527 See L<FS::cust_pay/unapplied>.
2531 sub total_unapplied_payments {
2533 my $total_unapplied = 0;
2534 foreach my $cust_pay ( qsearch('cust_pay', {
2535 'custnum' => $self->custnum,
2537 $total_unapplied += $cust_pay->unapplied;
2539 sprintf( "%.2f", $total_unapplied );
2544 Returns the balance for this customer (total_owed minus total_credited
2545 minus total_unapplied_payments).
2552 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2556 =item balance_date TIME
2558 Returns the balance for this customer, only considering invoices with date
2559 earlier than TIME (total_owed_date minus total_credited minus
2560 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2561 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2570 $self->total_owed_date($time)
2571 - $self->total_credited
2572 - $self->total_unapplied_payments
2576 =item paydate_monthyear
2578 Returns a two-element list consisting of the month and year of this customer's
2579 paydate (credit card expiration date for CARD customers)
2583 sub paydate_monthyear {
2585 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2587 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2594 =item payinfo_masked
2596 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.
2598 Credit Cards - Mask all but the last four characters.
2599 Checks - Mask all but last 2 of account number and bank routing number.
2600 Others - Do nothing, return the unmasked string.
2604 sub payinfo_masked {
2606 return $self->paymask;
2609 =item invoicing_list [ ARRAYREF ]
2611 If an arguement is given, sets these email addresses as invoice recipients
2612 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2613 (except as warnings), so use check_invoicing_list first.
2615 Returns a list of email addresses (with svcnum entries expanded).
2617 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2618 check it without disturbing anything by passing nothing.
2620 This interface may change in the future.
2624 sub invoicing_list {
2625 my( $self, $arrayref ) = @_;
2627 my @cust_main_invoice;
2628 if ( $self->custnum ) {
2629 @cust_main_invoice =
2630 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2632 @cust_main_invoice = ();
2634 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2635 #warn $cust_main_invoice->destnum;
2636 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2637 #warn $cust_main_invoice->destnum;
2638 my $error = $cust_main_invoice->delete;
2639 warn $error if $error;
2642 if ( $self->custnum ) {
2643 @cust_main_invoice =
2644 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2646 @cust_main_invoice = ();
2648 my %seen = map { $_->address => 1 } @cust_main_invoice;
2649 foreach my $address ( @{$arrayref} ) {
2650 next if exists $seen{$address} && $seen{$address};
2651 $seen{$address} = 1;
2652 my $cust_main_invoice = new FS::cust_main_invoice ( {
2653 'custnum' => $self->custnum,
2656 my $error = $cust_main_invoice->insert;
2657 warn $error if $error;
2660 if ( $self->custnum ) {
2662 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2668 =item check_invoicing_list ARRAYREF
2670 Checks these arguements as valid input for the invoicing_list method. If there
2671 is an error, returns the error, otherwise returns false.
2675 sub check_invoicing_list {
2676 my( $self, $arrayref ) = @_;
2677 foreach my $address ( @{$arrayref} ) {
2679 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2680 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2683 my $cust_main_invoice = new FS::cust_main_invoice ( {
2684 'custnum' => $self->custnum,
2687 my $error = $self->custnum
2688 ? $cust_main_invoice->check
2689 : $cust_main_invoice->checkdest
2691 return $error if $error;
2696 =item set_default_invoicing_list
2698 Sets the invoicing list to all accounts associated with this customer,
2699 overwriting any previous invoicing list.
2703 sub set_default_invoicing_list {
2705 $self->invoicing_list($self->all_emails);
2710 Returns the email addresses of all accounts provisioned for this customer.
2717 foreach my $cust_pkg ( $self->all_pkgs ) {
2718 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2720 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2721 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2723 $list{$_}=1 foreach map { $_->email } @svc_acct;
2728 =item invoicing_list_addpost
2730 Adds postal invoicing to this customer. If this customer is already configured
2731 to receive postal invoices, does nothing.
2735 sub invoicing_list_addpost {
2737 return if grep { $_ eq 'POST' } $self->invoicing_list;
2738 my @invoicing_list = $self->invoicing_list;
2739 push @invoicing_list, 'POST';
2740 $self->invoicing_list(\@invoicing_list);
2743 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2745 Returns an array of customers referred by this customer (referral_custnum set
2746 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2747 customers referred by customers referred by this customer and so on, inclusive.
2748 The default behavior is DEPTH 1 (no recursion).
2752 sub referral_cust_main {
2754 my $depth = @_ ? shift : 1;
2755 my $exclude = @_ ? shift : {};
2758 map { $exclude->{$_->custnum}++; $_; }
2759 grep { ! $exclude->{ $_->custnum } }
2760 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2764 map { $_->referral_cust_main($depth-1, $exclude) }
2771 =item referral_cust_main_ncancelled
2773 Same as referral_cust_main, except only returns customers with uncancelled
2778 sub referral_cust_main_ncancelled {
2780 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2783 =item referral_cust_pkg [ DEPTH ]
2785 Like referral_cust_main, except returns a flat list of all unsuspended (and
2786 uncancelled) packages for each customer. The number of items in this list may
2787 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2791 sub referral_cust_pkg {
2793 my $depth = @_ ? shift : 1;
2795 map { $_->unsuspended_pkgs }
2796 grep { $_->unsuspended_pkgs }
2797 $self->referral_cust_main($depth);
2800 =item referring_cust_main
2802 Returns the single cust_main record for the customer who referred this customer
2803 (referral_custnum), or false.
2807 sub referring_cust_main {
2809 return '' unless $self->referral_custnum;
2810 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2813 =item credit AMOUNT, REASON
2815 Applies a credit to this customer. If there is an error, returns the error,
2816 otherwise returns false.
2821 my( $self, $amount, $reason ) = @_;
2822 my $cust_credit = new FS::cust_credit {
2823 'custnum' => $self->custnum,
2824 'amount' => $amount,
2825 'reason' => $reason,
2827 $cust_credit->insert;
2830 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2832 Creates a one-time charge for this customer. If there is an error, returns
2833 the error, otherwise returns false.
2838 my ( $self, $amount ) = ( shift, shift );
2839 my $pkg = @_ ? shift : 'One-time charge';
2840 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
2841 my $taxclass = @_ ? shift : '';
2843 local $SIG{HUP} = 'IGNORE';
2844 local $SIG{INT} = 'IGNORE';
2845 local $SIG{QUIT} = 'IGNORE';
2846 local $SIG{TERM} = 'IGNORE';
2847 local $SIG{TSTP} = 'IGNORE';
2848 local $SIG{PIPE} = 'IGNORE';
2850 my $oldAutoCommit = $FS::UID::AutoCommit;
2851 local $FS::UID::AutoCommit = 0;
2854 my $part_pkg = new FS::part_pkg ( {
2856 'comment' => $comment,
2857 #'setup' => $amount,
2860 'plandata' => "setup_fee=$amount",
2863 'taxclass' => $taxclass,
2866 my $error = $part_pkg->insert;
2868 $dbh->rollback if $oldAutoCommit;
2872 my $pkgpart = $part_pkg->pkgpart;
2873 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2874 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2875 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2876 $error = $type_pkgs->insert;
2878 $dbh->rollback if $oldAutoCommit;
2883 my $cust_pkg = new FS::cust_pkg ( {
2884 'custnum' => $self->custnum,
2885 'pkgpart' => $pkgpart,
2888 $error = $cust_pkg->insert;
2890 $dbh->rollback if $oldAutoCommit;
2894 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2901 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2907 sort { $a->_date <=> $b->_date }
2908 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2911 =item open_cust_bill
2913 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2918 sub open_cust_bill {
2920 grep { $_->owed > 0 } $self->cust_bill;
2925 Returns all the credits (see L<FS::cust_credit>) for this customer.
2931 sort { $a->_date <=> $b->_date }
2932 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2937 Returns all the payments (see L<FS::cust_pay>) for this customer.
2943 sort { $a->_date <=> $b->_date }
2944 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2949 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2955 sort { $a->_date <=> $b->_date }
2956 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2962 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2968 sort { $a->_date <=> $b->_date }
2969 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2972 =item select_for_update
2974 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
2979 sub select_for_update {
2981 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2986 Returns a name string for this customer, either "Company (Last, First)" or
2993 my $name = $self->get('last'). ', '. $self->first;
2994 $name = $self->company. " ($name)" if $self->company;
3000 Returns a status string for this customer, currently:
3004 =item prospect - No packages have ever been ordered
3006 =item active - One or more recurring packages is active
3008 =item suspended - All non-cancelled recurring packages are suspended
3010 =item cancelled - All recurring packages are cancelled
3018 for my $status (qw( prospect active suspended cancelled )) {
3019 my $method = $status.'_sql';
3020 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3021 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3022 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3023 return $status if $sth->fetchrow_arrayref->[0];
3029 Returns a hex triplet color string for this customer's status.
3034 'prospect' => '000000',
3035 'active' => '00CC00',
3036 'suspended' => 'FF9900',
3037 'cancelled' => 'FF0000',
3041 $statuscolor{$self->status};
3046 =head1 CLASS METHODS
3052 Returns an SQL expression identifying prospective cust_main records (customers
3053 with no packages ever ordered)
3057 sub prospect_sql { "
3058 0 = ( SELECT COUNT(*) FROM cust_pkg
3059 WHERE cust_pkg.custnum = cust_main.custnum
3065 Returns an SQL expression identifying active cust_main records.
3070 0 < ( SELECT COUNT(*) FROM cust_pkg
3071 WHERE cust_pkg.custnum = cust_main.custnum
3072 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3073 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3080 Returns an SQL expression identifying suspended cust_main records.
3084 sub suspended_sql { susp_sql(@_); }
3086 0 < ( SELECT COUNT(*) FROM cust_pkg
3087 WHERE cust_pkg.custnum = cust_main.custnum
3088 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3090 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3091 WHERE cust_pkg.custnum = cust_main.custnum
3092 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3093 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3100 Returns an SQL expression identifying cancelled cust_main records.
3104 sub cancelled_sql { cancel_sql(@_); }
3106 0 < ( SELECT COUNT(*) FROM cust_pkg
3107 WHERE cust_pkg.custnum = cust_main.custnum
3109 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3110 WHERE cust_pkg.custnum = cust_main.custnum
3111 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3115 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3117 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3118 records. Currently, only I<last> or I<company> may be specified (the
3119 appropriate ship_ field is also searched if applicable).
3121 Additional options are the same as FS::Record::qsearch
3126 my( $self, $fuzzy, $hash, @opt) = @_;
3131 check_and_rebuild_fuzzyfiles();
3132 foreach my $field ( keys %$fuzzy ) {
3133 my $sub = \&{"all_$field"};
3135 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3137 foreach ( keys %match ) {
3138 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3139 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3140 if defined dbdef->table('cust_main')->column('ship_last');
3145 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3157 =item smart_search OPTION => VALUE ...
3159 Accepts the following options: I<search>, the string to search for. The string
3160 will be searched for as a customer number, last name or company name, first
3161 searching for an exact match then fuzzy and substring matches.
3163 Any additional options treated as an additional qualifier on the search
3166 Returns a (possibly empty) array of FS::cust_main objects.
3172 my $search = delete $options{'search'};
3175 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3177 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3179 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3182 my $q_value = dbh->quote($value);
3185 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3186 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3187 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3188 if defined dbdef->table('cust_main')->column('ship_last');
3191 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3193 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3195 #still some false laziness w/ search/cust_main.cgi
3198 push @cust_main, qsearch( 'cust_main',
3199 { 'last' => { 'op' => 'ILIKE',
3200 'value' => "%$q_value%" },
3204 push @cust_main, qsearch( 'cust_main',
3205 { 'ship_last' => { 'op' => 'ILIKE',
3206 'value' => "%$q_value%" },
3211 if defined dbdef->table('cust_main')->column('ship_last');
3213 push @cust_main, qsearch( 'cust_main',
3214 { 'company' => { 'op' => 'ILIKE',
3215 'value' => "%$q_value%" },
3219 push @cust_main, qsearch( 'cust_main',
3220 { 'ship_company' => { 'op' => 'ILIKE',
3221 'value' => "%$q_value%" },
3225 if defined dbdef->table('cust_main')->column('ship_last');
3228 push @cust_main, FS::cust_main->fuzzy_search(
3229 { 'last' => $value },
3232 push @cust_main, FS::cust_main->fuzzy_search(
3233 { 'company' => $value },
3245 =item check_and_rebuild_fuzzyfiles
3249 sub check_and_rebuild_fuzzyfiles {
3250 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3251 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3252 or &rebuild_fuzzyfiles;
3255 =item rebuild_fuzzyfiles
3259 sub rebuild_fuzzyfiles {
3261 use Fcntl qw(:flock);
3263 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3267 open(LASTLOCK,">>$dir/cust_main.last")
3268 or die "can't open $dir/cust_main.last: $!";
3269 flock(LASTLOCK,LOCK_EX)
3270 or die "can't lock $dir/cust_main.last: $!";
3272 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3274 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3275 if defined dbdef->table('cust_main')->column('ship_last');
3277 open (LASTCACHE,">$dir/cust_main.last.tmp")
3278 or die "can't open $dir/cust_main.last.tmp: $!";
3279 print LASTCACHE join("\n", @all_last), "\n";
3280 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3282 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3287 open(COMPANYLOCK,">>$dir/cust_main.company")
3288 or die "can't open $dir/cust_main.company: $!";
3289 flock(COMPANYLOCK,LOCK_EX)
3290 or die "can't lock $dir/cust_main.company: $!";
3292 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3294 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3295 if defined dbdef->table('cust_main')->column('ship_last');
3297 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3298 or die "can't open $dir/cust_main.company.tmp: $!";
3299 print COMPANYCACHE join("\n", @all_company), "\n";
3300 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3302 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3312 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3313 open(LASTCACHE,"<$dir/cust_main.last")
3314 or die "can't open $dir/cust_main.last: $!";
3315 my @array = map { chomp; $_; } <LASTCACHE>;
3325 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3326 open(COMPANYCACHE,"<$dir/cust_main.company")
3327 or die "can't open $dir/cust_main.last: $!";
3328 my @array = map { chomp; $_; } <COMPANYCACHE>;
3333 =item append_fuzzyfiles LASTNAME COMPANY
3337 sub append_fuzzyfiles {
3338 my( $last, $company ) = @_;
3340 &check_and_rebuild_fuzzyfiles;
3342 use Fcntl qw(:flock);
3344 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3348 open(LAST,">>$dir/cust_main.last")
3349 or die "can't open $dir/cust_main.last: $!";
3351 or die "can't lock $dir/cust_main.last: $!";
3353 print LAST "$last\n";
3356 or die "can't unlock $dir/cust_main.last: $!";
3362 open(COMPANY,">>$dir/cust_main.company")
3363 or die "can't open $dir/cust_main.company: $!";
3364 flock(COMPANY,LOCK_EX)
3365 or die "can't lock $dir/cust_main.company: $!";
3367 print COMPANY "$company\n";
3369 flock(COMPANY,LOCK_UN)
3370 or die "can't unlock $dir/cust_main.company: $!";
3384 #warn join('-',keys %$param);
3385 my $fh = $param->{filehandle};
3386 my $agentnum = $param->{agentnum};
3387 my $refnum = $param->{refnum};
3388 my $pkgpart = $param->{pkgpart};
3389 my @fields = @{$param->{fields}};
3391 eval "use Date::Parse;";
3393 eval "use Text::CSV_XS;";
3396 my $csv = new Text::CSV_XS;
3403 local $SIG{HUP} = 'IGNORE';
3404 local $SIG{INT} = 'IGNORE';
3405 local $SIG{QUIT} = 'IGNORE';
3406 local $SIG{TERM} = 'IGNORE';
3407 local $SIG{TSTP} = 'IGNORE';
3408 local $SIG{PIPE} = 'IGNORE';
3410 my $oldAutoCommit = $FS::UID::AutoCommit;
3411 local $FS::UID::AutoCommit = 0;
3414 #while ( $columns = $csv->getline($fh) ) {
3416 while ( defined($line=<$fh>) ) {
3418 $csv->parse($line) or do {
3419 $dbh->rollback if $oldAutoCommit;
3420 return "can't parse: ". $csv->error_input();
3423 my @columns = $csv->fields();
3424 #warn join('-',@columns);
3427 agentnum => $agentnum,
3429 country => $conf->config('countrydefault') || 'US',
3430 payby => 'BILL', #default
3431 paydate => '12/2037', #default
3433 my $billtime = time;
3434 my %cust_pkg = ( pkgpart => $pkgpart );
3435 foreach my $field ( @fields ) {
3436 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3437 #$cust_pkg{$1} = str2time( shift @$columns );
3438 if ( $1 eq 'setup' ) {
3439 $billtime = str2time(shift @columns);
3441 $cust_pkg{$1} = str2time( shift @columns );
3444 #$cust_main{$field} = shift @$columns;
3445 $cust_main{$field} = shift @columns;
3449 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3450 my $cust_main = new FS::cust_main ( \%cust_main );
3452 tie my %hash, 'Tie::RefHash'; #this part is important
3453 $hash{$cust_pkg} = [] if $pkgpart;
3454 my $error = $cust_main->insert( \%hash );
3457 $dbh->rollback if $oldAutoCommit;
3458 return "can't insert customer for $line: $error";
3461 #false laziness w/bill.cgi
3462 $error = $cust_main->bill( 'time' => $billtime );
3464 $dbh->rollback if $oldAutoCommit;
3465 return "can't bill customer for $line: $error";
3468 $cust_main->apply_payments;
3469 $cust_main->apply_credits;
3471 $error = $cust_main->collect();
3473 $dbh->rollback if $oldAutoCommit;
3474 return "can't collect customer for $line: $error";
3480 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3482 return "Empty file!" unless $imported;
3494 #warn join('-',keys %$param);
3495 my $fh = $param->{filehandle};
3496 my @fields = @{$param->{fields}};
3498 eval "use Date::Parse;";
3500 eval "use Text::CSV_XS;";
3503 my $csv = new Text::CSV_XS;
3510 local $SIG{HUP} = 'IGNORE';
3511 local $SIG{INT} = 'IGNORE';
3512 local $SIG{QUIT} = 'IGNORE';
3513 local $SIG{TERM} = 'IGNORE';
3514 local $SIG{TSTP} = 'IGNORE';
3515 local $SIG{PIPE} = 'IGNORE';
3517 my $oldAutoCommit = $FS::UID::AutoCommit;
3518 local $FS::UID::AutoCommit = 0;
3521 #while ( $columns = $csv->getline($fh) ) {
3523 while ( defined($line=<$fh>) ) {
3525 $csv->parse($line) or do {
3526 $dbh->rollback if $oldAutoCommit;
3527 return "can't parse: ". $csv->error_input();
3530 my @columns = $csv->fields();
3531 #warn join('-',@columns);
3534 foreach my $field ( @fields ) {
3535 $row{$field} = shift @columns;
3538 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3539 unless ( $cust_main ) {
3540 $dbh->rollback if $oldAutoCommit;
3541 return "unknown custnum $row{'custnum'}";
3544 if ( $row{'amount'} > 0 ) {
3545 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3547 $dbh->rollback if $oldAutoCommit;
3551 } elsif ( $row{'amount'} < 0 ) {
3552 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3555 $dbh->rollback if $oldAutoCommit;
3565 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3567 return "Empty file!" unless $imported;
3579 The delete method should possibly take an FS::cust_main object reference
3580 instead of a scalar customer number.
3582 Bill and collect options should probably be passed as references instead of a
3585 There should probably be a configuration file with a list of allowed credit
3588 No multiple currency support (probably a larger project than just this module).
3590 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3594 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3595 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3596 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.