4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $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;
54 $me = '[FS::cust_main]';
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_identifier = '';
353 my( $amount, $seconds ) = ( 0, 0 );
354 if ( $self->payby eq 'PREPAY' ) {
356 $self->payby('BILL');
357 $prepay_identifier = $self->payinfo;
360 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
362 $dbh->rollback if $oldAutoCommit;
363 #return "error applying prepaid card (transaction rolled back): $error";
369 my $error = $self->SUPER::insert;
371 $dbh->rollback if $oldAutoCommit;
372 #return "inserting cust_main record (transaction rolled back): $error";
377 if ( $invoicing_list ) {
378 $error = $self->check_invoicing_list( $invoicing_list );
380 $dbh->rollback if $oldAutoCommit;
381 return "checking invoicing_list (transaction rolled back): $error";
383 $self->invoicing_list( $invoicing_list );
387 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
389 $dbh->rollback if $oldAutoCommit;
394 $dbh->rollback if $oldAutoCommit;
395 return "No svc_acct record to apply pre-paid time";
399 $error = $self->insert_prepay($amount, $prepay_identifier);
401 $dbh->rollback if $oldAutoCommit;
402 return "inserting prepayment (transaction rolled back): $error";
406 unless ( $import || $skip_fuzzyfiles ) {
407 $error = $self->queue_fuzzyfiles_update;
409 $dbh->rollback if $oldAutoCommit;
410 return "updating fuzzy search cache: $error";
414 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
419 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
421 Like the insert method on an existing record, this method orders a package
422 and included services atomicaly. Pass a Tie::RefHash data structure to this
423 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
424 be a better explanation of this, but until then, here's an example:
427 tie %hash, 'Tie::RefHash'; #this part is important
429 $cust_pkg => [ $svc_acct ],
432 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
434 Services can be new, in which case they are inserted, or existing unaudited
435 services, in which case they are linked to the newly-created package.
437 Currently available options are: I<depend_jobnum> and I<noexport>.
439 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
440 on the supplied jobnum (they will not run until the specific job completes).
441 This can be used to defer provisioning until some action completes (such
442 as running the customer's credit card sucessfully).
444 The I<noexport> option is deprecated. If I<noexport> is set true, no
445 provisioning jobs (exports) are scheduled. (You can schedule them later with
446 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
447 on the cust_main object is not recommended, as existing services will also be
454 my $cust_pkgs = shift;
457 my %svc_options = ();
458 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
459 if exists $options{'depend_jobnum'};
460 warn "FS::cust_main::order_pkgs called with options ".
461 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
464 local $SIG{HUP} = 'IGNORE';
465 local $SIG{INT} = 'IGNORE';
466 local $SIG{QUIT} = 'IGNORE';
467 local $SIG{TERM} = 'IGNORE';
468 local $SIG{TSTP} = 'IGNORE';
469 local $SIG{PIPE} = 'IGNORE';
471 my $oldAutoCommit = $FS::UID::AutoCommit;
472 local $FS::UID::AutoCommit = 0;
475 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
477 foreach my $cust_pkg ( keys %$cust_pkgs ) {
478 $cust_pkg->custnum( $self->custnum );
479 my $error = $cust_pkg->insert;
481 $dbh->rollback if $oldAutoCommit;
482 return "inserting cust_pkg (transaction rolled back): $error";
484 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
485 if ( $svc_something->svcnum ) {
486 my $old_cust_svc = $svc_something->cust_svc;
487 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
488 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
489 $error = $new_cust_svc->replace($old_cust_svc);
491 $svc_something->pkgnum( $cust_pkg->pkgnum );
492 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
493 $svc_something->seconds( $svc_something->seconds + $$seconds );
496 $error = $svc_something->insert(%svc_options);
499 $dbh->rollback if $oldAutoCommit;
500 #return "inserting svc_ (transaction rolled back): $error";
506 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
510 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
512 Recharges this (existing) customer with the specified prepaid card (see
513 L<FS::prepay_credit>), specified either by I<identifier> or as an
514 FS::prepay_credit object. If there is an error, returns the error, otherwise
517 Optionally, two scalar references can be passed as well. They will have their
518 values filled in with the amount and number of seconds applied by this prepaid
523 sub recharge_prepay {
524 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
526 local $SIG{HUP} = 'IGNORE';
527 local $SIG{INT} = 'IGNORE';
528 local $SIG{QUIT} = 'IGNORE';
529 local $SIG{TERM} = 'IGNORE';
530 local $SIG{TSTP} = 'IGNORE';
531 local $SIG{PIPE} = 'IGNORE';
533 my $oldAutoCommit = $FS::UID::AutoCommit;
534 local $FS::UID::AutoCommit = 0;
537 my( $amount, $seconds ) = ( 0, 0 );
539 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
540 || $self->increment_seconds($seconds)
541 || $self->insert_cust_pay_prepay( $amount,
543 ? $prepay_credit->identifier
548 $dbh->rollback if $oldAutoCommit;
552 if ( defined($amountref) ) { $$amountref = $amount; }
553 if ( defined($secondsref) ) { $$secondsref = $seconds; }
555 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
560 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
562 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
563 specified either by I<identifier> or as an FS::prepay_credit object.
565 References to I<amount> and I<seconds> scalars should be passed as arguments
566 and will be incremented by the values of the prepaid card.
568 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
569 check or set this customer's I<agentnum>.
571 If there is an error, returns the error, otherwise returns false.
577 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
579 local $SIG{HUP} = 'IGNORE';
580 local $SIG{INT} = 'IGNORE';
581 local $SIG{QUIT} = 'IGNORE';
582 local $SIG{TERM} = 'IGNORE';
583 local $SIG{TSTP} = 'IGNORE';
584 local $SIG{PIPE} = 'IGNORE';
586 my $oldAutoCommit = $FS::UID::AutoCommit;
587 local $FS::UID::AutoCommit = 0;
590 unless ( ref($prepay_credit) ) {
592 my $identifier = $prepay_credit;
594 $prepay_credit = qsearchs(
596 { 'identifier' => $prepay_credit },
601 unless ( $prepay_credit ) {
602 $dbh->rollback if $oldAutoCommit;
603 return "Invalid prepaid card: ". $identifier;
608 if ( $prepay_credit->agentnum ) {
609 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
610 $dbh->rollback if $oldAutoCommit;
611 return "prepaid card not valid for agent ". $self->agentnum;
613 $self->agentnum($prepay_credit->agentnum);
616 my $error = $prepay_credit->delete;
618 $dbh->rollback if $oldAutoCommit;
619 return "removing prepay_credit (transaction rolled back): $error";
622 $$amountref += $prepay_credit->amount;
623 $$secondsref += $prepay_credit->seconds;
625 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
630 =item increment_seconds SECONDS
632 Updates this customer's single or primary account (see L<FS::svc_acct>) by
633 the specified number of seconds. If there is an error, returns the error,
634 otherwise returns false.
638 sub increment_seconds {
639 my( $self, $seconds ) = @_;
640 warn "$me increment_seconds called: $seconds seconds\n"
643 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
644 $self->ncancelled_pkgs;
647 return 'No packages with primary or single services found'.
648 ' to apply pre-paid time';
649 } elsif ( scalar(@cust_pkg) > 1 ) {
650 #maybe have a way to specify the package/account?
651 return 'Multiple packages found to apply pre-paid time';
654 my $cust_pkg = $cust_pkg[0];
655 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
659 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
662 return 'No account found to apply pre-paid time';
663 } elsif ( scalar(@cust_svc) > 1 ) {
664 return 'Multiple accounts found to apply pre-paid time';
667 my $svc_acct = $cust_svc[0]->svc_x;
668 warn " found service svcnum ". $svc_acct->pkgnum.
669 ' ('. $svc_acct->email. ")\n"
672 $svc_acct->increment_seconds($seconds);
676 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
678 Inserts a prepayment in the specified amount for this customer. An optional
679 second argument can specify the prepayment identifier for tracking purposes.
680 If there is an error, returns the error, otherwise returns false.
684 sub insert_cust_pay_prepay {
685 my( $self, $amount ) = splice(@_, 0, 2);
686 my $payinfo = scalar(@_) ? shift : '';
688 my $cust_pay = new FS::cust_pay {
689 'custnum' => $self->custnum,
690 'paid' => sprintf('%.2f', $amount),
691 #'_date' => #date the prepaid card was purchased???
693 'payinfo' => $payinfo,
701 This method is deprecated. See the I<depend_jobnum> option to the insert and
702 order_pkgs methods for a better way to defer provisioning.
704 Re-schedules all exports by calling the B<reexport> method of all associated
705 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
706 otherwise returns false.
713 carp "warning: FS::cust_main::reexport is deprectated; ".
714 "use the depend_jobnum option to insert or order_pkgs to delay export";
716 local $SIG{HUP} = 'IGNORE';
717 local $SIG{INT} = 'IGNORE';
718 local $SIG{QUIT} = 'IGNORE';
719 local $SIG{TERM} = 'IGNORE';
720 local $SIG{TSTP} = 'IGNORE';
721 local $SIG{PIPE} = 'IGNORE';
723 my $oldAutoCommit = $FS::UID::AutoCommit;
724 local $FS::UID::AutoCommit = 0;
727 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
728 my $error = $cust_pkg->reexport;
730 $dbh->rollback if $oldAutoCommit;
735 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
740 =item delete NEW_CUSTNUM
742 This deletes the customer. If there is an error, returns the error, otherwise
745 This will completely remove all traces of the customer record. This is not
746 what you want when a customer cancels service; for that, cancel all of the
747 customer's packages (see L</cancel>).
749 If the customer has any uncancelled packages, you need to pass a new (valid)
750 customer number for those packages to be transferred to. Cancelled packages
751 will be deleted. Did I mention that this is NOT what you want when a customer
752 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
754 You can't delete a customer with invoices (see L<FS::cust_bill>),
755 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
756 refunds (see L<FS::cust_refund>).
763 local $SIG{HUP} = 'IGNORE';
764 local $SIG{INT} = 'IGNORE';
765 local $SIG{QUIT} = 'IGNORE';
766 local $SIG{TERM} = 'IGNORE';
767 local $SIG{TSTP} = 'IGNORE';
768 local $SIG{PIPE} = 'IGNORE';
770 my $oldAutoCommit = $FS::UID::AutoCommit;
771 local $FS::UID::AutoCommit = 0;
774 if ( $self->cust_bill ) {
775 $dbh->rollback if $oldAutoCommit;
776 return "Can't delete a customer with invoices";
778 if ( $self->cust_credit ) {
779 $dbh->rollback if $oldAutoCommit;
780 return "Can't delete a customer with credits";
782 if ( $self->cust_pay ) {
783 $dbh->rollback if $oldAutoCommit;
784 return "Can't delete a customer with payments";
786 if ( $self->cust_refund ) {
787 $dbh->rollback if $oldAutoCommit;
788 return "Can't delete a customer with refunds";
791 my @cust_pkg = $self->ncancelled_pkgs;
793 my $new_custnum = shift;
794 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
795 $dbh->rollback if $oldAutoCommit;
796 return "Invalid new customer number: $new_custnum";
798 foreach my $cust_pkg ( @cust_pkg ) {
799 my %hash = $cust_pkg->hash;
800 $hash{'custnum'} = $new_custnum;
801 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
802 my $error = $new_cust_pkg->replace($cust_pkg);
804 $dbh->rollback if $oldAutoCommit;
809 my @cancelled_cust_pkg = $self->all_pkgs;
810 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
811 my $error = $cust_pkg->delete;
813 $dbh->rollback if $oldAutoCommit;
818 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
819 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
821 my $error = $cust_main_invoice->delete;
823 $dbh->rollback if $oldAutoCommit;
828 my $error = $self->SUPER::delete;
830 $dbh->rollback if $oldAutoCommit;
834 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
839 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
841 Replaces the OLD_RECORD with this one in the database. If there is an error,
842 returns the error, otherwise returns false.
844 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
845 be set as the invoicing list (see L<"invoicing_list">). Errors return as
846 expected and rollback the entire transaction; it is not necessary to call
847 check_invoicing_list first. Here's an example:
849 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
858 local $SIG{HUP} = 'IGNORE';
859 local $SIG{INT} = 'IGNORE';
860 local $SIG{QUIT} = 'IGNORE';
861 local $SIG{TERM} = 'IGNORE';
862 local $SIG{TSTP} = 'IGNORE';
863 local $SIG{PIPE} = 'IGNORE';
865 # If the mask is blank then try to set it - if we can...
866 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
867 $self->paymask($self->payinfo);
870 # We absolutely have to have an old vs. new record to make this work.
871 if (!defined($old)) {
872 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
875 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
876 && $conf->config('users-allow_comp') ) {
877 return "You are not permitted to create complimentary accounts."
878 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
881 my $oldAutoCommit = $FS::UID::AutoCommit;
882 local $FS::UID::AutoCommit = 0;
885 my $error = $self->SUPER::replace($old);
888 $dbh->rollback if $oldAutoCommit;
892 if ( @param ) { # INVOICING_LIST_ARYREF
893 my $invoicing_list = shift @param;
894 $error = $self->check_invoicing_list( $invoicing_list );
896 $dbh->rollback if $oldAutoCommit;
899 $self->invoicing_list( $invoicing_list );
902 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
903 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
904 # card/check/lec info has changed, want to retry realtime_ invoice events
905 my $error = $self->retry_realtime;
907 $dbh->rollback if $oldAutoCommit;
912 unless ( $import || $skip_fuzzyfiles ) {
913 $error = $self->queue_fuzzyfiles_update;
915 $dbh->rollback if $oldAutoCommit;
916 return "updating fuzzy search cache: $error";
920 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
925 =item queue_fuzzyfiles_update
927 Used by insert & replace to update the fuzzy search cache
931 sub queue_fuzzyfiles_update {
934 local $SIG{HUP} = 'IGNORE';
935 local $SIG{INT} = 'IGNORE';
936 local $SIG{QUIT} = 'IGNORE';
937 local $SIG{TERM} = 'IGNORE';
938 local $SIG{TSTP} = 'IGNORE';
939 local $SIG{PIPE} = 'IGNORE';
941 my $oldAutoCommit = $FS::UID::AutoCommit;
942 local $FS::UID::AutoCommit = 0;
945 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
946 my $error = $queue->insert($self->getfield('last'), $self->company);
948 $dbh->rollback if $oldAutoCommit;
949 return "queueing job (transaction rolled back): $error";
952 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
953 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
954 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
956 $dbh->rollback if $oldAutoCommit;
957 return "queueing job (transaction rolled back): $error";
961 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
968 Checks all fields to make sure this is a valid customer record. If there is
969 an error, returns the error, otherwise returns false. Called by the insert
977 #warn "BEFORE: \n". $self->_dump;
980 $self->ut_numbern('custnum')
981 || $self->ut_number('agentnum')
982 || $self->ut_number('refnum')
983 || $self->ut_name('last')
984 || $self->ut_name('first')
985 || $self->ut_textn('company')
986 || $self->ut_text('address1')
987 || $self->ut_textn('address2')
988 || $self->ut_text('city')
989 || $self->ut_textn('county')
990 || $self->ut_textn('state')
991 || $self->ut_country('country')
992 || $self->ut_anything('comments')
993 || $self->ut_numbern('referral_custnum')
995 #barf. need message catalogs. i18n. etc.
996 $error .= "Please select an advertising source."
997 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
998 return $error if $error;
1000 return "Unknown agent"
1001 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1003 return "Unknown refnum"
1004 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1006 return "Unknown referring custnum: ". $self->referral_custnum
1007 unless ! $self->referral_custnum
1008 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1010 if ( $self->ss eq '' ) {
1015 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1016 or return "Illegal social security number: ". $self->ss;
1017 $self->ss("$1-$2-$3");
1021 # bad idea to disable, causes billing to fail because of no tax rates later
1022 # unless ( $import ) {
1023 unless ( qsearch('cust_main_county', {
1024 'country' => $self->country,
1027 return "Unknown state/county/country: ".
1028 $self->state. "/". $self->county. "/". $self->country
1029 unless qsearch('cust_main_county',{
1030 'state' => $self->state,
1031 'county' => $self->county,
1032 'country' => $self->country,
1038 $self->ut_phonen('daytime', $self->country)
1039 || $self->ut_phonen('night', $self->country)
1040 || $self->ut_phonen('fax', $self->country)
1041 || $self->ut_zip('zip', $self->country)
1043 return $error if $error;
1046 last first company address1 address2 city county state zip
1047 country daytime night fax
1050 if ( defined $self->dbdef_table->column('ship_last') ) {
1051 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1053 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1057 $self->ut_name('ship_last')
1058 || $self->ut_name('ship_first')
1059 || $self->ut_textn('ship_company')
1060 || $self->ut_text('ship_address1')
1061 || $self->ut_textn('ship_address2')
1062 || $self->ut_text('ship_city')
1063 || $self->ut_textn('ship_county')
1064 || $self->ut_textn('ship_state')
1065 || $self->ut_country('ship_country')
1067 return $error if $error;
1069 #false laziness with above
1070 unless ( qsearchs('cust_main_county', {
1071 'country' => $self->ship_country,
1074 return "Unknown ship_state/ship_county/ship_country: ".
1075 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1076 unless qsearchs('cust_main_county',{
1077 'state' => $self->ship_state,
1078 'county' => $self->ship_county,
1079 'country' => $self->ship_country,
1085 $self->ut_phonen('ship_daytime', $self->ship_country)
1086 || $self->ut_phonen('ship_night', $self->ship_country)
1087 || $self->ut_phonen('ship_fax', $self->ship_country)
1088 || $self->ut_zip('ship_zip', $self->ship_country)
1090 return $error if $error;
1092 } else { # ship_ info eq billing info, so don't store dup info in database
1093 $self->setfield("ship_$_", '')
1094 foreach qw( last first company address1 address2 city county state zip
1095 country daytime night fax );
1099 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
1100 or return "Illegal payby: ". $self->payby;
1102 # If it is encrypted and the private key is not availaible then we can't
1103 # check the credit card.
1105 my $check_payinfo = 1;
1107 if ($self->is_encrypted($self->payinfo)) {
1113 if ( $check_payinfo && ($self->payby eq 'CARD' || $self->payby eq 'DCRD')) {
1115 my $payinfo = $self->payinfo;
1116 $payinfo =~ s/\D//g;
1117 $payinfo =~ /^(\d{13,16})$/
1118 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1120 $self->payinfo($payinfo);
1122 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1123 return gettext('unknown_card_type')
1124 if cardtype($self->payinfo) eq "Unknown";
1125 if ( defined $self->dbdef_table->column('paycvv') ) {
1126 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1127 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1128 $self->paycvv =~ /^(\d{4})$/
1129 or return "CVV2 (CID) for American Express cards is four digits.";
1132 $self->paycvv =~ /^(\d{3})$/
1133 or return "CVV2 (CVC2/CID) is three digits.";
1141 } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) {
1143 my $payinfo = $self->payinfo;
1144 $payinfo =~ s/[^\d\@]//g;
1145 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1146 $payinfo = "$1\@$2";
1147 $self->payinfo($payinfo);
1148 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1150 } elsif ( $self->payby eq 'LECB' ) {
1152 my $payinfo = $self->payinfo;
1153 $payinfo =~ s/\D//g;
1154 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1156 $self->payinfo($payinfo);
1157 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1159 } elsif ( $self->payby eq 'BILL' ) {
1161 $error = $self->ut_textn('payinfo');
1162 return "Illegal P.O. number: ". $self->payinfo if $error;
1163 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1165 } elsif ( $self->payby eq 'COMP' ) {
1167 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1168 return "You are not permitted to create complimentary accounts."
1169 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1172 $error = $self->ut_textn('payinfo');
1173 return "Illegal comp account issuer: ". $self->payinfo if $error;
1174 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1176 } elsif ( $self->payby eq 'PREPAY' ) {
1178 my $payinfo = $self->payinfo;
1179 $payinfo =~ s/\W//g; #anything else would just confuse things
1180 $self->payinfo($payinfo);
1181 $error = $self->ut_alpha('payinfo');
1182 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1183 return "Unknown prepayment identifier"
1184 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1185 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1189 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1190 return "Expriation date required"
1191 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
1195 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1196 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1197 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1198 ( $m, $y ) = ( $3, "20$2" );
1200 return "Illegal expiration date: ". $self->paydate;
1202 $self->paydate("$y-$m-01");
1203 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1204 return gettext('expired_card')
1205 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1208 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1209 ( ! $conf->exists('require_cardname')
1210 || $self->payby !~ /^(CARD|DCRD)$/ )
1212 $self->payname( $self->first. " ". $self->getfield('last') );
1214 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1215 or return gettext('illegal_name'). " payname: ". $self->payname;
1219 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1222 $self->otaker(getotaker) unless $self->otaker;
1224 #warn "AFTER: \n". $self->_dump;
1226 $self->SUPER::check;
1231 Returns all packages (see L<FS::cust_pkg>) for this customer.
1237 if ( $self->{'_pkgnum'} ) {
1238 values %{ $self->{'_pkgnum'}->cache };
1240 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1244 =item ncancelled_pkgs
1246 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1250 sub ncancelled_pkgs {
1252 if ( $self->{'_pkgnum'} ) {
1253 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1255 @{ [ # force list context
1256 qsearch( 'cust_pkg', {
1257 'custnum' => $self->custnum,
1260 qsearch( 'cust_pkg', {
1261 'custnum' => $self->custnum,
1268 =item suspended_pkgs
1270 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1274 sub suspended_pkgs {
1276 grep { $_->susp } $self->ncancelled_pkgs;
1279 =item unflagged_suspended_pkgs
1281 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1282 customer (thouse packages without the `manual_flag' set).
1286 sub unflagged_suspended_pkgs {
1288 return $self->suspended_pkgs
1289 unless dbdef->table('cust_pkg')->column('manual_flag');
1290 grep { ! $_->manual_flag } $self->suspended_pkgs;
1293 =item unsuspended_pkgs
1295 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1300 sub unsuspended_pkgs {
1302 grep { ! $_->susp } $self->ncancelled_pkgs;
1305 =item num_cancelled_pkgs
1307 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1312 sub num_cancelled_pkgs {
1314 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1318 my( $self, $sql ) = @_;
1319 my $sth = dbh->prepare(
1320 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1321 ) or die dbh->errstr;
1322 $sth->execute($self->custnum) or die $sth->errstr;
1323 $sth->fetchrow_arrayref->[0];
1328 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1329 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1330 on success or a list of errors.
1336 grep { $_->unsuspend } $self->suspended_pkgs;
1341 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1342 Always returns a list: an empty list on success or a list of errors.
1348 grep { $_->suspend } $self->unsuspended_pkgs;
1351 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1353 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1354 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1355 success or a list of errors.
1359 sub suspend_if_pkgpart {
1362 grep { $_->suspend }
1363 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1364 $self->unsuspended_pkgs;
1367 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1369 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1370 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1371 on success or a list of errors.
1375 sub suspend_unless_pkgpart {
1378 grep { $_->suspend }
1379 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1380 $self->unsuspended_pkgs;
1383 =item cancel [ OPTION => VALUE ... ]
1385 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1387 Available options are: I<quiet>
1389 I<quiet> can be set true to supress email cancellation notices.
1391 Always returns a list: an empty list on success or a list of errors.
1397 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1402 Returns the agent (see L<FS::agent>) for this customer.
1408 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1413 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1414 conjunction with the collect method.
1416 Options are passed as name-value pairs.
1418 Currently available options are:
1420 resetup - if set true, re-charges setup fees.
1422 time - bills the customer as if it were that time. Specified as a UNIX
1423 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1424 L<Date::Parse> for conversion functions. For example:
1428 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1431 If there is an error, returns the error, otherwise returns false.
1436 my( $self, %options ) = @_;
1437 return '' if $self->payby eq 'COMP';
1438 warn "bill customer ". $self->custnum. "\n" if $DEBUG;
1440 my $time = $options{'time'} || time;
1445 local $SIG{HUP} = 'IGNORE';
1446 local $SIG{INT} = 'IGNORE';
1447 local $SIG{QUIT} = 'IGNORE';
1448 local $SIG{TERM} = 'IGNORE';
1449 local $SIG{TSTP} = 'IGNORE';
1450 local $SIG{PIPE} = 'IGNORE';
1452 my $oldAutoCommit = $FS::UID::AutoCommit;
1453 local $FS::UID::AutoCommit = 0;
1456 $self->select_for_update; #mutex
1458 # find the packages which are due for billing, find out how much they are
1459 # & generate invoice database.
1461 my( $total_setup, $total_recur ) = ( 0, 0 );
1462 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1463 my @cust_bill_pkg = ();
1465 #my $taxable_charged = 0;##
1470 foreach my $cust_pkg (
1471 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1474 #NO!! next if $cust_pkg->cancel;
1475 next if $cust_pkg->getfield('cancel');
1477 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
1479 #? to avoid use of uninitialized value errors... ?
1480 $cust_pkg->setfield('bill', '')
1481 unless defined($cust_pkg->bill);
1483 my $part_pkg = $cust_pkg->part_pkg;
1485 my %hash = $cust_pkg->hash;
1486 my $old_cust_pkg = new FS::cust_pkg \%hash;
1492 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1494 warn " bill setup\n" if $DEBUG;
1496 $setup = eval { $cust_pkg->calc_setup( $time ) };
1498 $dbh->rollback if $oldAutoCommit;
1502 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1508 if ( $part_pkg->getfield('freq') ne '0' &&
1509 ! $cust_pkg->getfield('susp') &&
1510 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1513 warn " bill recur\n" if $DEBUG;
1515 # XXX shared with $recur_prog
1516 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1518 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1520 $dbh->rollback if $oldAutoCommit;
1524 #change this bit to use Date::Manip? CAREFUL with timezones (see
1525 # mailing list archive)
1526 my ($sec,$min,$hour,$mday,$mon,$year) =
1527 (localtime($sdate) )[0,1,2,3,4,5];
1529 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1530 # only for figuring next bill date, nothing else, so, reset $sdate again
1532 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1533 $cust_pkg->last_bill($sdate)
1534 if $cust_pkg->dbdef_table->column('last_bill');
1536 if ( $part_pkg->freq =~ /^\d+$/ ) {
1537 $mon += $part_pkg->freq;
1538 until ( $mon < 12 ) { $mon -= 12; $year++; }
1539 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1541 $mday += $weeks * 7;
1542 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1546 $dbh->rollback if $oldAutoCommit;
1547 return "unparsable frequency: ". $part_pkg->freq;
1549 $cust_pkg->setfield('bill',
1550 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1553 warn "\$setup is undefined" unless defined($setup);
1554 warn "\$recur is undefined" unless defined($recur);
1555 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1557 if ( $cust_pkg->modified ) {
1559 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1561 $error=$cust_pkg->replace($old_cust_pkg);
1562 if ( $error ) { #just in case
1563 $dbh->rollback if $oldAutoCommit;
1564 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1567 $setup = sprintf( "%.2f", $setup );
1568 $recur = sprintf( "%.2f", $recur );
1569 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1570 $dbh->rollback if $oldAutoCommit;
1571 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1573 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1574 $dbh->rollback if $oldAutoCommit;
1575 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1577 if ( $setup != 0 || $recur != 0 ) {
1578 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1580 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1581 'pkgnum' => $cust_pkg->pkgnum,
1585 'edate' => $cust_pkg->bill,
1586 'details' => \@details,
1588 push @cust_bill_pkg, $cust_bill_pkg;
1589 $total_setup += $setup;
1590 $total_recur += $recur;
1592 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1594 my @taxes = qsearch( 'cust_main_county', {
1595 'state' => $self->state,
1596 'county' => $self->county,
1597 'country' => $self->country,
1598 'taxclass' => $part_pkg->taxclass,
1601 @taxes = qsearch( 'cust_main_county', {
1602 'state' => $self->state,
1603 'county' => $self->county,
1604 'country' => $self->country,
1609 #one more try at a whole-country tax rate
1611 @taxes = qsearch( 'cust_main_county', {
1614 'country' => $self->country,
1619 # maybe eliminate this entirely, along with all the 0% records
1621 $dbh->rollback if $oldAutoCommit;
1623 "fatal: can't find tax rate for state/county/country/taxclass ".
1624 join('/', ( map $self->$_(), qw(state county country) ),
1625 $part_pkg->taxclass ). "\n";
1628 foreach my $tax ( @taxes ) {
1630 my $taxable_charged = 0;
1631 $taxable_charged += $setup
1632 unless $part_pkg->setuptax =~ /^Y$/i
1633 || $tax->setuptax =~ /^Y$/i;
1634 $taxable_charged += $recur
1635 unless $part_pkg->recurtax =~ /^Y$/i
1636 || $tax->recurtax =~ /^Y$/i;
1637 next unless $taxable_charged;
1639 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1640 my ($mon,$year) = (localtime($sdate) )[4,5];
1642 my $freq = $part_pkg->freq || 1;
1643 if ( $freq !~ /(\d+)$/ ) {
1644 $dbh->rollback if $oldAutoCommit;
1645 return "daily/weekly package definitions not (yet?)".
1646 " compatible with monthly tax exemptions";
1648 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1649 foreach my $which_month ( 1 .. $freq ) {
1651 'custnum' => $self->custnum,
1652 'taxnum' => $tax->taxnum,
1653 'year' => 1900+$year,
1656 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1657 until ( $mon < 13 ) { $mon -= 12; $year++; }
1658 my $cust_tax_exempt =
1659 qsearchs('cust_tax_exempt', \%hash)
1660 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1661 my $remaining_exemption = sprintf("%.2f",
1662 $tax->exempt_amount - $cust_tax_exempt->amount );
1663 if ( $remaining_exemption > 0 ) {
1664 my $addl = $remaining_exemption > $taxable_per_month
1665 ? $taxable_per_month
1666 : $remaining_exemption;
1667 $taxable_charged -= $addl;
1668 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1669 $cust_tax_exempt->hash,
1671 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1673 $error = $new_cust_tax_exempt->exemptnum
1674 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1675 : $new_cust_tax_exempt->insert;
1677 $dbh->rollback if $oldAutoCommit;
1678 return "fatal: can't update cust_tax_exempt: $error";
1681 } # if $remaining_exemption > 0
1683 } #foreach $which_month
1685 } #if $tax->exempt_amount
1687 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1689 #$tax += $taxable_charged * $cust_main_county->tax / 100
1690 $tax{ $tax->taxname || 'Tax' } +=
1691 $taxable_charged * $tax->tax / 100
1693 } #foreach my $tax ( @taxes )
1695 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1697 } #if $setup != 0 || $recur != 0
1699 } #if $cust_pkg->modified
1701 } #foreach my $cust_pkg
1703 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1704 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1706 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1707 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1711 # unless ( $self->tax =~ /Y/i
1712 # || $self->payby eq 'COMP'
1713 # || $taxable_charged == 0 ) {
1714 # my $cust_main_county = qsearchs('cust_main_county',{
1715 # 'state' => $self->state,
1716 # 'county' => $self->county,
1717 # 'country' => $self->country,
1718 # } ) or die "fatal: can't find tax rate for state/county/country ".
1719 # $self->state. "/". $self->county. "/". $self->country. "\n";
1720 # my $tax = sprintf( "%.2f",
1721 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1724 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1726 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1727 my $tax = sprintf("%.2f", $tax{$taxname} );
1728 $charged = sprintf( "%.2f", $charged+$tax );
1730 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1736 'itemdesc' => $taxname,
1738 push @cust_bill_pkg, $cust_bill_pkg;
1741 } else { #1.4 schema
1744 foreach ( values %tax ) { $tax += $_ };
1745 $tax = sprintf("%.2f", $tax);
1747 $charged = sprintf( "%.2f", $charged+$tax );
1749 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1756 push @cust_bill_pkg, $cust_bill_pkg;
1761 my $cust_bill = new FS::cust_bill ( {
1762 'custnum' => $self->custnum,
1764 'charged' => $charged,
1766 $error = $cust_bill->insert;
1768 $dbh->rollback if $oldAutoCommit;
1769 return "can't create invoice for customer #". $self->custnum. ": $error";
1772 my $invnum = $cust_bill->invnum;
1774 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1776 $cust_bill_pkg->invnum($invnum);
1777 $error = $cust_bill_pkg->insert;
1779 $dbh->rollback if $oldAutoCommit;
1780 return "can't create invoice line item for customer #". $self->custnum.
1785 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1789 =item collect OPTIONS
1791 (Attempt to) collect money for this customer's outstanding invoices (see
1792 L<FS::cust_bill>). Usually used after the bill method.
1794 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1795 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1796 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1798 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1799 and the invoice events web interface.
1801 If there is an error, returns the error, otherwise returns false.
1803 Options are passed as name-value pairs.
1805 Currently available options are:
1807 invoice_time - Use this time when deciding when to print invoices and
1808 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>
1809 for conversion functions.
1811 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1814 retry_card - Deprecated alias for 'retry'
1816 batch_card - This option is deprecated. See the invoice events web interface
1817 to control whether cards are batched or run against a realtime gateway.
1819 report_badcard - This option is deprecated.
1821 force_print - This option is deprecated; see the invoice events web interface.
1823 quiet - set true to surpress email card/ACH decline notices.
1828 my( $self, %options ) = @_;
1829 my $invoice_time = $options{'invoice_time'} || time;
1832 local $SIG{HUP} = 'IGNORE';
1833 local $SIG{INT} = 'IGNORE';
1834 local $SIG{QUIT} = 'IGNORE';
1835 local $SIG{TERM} = 'IGNORE';
1836 local $SIG{TSTP} = 'IGNORE';
1837 local $SIG{PIPE} = 'IGNORE';
1839 my $oldAutoCommit = $FS::UID::AutoCommit;
1840 local $FS::UID::AutoCommit = 0;
1843 $self->select_for_update; #mutex
1845 my $balance = $self->balance;
1846 warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG;
1847 unless ( $balance > 0 ) { #redundant?????
1848 $dbh->rollback if $oldAutoCommit; #hmm
1852 if ( exists($options{'retry_card'}) ) {
1853 carp 'retry_card option passed to collect is deprecated; use retry';
1854 $options{'retry'} ||= $options{'retry_card'};
1856 if ( exists($options{'retry'}) && $options{'retry'} ) {
1857 my $error = $self->retry_realtime;
1859 $dbh->rollback if $oldAutoCommit;
1864 foreach my $cust_bill ( $self->open_cust_bill ) {
1866 # don't try to charge for the same invoice if it's already in a batch
1867 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1869 last if $self->balance <= 0;
1871 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
1874 foreach my $part_bill_event (
1875 sort { $a->seconds <=> $b->seconds
1876 || $a->weight <=> $b->weight
1877 || $a->eventpart <=> $b->eventpart }
1878 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1879 && ! qsearch( 'cust_bill_event', {
1880 'invnum' => $cust_bill->invnum,
1881 'eventpart' => $_->eventpart,
1885 qsearch('part_bill_event', { 'payby' => $self->payby,
1886 'disabled' => '', } )
1889 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
1890 || $self->balance <= 0; # or if balance<=0
1892 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1894 my $cust_main = $self; #for callback
1898 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1899 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1900 $error = eval $part_bill_event->eventcode;
1904 my $statustext = '';
1908 } elsif ( $error ) {
1910 $statustext = $error;
1915 #add cust_bill_event
1916 my $cust_bill_event = new FS::cust_bill_event {
1917 'invnum' => $cust_bill->invnum,
1918 'eventpart' => $part_bill_event->eventpart,
1919 #'_date' => $invoice_time,
1921 'status' => $status,
1922 'statustext' => $statustext,
1924 $error = $cust_bill_event->insert;
1926 #$dbh->rollback if $oldAutoCommit;
1927 #return "error: $error";
1929 # gah, even with transactions.
1930 $dbh->commit if $oldAutoCommit; #well.
1931 my $e = 'WARNING: Event run but database not updated - '.
1932 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1933 ', eventpart '. $part_bill_event->eventpart.
1944 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1949 =item retry_realtime
1951 Schedules realtime credit card / electronic check / LEC billing events for
1952 for retry. Useful if card information has changed or manual retry is desired.
1953 The 'collect' method must be called to actually retry the transaction.
1955 Implementation details: For each of this customer's open invoices, changes
1956 the status of the first "done" (with statustext error) realtime processing
1961 sub retry_realtime {
1964 local $SIG{HUP} = 'IGNORE';
1965 local $SIG{INT} = 'IGNORE';
1966 local $SIG{QUIT} = 'IGNORE';
1967 local $SIG{TERM} = 'IGNORE';
1968 local $SIG{TSTP} = 'IGNORE';
1969 local $SIG{PIPE} = 'IGNORE';
1971 my $oldAutoCommit = $FS::UID::AutoCommit;
1972 local $FS::UID::AutoCommit = 0;
1975 foreach my $cust_bill (
1976 grep { $_->cust_bill_event }
1977 $self->open_cust_bill
1979 my @cust_bill_event =
1980 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1982 #$_->part_bill_event->plan eq 'realtime-card'
1983 $_->part_bill_event->eventcode =~
1984 /\$cust_bill\->realtime_(card|ach|lec)/
1985 && $_->status eq 'done'
1988 $cust_bill->cust_bill_event;
1989 next unless @cust_bill_event;
1990 my $error = $cust_bill_event[0]->retry;
1992 $dbh->rollback if $oldAutoCommit;
1993 return "error scheduling invoice event for retry: $error";
1998 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2003 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2005 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2006 via a Business::OnlinePayment realtime gateway. See
2007 L<http://420.am/business-onlinepayment> for supported gateways.
2009 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2011 Available options are: I<description>, I<invnum>, I<quiet>
2013 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2014 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2015 if set, will override the value from the customer record.
2017 I<description> is a free-text field passed to the gateway. It defaults to
2018 "Internet services".
2020 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2021 specified invoice. If you don't specify an I<invnum> you might want to
2022 call the B<apply_payments> method.
2024 I<quiet> can be set true to surpress email decline notices.
2026 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2031 my( $self, $method, $amount, %options ) = @_;
2033 warn "$self $method $amount\n";
2034 warn " $_ => $options{$_}\n" foreach keys %options;
2037 $options{'description'} ||= 'Internet services';
2040 die "Real-time processing not enabled\n"
2041 unless $conf->exists('business-onlinepayment');
2042 eval "use Business::OnlinePayment";
2046 my $bop_config = 'business-onlinepayment';
2047 $bop_config .= '-ach'
2048 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2049 my ( $processor, $login, $password, $action, @bop_options ) =
2050 $conf->config($bop_config);
2051 $action ||= 'normal authorization';
2052 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2053 die "No real-time processor is enabled - ".
2054 "did you set the business-onlinepayment configuration value?\n"
2059 my $address = exists($options{'address1'})
2060 ? $options{'address1'}
2062 my $address2 = exists($options{'address2'})
2063 ? $options{'address2'}
2065 $address .= ", ". $address2 if length($address2);
2067 my $o_payname = exists($options{'payname'})
2068 ? $options{'payname'}
2070 my($payname, $payfirst, $paylast);
2071 if ( $o_payname && $method ne 'ECHECK' ) {
2072 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2073 or return "Illegal payname $payname";
2074 ($payfirst, $paylast) = ($1, $2);
2076 $payfirst = $self->getfield('first');
2077 $paylast = $self->getfield('last');
2078 $payname = "$payfirst $paylast";
2081 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2082 if ( $conf->exists('emailinvoiceauto')
2083 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2084 push @invoicing_list, $self->all_emails;
2087 my $email = ($conf->exists('business-onlinepayment-email-override'))
2088 ? $conf->config('business-onlinepayment-email-override')
2089 : $invoicing_list[0];
2091 my $payinfo = exists($options{'payinfo'})
2092 ? $options{'payinfo'}
2096 if ( $method eq 'CC' ) {
2098 $content{card_number} = $payinfo;
2099 my $paydate = exists($options{'paydate'})
2100 ? $options{'paydate'}
2102 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2103 $content{expiration} = "$2/$1";
2105 if ( defined $self->dbdef_table->column('paycvv') ) {
2106 my $paycvv = exists($options{'paycvv'})
2107 ? $options{'paycvv'}
2109 $content{cvv2} = $self->paycvv
2113 $content{recurring_billing} = 'YES'
2114 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2116 'payinfo' => $payinfo,
2119 } elsif ( $method eq 'ECHECK' ) {
2120 ( $content{account_number}, $content{routing_code} ) =
2121 split('@', $payinfo);
2122 $content{bank_name} = $o_payname;
2123 $content{account_type} = 'CHECKING';
2124 $content{account_name} = $payname;
2125 $content{customer_org} = $self->company ? 'B' : 'I';
2126 $content{customer_ssn} = exists($options{'ss'})
2129 } elsif ( $method eq 'LEC' ) {
2130 $content{phone} = $payinfo;
2135 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2137 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2138 $transaction->content(
2141 'password' => $password,
2142 'action' => $action1,
2143 'description' => $options{'description'},
2144 'amount' => $amount,
2145 'invoice_number' => $options{'invnum'},
2146 'customer_id' => $self->custnum,
2147 'last_name' => $paylast,
2148 'first_name' => $payfirst,
2150 'address' => $address,
2151 'city' => ( exists($options{'city'})
2154 'state' => ( exists($options{'state'})
2157 'zip' => ( exists($options{'zip'})
2160 'country' => ( exists($options{'country'})
2161 ? $options{'country'}
2163 'referer' => 'http://cleanwhisker.420.am/',
2165 'phone' => $self->daytime || $self->night,
2168 $transaction->submit();
2170 if ( $transaction->is_success() && $action2 ) {
2171 my $auth = $transaction->authorization;
2172 my $ordernum = $transaction->can('order_number')
2173 ? $transaction->order_number
2177 new Business::OnlinePayment( $processor, @bop_options );
2184 password => $password,
2185 order_number => $ordernum,
2187 authorization => $auth,
2188 description => $options{'description'},
2191 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2192 transaction_sequence_num local_transaction_date
2193 local_transaction_time AVS_result_code )) {
2194 $capture{$field} = $transaction->$field() if $transaction->can($field);
2197 $capture->content( %capture );
2201 unless ( $capture->is_success ) {
2202 my $e = "Authorization sucessful but capture failed, custnum #".
2203 $self->custnum. ': '. $capture->result_code.
2204 ": ". $capture->error_message;
2211 #remove paycvv after initial transaction
2212 #false laziness w/misc/process/payment.cgi - check both to make sure working
2214 if ( defined $self->dbdef_table->column('paycvv')
2215 && length($self->paycvv)
2216 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2218 my $error = $self->remove_cvv;
2220 warn "error removing cvv: $error\n";
2225 if ( $transaction->is_success() ) {
2227 my %method2payby = (
2233 my $paybatch = "$processor:". $transaction->authorization;
2234 $paybatch .= ':'. $transaction->order_number
2235 if $transaction->can('order_number')
2236 && length($transaction->order_number);
2238 my $cust_pay = new FS::cust_pay ( {
2239 'custnum' => $self->custnum,
2240 'invnum' => $options{'invnum'},
2243 'payby' => $method2payby{$method},
2244 'payinfo' => $payinfo,
2245 'paybatch' => $paybatch,
2247 my $error = $cust_pay->insert;
2249 $cust_pay->invnum(''); #try again with no specific invnum
2250 my $error2 = $cust_pay->insert;
2252 # gah, even with transactions.
2253 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2254 "error inserting payment ($processor): $error2".
2255 " (previously tried insert with invnum #$options{'invnum'}" .
2261 return ''; #no error
2265 my $perror = "$processor error: ". $transaction->error_message;
2267 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2268 && $conf->exists('emaildecline')
2269 && grep { $_ ne 'POST' } $self->invoicing_list
2270 && ! grep { $transaction->error_message =~ /$_/ }
2271 $conf->config('emaildecline-exclude')
2273 my @templ = $conf->config('declinetemplate');
2274 my $template = new Text::Template (
2276 SOURCE => [ map "$_\n", @templ ],
2277 ) or return "($perror) can't create template: $Text::Template::ERROR";
2278 $template->compile()
2279 or return "($perror) can't compile template: $Text::Template::ERROR";
2281 my $templ_hash = { error => $transaction->error_message };
2283 my $error = send_email(
2284 'from' => $conf->config('invoice_from'),
2285 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2286 'subject' => 'Your payment could not be processed',
2287 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2290 $perror .= " (also received error sending decline notification: $error)"
2302 Removes the I<paycvv> field from the database directly.
2304 If there is an error, returns the error, otherwise returns false.
2310 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2311 or return dbh->errstr;
2312 $sth->execute($self->custnum)
2313 or return $sth->errstr;
2318 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2320 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2321 via a Business::OnlinePayment realtime gateway. See
2322 L<http://420.am/business-onlinepayment> for supported gateways.
2324 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2326 Available options are: I<amount>, I<reason>, I<paynum>
2328 Most gateways require a reference to an original payment transaction to refund,
2329 so you probably need to specify a I<paynum>.
2331 I<amount> defaults to the original amount of the payment if not specified.
2333 I<reason> specifies a reason for the refund.
2335 Implementation note: If I<amount> is unspecified or equal to the amount of the
2336 orignal payment, first an attempt is made to "void" the transaction via
2337 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2338 the normal attempt is made to "refund" ("credit") the transaction via the
2339 gateway is attempted.
2341 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2342 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2343 #if set, will override the value from the customer record.
2345 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2346 #specified invoice. If you don't specify an I<invnum> you might want to
2347 #call the B<apply_payments> method.
2351 #some false laziness w/realtime_bop, not enough to make it worth merging
2352 #but some useful small subs should be pulled out
2353 sub realtime_refund_bop {
2354 my( $self, $method, %options ) = @_;
2356 warn "$self $method refund\n";
2357 warn " $_ => $options{$_}\n" foreach keys %options;
2361 die "Real-time processing not enabled\n"
2362 unless $conf->exists('business-onlinepayment');
2363 eval "use Business::OnlinePayment";
2367 my $bop_config = 'business-onlinepayment';
2368 $bop_config .= '-ach'
2369 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2370 my ( $processor, $login, $password, $unused_action, @bop_options ) =
2371 $conf->config($bop_config);
2372 #$action ||= 'normal authorization';
2373 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2374 die "No real-time processor is enabled - ".
2375 "did you set the business-onlinepayment configuration value?\n"
2379 my $amount = $options{'amount'};
2380 my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2381 if ( $options{'paynum'} ) {
2382 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2383 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2384 or return "Unknown paynum $options{'paynum'}";
2385 $amount ||= $cust_pay->paid;
2386 $cust_pay->paybatch =~ /^(\w+):([\w-]*)(:(\w+))?$/
2387 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2388 $cust_pay->paybatch;
2389 ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2390 return "processor of payment $options{'paynum'} $pay_processor does not".
2391 " match current processor $processor"
2392 unless $pay_processor eq $processor;
2394 return "neither amount nor paynum specified" unless $amount;
2399 'password' => $password,
2400 'order_number' => $order_number,
2401 'amount' => $amount,
2402 'referer' => 'http://cleanwhisker.420.am/',
2404 $content{authorization} = $auth
2405 if length($auth); #echeck/ACH transactions have an order # but no auth
2406 #(at least with authorize.net)
2408 #first try void if applicable
2409 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2410 warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2411 my $void = new Business::OnlinePayment( $processor, @bop_options );
2412 $void->content( 'action' => 'void', %content );
2414 if ( $void->is_success ) {
2415 my $error = $cust_pay->void($options{'reason'});
2417 # gah, even with transactions.
2418 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2419 "error voiding payment: $error";
2423 warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2428 warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2432 my $address = $self->address1;
2433 $address .= ", ". $self->address2 if $self->address2;
2435 my($payname, $payfirst, $paylast);
2436 if ( $self->payname && $method ne 'ECHECK' ) {
2437 $payname = $self->payname;
2438 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2439 or return "Illegal payname $payname";
2440 ($payfirst, $paylast) = ($1, $2);
2442 $payfirst = $self->getfield('first');
2443 $paylast = $self->getfield('last');
2444 $payname = "$payfirst $paylast";
2448 if ( $method eq 'CC' ) {
2451 $content{card_number} = $payinfo = $cust_pay->payinfo;
2452 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2453 #$content{expiration} = "$2/$1";
2455 $content{card_number} = $payinfo = $self->payinfo;
2456 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2457 $content{expiration} = "$2/$1";
2460 } elsif ( $method eq 'ECHECK' ) {
2461 ( $content{account_number}, $content{routing_code} ) =
2462 split('@', $payinfo = $self->payinfo);
2463 $content{bank_name} = $self->payname;
2464 $content{account_type} = 'CHECKING';
2465 $content{account_name} = $payname;
2466 $content{customer_org} = $self->company ? 'B' : 'I';
2467 $content{customer_ssn} = $self->ss;
2468 } elsif ( $method eq 'LEC' ) {
2469 $content{phone} = $payinfo = $self->payinfo;
2473 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2474 my %sub_content = $refund->content(
2475 'action' => 'credit',
2476 'customer_id' => $self->custnum,
2477 'last_name' => $paylast,
2478 'first_name' => $payfirst,
2480 'address' => $address,
2481 'city' => $self->city,
2482 'state' => $self->state,
2483 'zip' => $self->zip,
2484 'country' => $self->country,
2487 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2491 return "$processor error: ". $refund->error_message
2492 unless $refund->is_success();
2494 my %method2payby = (
2500 my $paybatch = "$processor:". $refund->authorization;
2501 $paybatch .= ':'. $refund->order_number
2502 if $refund->can('order_number') && $refund->order_number;
2504 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2505 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2506 last unless @cust_bill_pay;
2507 my $cust_bill_pay = pop @cust_bill_pay;
2508 my $error = $cust_bill_pay->delete;
2512 my $cust_refund = new FS::cust_refund ( {
2513 'custnum' => $self->custnum,
2514 'paynum' => $options{'paynum'},
2515 'refund' => $amount,
2517 'payby' => $method2payby{$method},
2518 'payinfo' => $payinfo,
2519 'paybatch' => $paybatch,
2520 'reason' => $options{'reason'} || 'card or ACH refund',
2522 my $error = $cust_refund->insert;
2524 $cust_refund->paynum(''); #try again with no specific paynum
2525 my $error2 = $cust_refund->insert;
2527 # gah, even with transactions.
2528 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2529 "error inserting refund ($processor): $error2".
2530 " (previously tried insert with paynum #$options{'paynum'}" .
2543 Returns the total owed for this customer on all invoices
2544 (see L<FS::cust_bill/owed>).
2550 $self->total_owed_date(2145859200); #12/31/2037
2553 =item total_owed_date TIME
2555 Returns the total owed for this customer on all invoices with date earlier than
2556 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2557 see L<Time::Local> and L<Date::Parse> for conversion functions.
2561 sub total_owed_date {
2565 foreach my $cust_bill (
2566 grep { $_->_date <= $time }
2567 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2569 $total_bill += $cust_bill->owed;
2571 sprintf( "%.2f", $total_bill );
2574 =item apply_credits OPTION => VALUE ...
2576 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2577 to outstanding invoice balances in chronological order (or reverse
2578 chronological order if the I<order> option is set to B<newest>) and returns the
2579 value of any remaining unapplied credits available for refund (see
2580 L<FS::cust_refund>).
2588 return 0 unless $self->total_credited;
2590 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2591 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2593 my @invoices = $self->open_cust_bill;
2594 @invoices = sort { $b->_date <=> $a->_date } @invoices
2595 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2598 foreach my $cust_bill ( @invoices ) {
2601 if ( !defined($credit) || $credit->credited == 0) {
2602 $credit = pop @credits or last;
2605 if ($cust_bill->owed >= $credit->credited) {
2606 $amount=$credit->credited;
2608 $amount=$cust_bill->owed;
2611 my $cust_credit_bill = new FS::cust_credit_bill ( {
2612 'crednum' => $credit->crednum,
2613 'invnum' => $cust_bill->invnum,
2614 'amount' => $amount,
2616 my $error = $cust_credit_bill->insert;
2617 die $error if $error;
2619 redo if ($cust_bill->owed > 0);
2623 return $self->total_credited;
2626 =item apply_payments
2628 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2629 to outstanding invoice balances in chronological order.
2631 #and returns the value of any remaining unapplied payments.
2635 sub apply_payments {
2640 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2641 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2643 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2644 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2648 foreach my $cust_bill ( @invoices ) {
2651 if ( !defined($payment) || $payment->unapplied == 0 ) {
2652 $payment = pop @payments or last;
2655 if ( $cust_bill->owed >= $payment->unapplied ) {
2656 $amount = $payment->unapplied;
2658 $amount = $cust_bill->owed;
2661 my $cust_bill_pay = new FS::cust_bill_pay ( {
2662 'paynum' => $payment->paynum,
2663 'invnum' => $cust_bill->invnum,
2664 'amount' => $amount,
2666 my $error = $cust_bill_pay->insert;
2667 die $error if $error;
2669 redo if ( $cust_bill->owed > 0);
2673 return $self->total_unapplied_payments;
2676 =item total_credited
2678 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2679 customer. See L<FS::cust_credit/credited>.
2683 sub total_credited {
2685 my $total_credit = 0;
2686 foreach my $cust_credit ( qsearch('cust_credit', {
2687 'custnum' => $self->custnum,
2689 $total_credit += $cust_credit->credited;
2691 sprintf( "%.2f", $total_credit );
2694 =item total_unapplied_payments
2696 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2697 See L<FS::cust_pay/unapplied>.
2701 sub total_unapplied_payments {
2703 my $total_unapplied = 0;
2704 foreach my $cust_pay ( qsearch('cust_pay', {
2705 'custnum' => $self->custnum,
2707 $total_unapplied += $cust_pay->unapplied;
2709 sprintf( "%.2f", $total_unapplied );
2714 Returns the balance for this customer (total_owed minus total_credited
2715 minus total_unapplied_payments).
2722 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2726 =item balance_date TIME
2728 Returns the balance for this customer, only considering invoices with date
2729 earlier than TIME (total_owed_date minus total_credited minus
2730 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2731 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2740 $self->total_owed_date($time)
2741 - $self->total_credited
2742 - $self->total_unapplied_payments
2746 =item paydate_monthyear
2748 Returns a two-element list consisting of the month and year of this customer's
2749 paydate (credit card expiration date for CARD customers)
2753 sub paydate_monthyear {
2755 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2757 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2764 =item payinfo_masked
2766 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.
2768 Credit Cards - Mask all but the last four characters.
2769 Checks - Mask all but last 2 of account number and bank routing number.
2770 Others - Do nothing, return the unmasked string.
2774 sub payinfo_masked {
2776 return $self->paymask;
2779 =item invoicing_list [ ARRAYREF ]
2781 If an arguement is given, sets these email addresses as invoice recipients
2782 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2783 (except as warnings), so use check_invoicing_list first.
2785 Returns a list of email addresses (with svcnum entries expanded).
2787 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2788 check it without disturbing anything by passing nothing.
2790 This interface may change in the future.
2794 sub invoicing_list {
2795 my( $self, $arrayref ) = @_;
2797 my @cust_main_invoice;
2798 if ( $self->custnum ) {
2799 @cust_main_invoice =
2800 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2802 @cust_main_invoice = ();
2804 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2805 #warn $cust_main_invoice->destnum;
2806 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2807 #warn $cust_main_invoice->destnum;
2808 my $error = $cust_main_invoice->delete;
2809 warn $error if $error;
2812 if ( $self->custnum ) {
2813 @cust_main_invoice =
2814 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2816 @cust_main_invoice = ();
2818 my %seen = map { $_->address => 1 } @cust_main_invoice;
2819 foreach my $address ( @{$arrayref} ) {
2820 next if exists $seen{$address} && $seen{$address};
2821 $seen{$address} = 1;
2822 my $cust_main_invoice = new FS::cust_main_invoice ( {
2823 'custnum' => $self->custnum,
2826 my $error = $cust_main_invoice->insert;
2827 warn $error if $error;
2830 if ( $self->custnum ) {
2832 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2838 =item check_invoicing_list ARRAYREF
2840 Checks these arguements as valid input for the invoicing_list method. If there
2841 is an error, returns the error, otherwise returns false.
2845 sub check_invoicing_list {
2846 my( $self, $arrayref ) = @_;
2847 foreach my $address ( @{$arrayref} ) {
2849 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2850 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2853 my $cust_main_invoice = new FS::cust_main_invoice ( {
2854 'custnum' => $self->custnum,
2857 my $error = $self->custnum
2858 ? $cust_main_invoice->check
2859 : $cust_main_invoice->checkdest
2861 return $error if $error;
2866 =item set_default_invoicing_list
2868 Sets the invoicing list to all accounts associated with this customer,
2869 overwriting any previous invoicing list.
2873 sub set_default_invoicing_list {
2875 $self->invoicing_list($self->all_emails);
2880 Returns the email addresses of all accounts provisioned for this customer.
2887 foreach my $cust_pkg ( $self->all_pkgs ) {
2888 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2890 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2891 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2893 $list{$_}=1 foreach map { $_->email } @svc_acct;
2898 =item invoicing_list_addpost
2900 Adds postal invoicing to this customer. If this customer is already configured
2901 to receive postal invoices, does nothing.
2905 sub invoicing_list_addpost {
2907 return if grep { $_ eq 'POST' } $self->invoicing_list;
2908 my @invoicing_list = $self->invoicing_list;
2909 push @invoicing_list, 'POST';
2910 $self->invoicing_list(\@invoicing_list);
2913 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2915 Returns an array of customers referred by this customer (referral_custnum set
2916 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2917 customers referred by customers referred by this customer and so on, inclusive.
2918 The default behavior is DEPTH 1 (no recursion).
2922 sub referral_cust_main {
2924 my $depth = @_ ? shift : 1;
2925 my $exclude = @_ ? shift : {};
2928 map { $exclude->{$_->custnum}++; $_; }
2929 grep { ! $exclude->{ $_->custnum } }
2930 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2934 map { $_->referral_cust_main($depth-1, $exclude) }
2941 =item referral_cust_main_ncancelled
2943 Same as referral_cust_main, except only returns customers with uncancelled
2948 sub referral_cust_main_ncancelled {
2950 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2953 =item referral_cust_pkg [ DEPTH ]
2955 Like referral_cust_main, except returns a flat list of all unsuspended (and
2956 uncancelled) packages for each customer. The number of items in this list may
2957 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2961 sub referral_cust_pkg {
2963 my $depth = @_ ? shift : 1;
2965 map { $_->unsuspended_pkgs }
2966 grep { $_->unsuspended_pkgs }
2967 $self->referral_cust_main($depth);
2970 =item referring_cust_main
2972 Returns the single cust_main record for the customer who referred this customer
2973 (referral_custnum), or false.
2977 sub referring_cust_main {
2979 return '' unless $self->referral_custnum;
2980 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2983 =item credit AMOUNT, REASON
2985 Applies a credit to this customer. If there is an error, returns the error,
2986 otherwise returns false.
2991 my( $self, $amount, $reason ) = @_;
2992 my $cust_credit = new FS::cust_credit {
2993 'custnum' => $self->custnum,
2994 'amount' => $amount,
2995 'reason' => $reason,
2997 $cust_credit->insert;
3000 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3002 Creates a one-time charge for this customer. If there is an error, returns
3003 the error, otherwise returns false.
3008 my ( $self, $amount ) = ( shift, shift );
3009 my $pkg = @_ ? shift : 'One-time charge';
3010 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3011 my $taxclass = @_ ? shift : '';
3013 local $SIG{HUP} = 'IGNORE';
3014 local $SIG{INT} = 'IGNORE';
3015 local $SIG{QUIT} = 'IGNORE';
3016 local $SIG{TERM} = 'IGNORE';
3017 local $SIG{TSTP} = 'IGNORE';
3018 local $SIG{PIPE} = 'IGNORE';
3020 my $oldAutoCommit = $FS::UID::AutoCommit;
3021 local $FS::UID::AutoCommit = 0;
3024 my $part_pkg = new FS::part_pkg ( {
3026 'comment' => $comment,
3027 #'setup' => $amount,
3030 'plandata' => "setup_fee=$amount",
3033 'taxclass' => $taxclass,
3036 my $error = $part_pkg->insert;
3038 $dbh->rollback if $oldAutoCommit;
3042 my $pkgpart = $part_pkg->pkgpart;
3043 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3044 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3045 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3046 $error = $type_pkgs->insert;
3048 $dbh->rollback if $oldAutoCommit;
3053 my $cust_pkg = new FS::cust_pkg ( {
3054 'custnum' => $self->custnum,
3055 'pkgpart' => $pkgpart,
3058 $error = $cust_pkg->insert;
3060 $dbh->rollback if $oldAutoCommit;
3064 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3071 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3077 sort { $a->_date <=> $b->_date }
3078 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3081 =item open_cust_bill
3083 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3088 sub open_cust_bill {
3090 grep { $_->owed > 0 } $self->cust_bill;
3095 Returns all the credits (see L<FS::cust_credit>) for this customer.
3101 sort { $a->_date <=> $b->_date }
3102 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3107 Returns all the payments (see L<FS::cust_pay>) for this customer.
3113 sort { $a->_date <=> $b->_date }
3114 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3119 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3125 sort { $a->_date <=> $b->_date }
3126 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3132 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3138 sort { $a->_date <=> $b->_date }
3139 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3142 =item select_for_update
3144 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3149 sub select_for_update {
3151 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3156 Returns a name string for this customer, either "Company (Last, First)" or
3163 my $name = $self->get('last'). ', '. $self->first;
3164 $name = $self->company. " ($name)" if $self->company;
3170 Returns a status string for this customer, currently:
3174 =item prospect - No packages have ever been ordered
3176 =item active - One or more recurring packages is active
3178 =item suspended - All non-cancelled recurring packages are suspended
3180 =item cancelled - All recurring packages are cancelled
3188 for my $status (qw( prospect active suspended cancelled )) {
3189 my $method = $status.'_sql';
3190 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3191 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3192 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3193 return $status if $sth->fetchrow_arrayref->[0];
3199 Returns a hex triplet color string for this customer's status.
3204 'prospect' => '000000',
3205 'active' => '00CC00',
3206 'suspended' => 'FF9900',
3207 'cancelled' => 'FF0000',
3211 $statuscolor{$self->status};
3216 =head1 CLASS METHODS
3222 Returns an SQL expression identifying prospective cust_main records (customers
3223 with no packages ever ordered)
3227 sub prospect_sql { "
3228 0 = ( SELECT COUNT(*) FROM cust_pkg
3229 WHERE cust_pkg.custnum = cust_main.custnum
3235 Returns an SQL expression identifying active cust_main records.
3239 my $recurring_sql = "
3240 '0' != ( select freq from part_pkg
3241 where cust_pkg.pkgpart = part_pkg.pkgpart )
3245 0 < ( SELECT COUNT(*) FROM cust_pkg
3246 WHERE cust_pkg.custnum = cust_main.custnum
3248 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3249 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3256 Returns an SQL expression identifying suspended cust_main records.
3260 sub suspended_sql { susp_sql(@_); }
3262 0 < ( SELECT COUNT(*) FROM cust_pkg
3263 WHERE cust_pkg.custnum = cust_main.custnum
3265 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3267 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3268 WHERE cust_pkg.custnum = cust_main.custnum
3270 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3271 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3278 Returns an SQL expression identifying cancelled cust_main records.
3282 sub cancelled_sql { cancel_sql(@_); }
3284 0 < ( SELECT COUNT(*) FROM cust_pkg
3285 WHERE cust_pkg.custnum = cust_main.custnum
3287 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3288 WHERE cust_pkg.custnum = cust_main.custnum
3290 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3294 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3296 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3297 records. Currently, only I<last> or I<company> may be specified (the
3298 appropriate ship_ field is also searched if applicable).
3300 Additional options are the same as FS::Record::qsearch
3305 my( $self, $fuzzy, $hash, @opt) = @_;
3310 check_and_rebuild_fuzzyfiles();
3311 foreach my $field ( keys %$fuzzy ) {
3312 my $sub = \&{"all_$field"};
3314 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3316 foreach ( keys %match ) {
3317 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3318 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3319 if defined dbdef->table('cust_main')->column('ship_last');
3324 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3336 =item smart_search OPTION => VALUE ...
3338 Accepts the following options: I<search>, the string to search for. The string
3339 will be searched for as a customer number, last name or company name, first
3340 searching for an exact match then fuzzy and substring matches.
3342 Any additional options treated as an additional qualifier on the search
3345 Returns a (possibly empty) array of FS::cust_main objects.
3351 my $search = delete $options{'search'};
3354 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3356 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3358 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3361 my $q_value = dbh->quote($value);
3364 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3365 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3366 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3367 if defined dbdef->table('cust_main')->column('ship_last');
3370 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3372 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3374 #still some false laziness w/ search/cust_main.cgi
3377 push @cust_main, qsearch( 'cust_main',
3378 { 'last' => { 'op' => 'ILIKE',
3379 'value' => "%$q_value%" },
3383 push @cust_main, qsearch( 'cust_main',
3384 { 'ship_last' => { 'op' => 'ILIKE',
3385 'value' => "%$q_value%" },
3390 if defined dbdef->table('cust_main')->column('ship_last');
3392 push @cust_main, qsearch( 'cust_main',
3393 { 'company' => { 'op' => 'ILIKE',
3394 'value' => "%$q_value%" },
3398 push @cust_main, qsearch( 'cust_main',
3399 { 'ship_company' => { 'op' => 'ILIKE',
3400 'value' => "%$q_value%" },
3404 if defined dbdef->table('cust_main')->column('ship_last');
3407 push @cust_main, FS::cust_main->fuzzy_search(
3408 { 'last' => $value },
3411 push @cust_main, FS::cust_main->fuzzy_search(
3412 { 'company' => $value },
3424 =item check_and_rebuild_fuzzyfiles
3428 sub check_and_rebuild_fuzzyfiles {
3429 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3430 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3431 or &rebuild_fuzzyfiles;
3434 =item rebuild_fuzzyfiles
3438 sub rebuild_fuzzyfiles {
3440 use Fcntl qw(:flock);
3442 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3446 open(LASTLOCK,">>$dir/cust_main.last")
3447 or die "can't open $dir/cust_main.last: $!";
3448 flock(LASTLOCK,LOCK_EX)
3449 or die "can't lock $dir/cust_main.last: $!";
3451 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3453 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3454 if defined dbdef->table('cust_main')->column('ship_last');
3456 open (LASTCACHE,">$dir/cust_main.last.tmp")
3457 or die "can't open $dir/cust_main.last.tmp: $!";
3458 print LASTCACHE join("\n", @all_last), "\n";
3459 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3461 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3466 open(COMPANYLOCK,">>$dir/cust_main.company")
3467 or die "can't open $dir/cust_main.company: $!";
3468 flock(COMPANYLOCK,LOCK_EX)
3469 or die "can't lock $dir/cust_main.company: $!";
3471 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3473 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3474 if defined dbdef->table('cust_main')->column('ship_last');
3476 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3477 or die "can't open $dir/cust_main.company.tmp: $!";
3478 print COMPANYCACHE join("\n", @all_company), "\n";
3479 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3481 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3491 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3492 open(LASTCACHE,"<$dir/cust_main.last")
3493 or die "can't open $dir/cust_main.last: $!";
3494 my @array = map { chomp; $_; } <LASTCACHE>;
3504 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3505 open(COMPANYCACHE,"<$dir/cust_main.company")
3506 or die "can't open $dir/cust_main.last: $!";
3507 my @array = map { chomp; $_; } <COMPANYCACHE>;
3512 =item append_fuzzyfiles LASTNAME COMPANY
3516 sub append_fuzzyfiles {
3517 my( $last, $company ) = @_;
3519 &check_and_rebuild_fuzzyfiles;
3521 use Fcntl qw(:flock);
3523 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3527 open(LAST,">>$dir/cust_main.last")
3528 or die "can't open $dir/cust_main.last: $!";
3530 or die "can't lock $dir/cust_main.last: $!";
3532 print LAST "$last\n";
3535 or die "can't unlock $dir/cust_main.last: $!";
3541 open(COMPANY,">>$dir/cust_main.company")
3542 or die "can't open $dir/cust_main.company: $!";
3543 flock(COMPANY,LOCK_EX)
3544 or die "can't lock $dir/cust_main.company: $!";
3546 print COMPANY "$company\n";
3548 flock(COMPANY,LOCK_UN)
3549 or die "can't unlock $dir/cust_main.company: $!";
3563 #warn join('-',keys %$param);
3564 my $fh = $param->{filehandle};
3565 my $agentnum = $param->{agentnum};
3566 my $refnum = $param->{refnum};
3567 my $pkgpart = $param->{pkgpart};
3568 my @fields = @{$param->{fields}};
3570 eval "use Date::Parse;";
3572 eval "use Text::CSV_XS;";
3575 my $csv = new Text::CSV_XS;
3582 local $SIG{HUP} = 'IGNORE';
3583 local $SIG{INT} = 'IGNORE';
3584 local $SIG{QUIT} = 'IGNORE';
3585 local $SIG{TERM} = 'IGNORE';
3586 local $SIG{TSTP} = 'IGNORE';
3587 local $SIG{PIPE} = 'IGNORE';
3589 my $oldAutoCommit = $FS::UID::AutoCommit;
3590 local $FS::UID::AutoCommit = 0;
3593 #while ( $columns = $csv->getline($fh) ) {
3595 while ( defined($line=<$fh>) ) {
3597 $csv->parse($line) or do {
3598 $dbh->rollback if $oldAutoCommit;
3599 return "can't parse: ". $csv->error_input();
3602 my @columns = $csv->fields();
3603 #warn join('-',@columns);
3606 agentnum => $agentnum,
3608 country => $conf->config('countrydefault') || 'US',
3609 payby => 'BILL', #default
3610 paydate => '12/2037', #default
3612 my $billtime = time;
3613 my %cust_pkg = ( pkgpart => $pkgpart );
3614 foreach my $field ( @fields ) {
3615 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3616 #$cust_pkg{$1} = str2time( shift @$columns );
3617 if ( $1 eq 'setup' ) {
3618 $billtime = str2time(shift @columns);
3620 $cust_pkg{$1} = str2time( shift @columns );
3623 #$cust_main{$field} = shift @$columns;
3624 $cust_main{$field} = shift @columns;
3628 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3629 my $cust_main = new FS::cust_main ( \%cust_main );
3631 tie my %hash, 'Tie::RefHash'; #this part is important
3632 $hash{$cust_pkg} = [] if $pkgpart;
3633 my $error = $cust_main->insert( \%hash );
3636 $dbh->rollback if $oldAutoCommit;
3637 return "can't insert customer for $line: $error";
3640 #false laziness w/bill.cgi
3641 $error = $cust_main->bill( 'time' => $billtime );
3643 $dbh->rollback if $oldAutoCommit;
3644 return "can't bill customer for $line: $error";
3647 $cust_main->apply_payments;
3648 $cust_main->apply_credits;
3650 $error = $cust_main->collect();
3652 $dbh->rollback if $oldAutoCommit;
3653 return "can't collect customer for $line: $error";
3659 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3661 return "Empty file!" unless $imported;
3673 #warn join('-',keys %$param);
3674 my $fh = $param->{filehandle};
3675 my @fields = @{$param->{fields}};
3677 eval "use Date::Parse;";
3679 eval "use Text::CSV_XS;";
3682 my $csv = new Text::CSV_XS;
3689 local $SIG{HUP} = 'IGNORE';
3690 local $SIG{INT} = 'IGNORE';
3691 local $SIG{QUIT} = 'IGNORE';
3692 local $SIG{TERM} = 'IGNORE';
3693 local $SIG{TSTP} = 'IGNORE';
3694 local $SIG{PIPE} = 'IGNORE';
3696 my $oldAutoCommit = $FS::UID::AutoCommit;
3697 local $FS::UID::AutoCommit = 0;
3700 #while ( $columns = $csv->getline($fh) ) {
3702 while ( defined($line=<$fh>) ) {
3704 $csv->parse($line) or do {
3705 $dbh->rollback if $oldAutoCommit;
3706 return "can't parse: ". $csv->error_input();
3709 my @columns = $csv->fields();
3710 #warn join('-',@columns);
3713 foreach my $field ( @fields ) {
3714 $row{$field} = shift @columns;
3717 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3718 unless ( $cust_main ) {
3719 $dbh->rollback if $oldAutoCommit;
3720 return "unknown custnum $row{'custnum'}";
3723 if ( $row{'amount'} > 0 ) {
3724 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3726 $dbh->rollback if $oldAutoCommit;
3730 } elsif ( $row{'amount'} < 0 ) {
3731 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3734 $dbh->rollback if $oldAutoCommit;
3744 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3746 return "Empty file!" unless $imported;
3758 The delete method should possibly take an FS::cust_main object reference
3759 instead of a scalar customer number.
3761 Bill and collect options should probably be passed as references instead of a
3764 There should probably be a configuration file with a list of allowed credit
3767 No multiple currency support (probably a larger project than just this module).
3769 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3773 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3774 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3775 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.