4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
5 $import $skip_fuzzyfiles $ignore_expired_card );
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);";
17 use Digest::MD5 qw(md5_base64);
20 use String::Approx qw(amatch);
21 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( send_email );
25 use FS::Msgcat qw(gettext);
29 use FS::cust_bill_pkg;
31 use FS::cust_pay_void;
34 use FS::part_referral;
35 use FS::cust_main_county;
37 use FS::cust_main_invoice;
38 use FS::cust_credit_bill;
39 use FS::cust_bill_pay;
40 use FS::prepay_credit;
43 use FS::part_bill_event;
44 use FS::cust_bill_event;
45 use FS::cust_tax_exempt;
47 use FS::payment_gateway;
48 use FS::agent_payment_gateway;
51 @ISA = qw( FS::Record );
53 @EXPORT_OK = qw( smart_search );
55 $realtime_bop_decline_quiet = 0;
58 $me = '[FS::cust_main]';
62 $ignore_expired_card = 0;
64 @encrypted_fields = ('payinfo', 'paycvv');
66 #ask FS::UID to run this stuff for us later
67 #$FS::UID::callback{'FS::cust_main'} = sub {
68 install_callback FS::UID sub {
70 #yes, need it for stuff below (prolly should be cached)
75 my ( $hashref, $cache ) = @_;
76 if ( exists $hashref->{'pkgnum'} ) {
77 # #@{ $self->{'_pkgnum'} } = ();
78 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
79 $self->{'_pkgnum'} = $subcache;
80 #push @{ $self->{'_pkgnum'} },
81 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
87 FS::cust_main - Object methods for cust_main records
93 $record = new FS::cust_main \%hash;
94 $record = new FS::cust_main { 'column' => 'value' };
96 $error = $record->insert;
98 $error = $new_record->replace($old_record);
100 $error = $record->delete;
102 $error = $record->check;
104 @cust_pkg = $record->all_pkgs;
106 @cust_pkg = $record->ncancelled_pkgs;
108 @cust_pkg = $record->suspended_pkgs;
110 $error = $record->bill;
111 $error = $record->bill %options;
112 $error = $record->bill 'time' => $time;
114 $error = $record->collect;
115 $error = $record->collect %options;
116 $error = $record->collect 'invoice_time' => $time,
117 'batch_card' => 'yes',
118 'report_badcard' => 'yes',
123 An FS::cust_main object represents a customer. FS::cust_main inherits from
124 FS::Record. The following fields are currently supported:
128 =item custnum - primary key (assigned automatically for new customers)
130 =item agentnum - agent (see L<FS::agent>)
132 =item refnum - Advertising source (see L<FS::part_referral>)
138 =item ss - social security number (optional)
140 =item company - (optional)
144 =item address2 - (optional)
148 =item county - (optional, see L<FS::cust_main_county>)
150 =item state - (see L<FS::cust_main_county>)
154 =item country - (see L<FS::cust_main_county>)
156 =item daytime - phone (optional)
158 =item night - phone (optional)
160 =item fax - phone (optional)
162 =item ship_first - name
164 =item ship_last - name
166 =item ship_company - (optional)
170 =item ship_address2 - (optional)
174 =item ship_county - (optional, see L<FS::cust_main_county>)
176 =item ship_state - (see L<FS::cust_main_county>)
180 =item ship_country - (see L<FS::cust_main_county>)
182 =item ship_daytime - phone (optional)
184 =item ship_night - phone (optional)
186 =item ship_fax - phone (optional)
190 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>)
194 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
199 my($self,$payinfo) = @_;
200 if ( defined($payinfo) ) {
201 $self->paymask($payinfo);
202 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
204 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
212 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
216 =item paymask - Masked payment type
222 Mask all but the last four characters.
226 Mask all but last 2 of account number and bank routing number.
230 Do nothing, return the unmasked string.
239 # If it doesn't exist then generate it
240 my $paymask=$self->getfield('paymask');
241 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
242 $value = $self->payinfo;
245 if ( defined($value) && !$self->is_encrypted($value)) {
246 my $payinfo = $value;
247 my $payby = $self->payby;
248 if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
249 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
250 } elsif ($payby eq 'CHEK' ||
251 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
252 my( $account, $aba ) = split('@', $payinfo );
253 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
254 } else { # Tie up loose ends
257 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
258 } elsif (defined($value) && $self->is_encrypted($value)) {
264 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
266 =item paystart_month - start date month (maestro/solo cards only)
268 =item paystart_year - start date year (maestro/solo cards only)
270 =item payissue - issue number (maestro/solo cards only)
272 =item payname - name on card or billing name
274 =item payip - IP address from which payment information was received
276 =item tax - tax exempt, empty or `Y'
278 =item otaker - order taker (assigned automatically, see L<FS::UID>)
280 =item comments - comments (optional)
282 =item referral_custnum - referring customer number
292 Creates a new customer. To add the customer to the database, see L<"insert">.
294 Note that this stores the hash reference, not a distinct copy of the hash it
295 points to. You can ask the object for a copy with the I<hash> method.
299 sub table { 'cust_main'; }
301 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
303 Adds this customer to the database. If there is an error, returns the error,
304 otherwise returns false.
306 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
307 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
308 are inserted atomicly, or the transaction is rolled back. Passing an empty
309 hash reference is equivalent to not supplying this parameter. There should be
310 a better explanation of this, but until then, here's an example:
313 tie %hash, 'Tie::RefHash'; #this part is important
315 $cust_pkg => [ $svc_acct ],
318 $cust_main->insert( \%hash );
320 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
321 be set as the invoicing list (see L<"invoicing_list">). Errors return as
322 expected and rollback the entire transaction; it is not necessary to call
323 check_invoicing_list first. The invoicing_list is set after the records in the
324 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
325 invoicing_list destination to the newly-created svc_acct. Here's an example:
327 $cust_main->insert( {}, [ $email, 'POST' ] );
329 Currently available options are: I<depend_jobnum> and I<noexport>.
331 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
332 on the supplied jobnum (they will not run until the specific job completes).
333 This can be used to defer provisioning until some action completes (such
334 as running the customer's credit card sucessfully).
336 The I<noexport> option is deprecated. If I<noexport> is set true, no
337 provisioning jobs (exports) are scheduled. (You can schedule them later with
338 the B<reexport> method.)
344 my $cust_pkgs = @_ ? shift : {};
345 my $invoicing_list = @_ ? shift : '';
347 warn "FS::cust_main::insert called with options ".
348 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
351 local $SIG{HUP} = 'IGNORE';
352 local $SIG{INT} = 'IGNORE';
353 local $SIG{QUIT} = 'IGNORE';
354 local $SIG{TERM} = 'IGNORE';
355 local $SIG{TSTP} = 'IGNORE';
356 local $SIG{PIPE} = 'IGNORE';
358 my $oldAutoCommit = $FS::UID::AutoCommit;
359 local $FS::UID::AutoCommit = 0;
362 my $prepay_identifier = '';
363 my( $amount, $seconds ) = ( 0, 0 );
365 if ( $self->payby eq 'PREPAY' ) {
367 $self->payby('BILL');
368 $prepay_identifier = $self->payinfo;
371 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
373 $dbh->rollback if $oldAutoCommit;
374 #return "error applying prepaid card (transaction rolled back): $error";
378 $payby = 'PREP' if $amount;
380 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
383 $self->payby('BILL');
384 $amount = $self->paid;
388 my $error = $self->SUPER::insert;
390 $dbh->rollback if $oldAutoCommit;
391 #return "inserting cust_main record (transaction rolled back): $error";
396 if ( $invoicing_list ) {
397 $error = $self->check_invoicing_list( $invoicing_list );
399 $dbh->rollback if $oldAutoCommit;
400 return "checking invoicing_list (transaction rolled back): $error";
402 $self->invoicing_list( $invoicing_list );
406 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
408 $dbh->rollback if $oldAutoCommit;
413 $dbh->rollback if $oldAutoCommit;
414 return "No svc_acct record to apply pre-paid time";
418 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
420 $dbh->rollback if $oldAutoCommit;
421 return "inserting payment (transaction rolled back): $error";
427 unless ( $import || $skip_fuzzyfiles ) {
428 $error = $self->queue_fuzzyfiles_update;
430 $dbh->rollback if $oldAutoCommit;
431 return "updating fuzzy search cache: $error";
435 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
440 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
442 Like the insert method on an existing record, this method orders a package
443 and included services atomicaly. Pass a Tie::RefHash data structure to this
444 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
445 be a better explanation of this, but until then, here's an example:
448 tie %hash, 'Tie::RefHash'; #this part is important
450 $cust_pkg => [ $svc_acct ],
453 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
455 Services can be new, in which case they are inserted, or existing unaudited
456 services, in which case they are linked to the newly-created package.
458 Currently available options are: I<depend_jobnum> and I<noexport>.
460 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
461 on the supplied jobnum (they will not run until the specific job completes).
462 This can be used to defer provisioning until some action completes (such
463 as running the customer's credit card sucessfully).
465 The I<noexport> option is deprecated. If I<noexport> is set true, no
466 provisioning jobs (exports) are scheduled. (You can schedule them later with
467 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
468 on the cust_main object is not recommended, as existing services will also be
475 my $cust_pkgs = shift;
478 my %svc_options = ();
479 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
480 if exists $options{'depend_jobnum'};
481 warn "FS::cust_main::order_pkgs called with options ".
482 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
485 local $SIG{HUP} = 'IGNORE';
486 local $SIG{INT} = 'IGNORE';
487 local $SIG{QUIT} = 'IGNORE';
488 local $SIG{TERM} = 'IGNORE';
489 local $SIG{TSTP} = 'IGNORE';
490 local $SIG{PIPE} = 'IGNORE';
492 my $oldAutoCommit = $FS::UID::AutoCommit;
493 local $FS::UID::AutoCommit = 0;
496 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
498 foreach my $cust_pkg ( keys %$cust_pkgs ) {
499 $cust_pkg->custnum( $self->custnum );
500 my $error = $cust_pkg->insert;
502 $dbh->rollback if $oldAutoCommit;
503 return "inserting cust_pkg (transaction rolled back): $error";
505 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
506 if ( $svc_something->svcnum ) {
507 my $old_cust_svc = $svc_something->cust_svc;
508 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
509 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
510 $error = $new_cust_svc->replace($old_cust_svc);
512 $svc_something->pkgnum( $cust_pkg->pkgnum );
513 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
514 $svc_something->seconds( $svc_something->seconds + $$seconds );
517 $error = $svc_something->insert(%svc_options);
520 $dbh->rollback if $oldAutoCommit;
521 #return "inserting svc_ (transaction rolled back): $error";
527 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
531 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
533 Recharges this (existing) customer with the specified prepaid card (see
534 L<FS::prepay_credit>), specified either by I<identifier> or as an
535 FS::prepay_credit object. If there is an error, returns the error, otherwise
538 Optionally, two scalar references can be passed as well. They will have their
539 values filled in with the amount and number of seconds applied by this prepaid
544 sub recharge_prepay {
545 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
547 local $SIG{HUP} = 'IGNORE';
548 local $SIG{INT} = 'IGNORE';
549 local $SIG{QUIT} = 'IGNORE';
550 local $SIG{TERM} = 'IGNORE';
551 local $SIG{TSTP} = 'IGNORE';
552 local $SIG{PIPE} = 'IGNORE';
554 my $oldAutoCommit = $FS::UID::AutoCommit;
555 local $FS::UID::AutoCommit = 0;
558 my( $amount, $seconds ) = ( 0, 0 );
560 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
561 || $self->increment_seconds($seconds)
562 || $self->insert_cust_pay_prepay( $amount,
564 ? $prepay_credit->identifier
569 $dbh->rollback if $oldAutoCommit;
573 if ( defined($amountref) ) { $$amountref = $amount; }
574 if ( defined($secondsref) ) { $$secondsref = $seconds; }
576 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
581 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
583 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
584 specified either by I<identifier> or as an FS::prepay_credit object.
586 References to I<amount> and I<seconds> scalars should be passed as arguments
587 and will be incremented by the values of the prepaid card.
589 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
590 check or set this customer's I<agentnum>.
592 If there is an error, returns the error, otherwise returns false.
598 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
600 local $SIG{HUP} = 'IGNORE';
601 local $SIG{INT} = 'IGNORE';
602 local $SIG{QUIT} = 'IGNORE';
603 local $SIG{TERM} = 'IGNORE';
604 local $SIG{TSTP} = 'IGNORE';
605 local $SIG{PIPE} = 'IGNORE';
607 my $oldAutoCommit = $FS::UID::AutoCommit;
608 local $FS::UID::AutoCommit = 0;
611 unless ( ref($prepay_credit) ) {
613 my $identifier = $prepay_credit;
615 $prepay_credit = qsearchs(
617 { 'identifier' => $prepay_credit },
622 unless ( $prepay_credit ) {
623 $dbh->rollback if $oldAutoCommit;
624 return "Invalid prepaid card: ". $identifier;
629 if ( $prepay_credit->agentnum ) {
630 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
631 $dbh->rollback if $oldAutoCommit;
632 return "prepaid card not valid for agent ". $self->agentnum;
634 $self->agentnum($prepay_credit->agentnum);
637 my $error = $prepay_credit->delete;
639 $dbh->rollback if $oldAutoCommit;
640 return "removing prepay_credit (transaction rolled back): $error";
643 $$amountref += $prepay_credit->amount;
644 $$secondsref += $prepay_credit->seconds;
646 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
651 =item increment_seconds SECONDS
653 Updates this customer's single or primary account (see L<FS::svc_acct>) by
654 the specified number of seconds. If there is an error, returns the error,
655 otherwise returns false.
659 sub increment_seconds {
660 my( $self, $seconds ) = @_;
661 warn "$me increment_seconds called: $seconds seconds\n"
664 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
665 $self->ncancelled_pkgs;
668 return 'No packages with primary or single services found'.
669 ' to apply pre-paid time';
670 } elsif ( scalar(@cust_pkg) > 1 ) {
671 #maybe have a way to specify the package/account?
672 return 'Multiple packages found to apply pre-paid time';
675 my $cust_pkg = $cust_pkg[0];
676 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
680 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
683 return 'No account found to apply pre-paid time';
684 } elsif ( scalar(@cust_svc) > 1 ) {
685 return 'Multiple accounts found to apply pre-paid time';
688 my $svc_acct = $cust_svc[0]->svc_x;
689 warn " found service svcnum ". $svc_acct->pkgnum.
690 ' ('. $svc_acct->email. ")\n"
693 $svc_acct->increment_seconds($seconds);
697 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
699 Inserts a prepayment in the specified amount for this customer. An optional
700 second argument can specify the prepayment identifier for tracking purposes.
701 If there is an error, returns the error, otherwise returns false.
705 sub insert_cust_pay_prepay {
706 shift->insert_cust_pay('PREP', @_);
709 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
711 Inserts a cash payment in the specified amount for this customer. An optional
712 second argument can specify the payment identifier for tracking purposes.
713 If there is an error, returns the error, otherwise returns false.
717 sub insert_cust_pay_cash {
718 shift->insert_cust_pay('CASH', @_);
721 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
723 Inserts a Western Union payment in the specified amount for this customer. An
724 optional second argument can specify the prepayment identifier for tracking
725 purposes. If there is an error, returns the error, otherwise returns false.
729 sub insert_cust_pay_west {
730 shift->insert_cust_pay('WEST', @_);
733 sub insert_cust_pay {
734 my( $self, $payby, $amount ) = splice(@_, 0, 3);
735 my $payinfo = scalar(@_) ? shift : '';
737 my $cust_pay = new FS::cust_pay {
738 'custnum' => $self->custnum,
739 'paid' => sprintf('%.2f', $amount),
740 #'_date' => #date the prepaid card was purchased???
742 'payinfo' => $payinfo,
750 This method is deprecated. See the I<depend_jobnum> option to the insert and
751 order_pkgs methods for a better way to defer provisioning.
753 Re-schedules all exports by calling the B<reexport> method of all associated
754 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
755 otherwise returns false.
762 carp "warning: FS::cust_main::reexport is deprectated; ".
763 "use the depend_jobnum option to insert or order_pkgs to delay export";
765 local $SIG{HUP} = 'IGNORE';
766 local $SIG{INT} = 'IGNORE';
767 local $SIG{QUIT} = 'IGNORE';
768 local $SIG{TERM} = 'IGNORE';
769 local $SIG{TSTP} = 'IGNORE';
770 local $SIG{PIPE} = 'IGNORE';
772 my $oldAutoCommit = $FS::UID::AutoCommit;
773 local $FS::UID::AutoCommit = 0;
776 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
777 my $error = $cust_pkg->reexport;
779 $dbh->rollback if $oldAutoCommit;
784 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
789 =item delete NEW_CUSTNUM
791 This deletes the customer. If there is an error, returns the error, otherwise
794 This will completely remove all traces of the customer record. This is not
795 what you want when a customer cancels service; for that, cancel all of the
796 customer's packages (see L</cancel>).
798 If the customer has any uncancelled packages, you need to pass a new (valid)
799 customer number for those packages to be transferred to. Cancelled packages
800 will be deleted. Did I mention that this is NOT what you want when a customer
801 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
803 You can't delete a customer with invoices (see L<FS::cust_bill>),
804 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
805 refunds (see L<FS::cust_refund>).
812 local $SIG{HUP} = 'IGNORE';
813 local $SIG{INT} = 'IGNORE';
814 local $SIG{QUIT} = 'IGNORE';
815 local $SIG{TERM} = 'IGNORE';
816 local $SIG{TSTP} = 'IGNORE';
817 local $SIG{PIPE} = 'IGNORE';
819 my $oldAutoCommit = $FS::UID::AutoCommit;
820 local $FS::UID::AutoCommit = 0;
823 if ( $self->cust_bill ) {
824 $dbh->rollback if $oldAutoCommit;
825 return "Can't delete a customer with invoices";
827 if ( $self->cust_credit ) {
828 $dbh->rollback if $oldAutoCommit;
829 return "Can't delete a customer with credits";
831 if ( $self->cust_pay ) {
832 $dbh->rollback if $oldAutoCommit;
833 return "Can't delete a customer with payments";
835 if ( $self->cust_refund ) {
836 $dbh->rollback if $oldAutoCommit;
837 return "Can't delete a customer with refunds";
840 my @cust_pkg = $self->ncancelled_pkgs;
842 my $new_custnum = shift;
843 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
844 $dbh->rollback if $oldAutoCommit;
845 return "Invalid new customer number: $new_custnum";
847 foreach my $cust_pkg ( @cust_pkg ) {
848 my %hash = $cust_pkg->hash;
849 $hash{'custnum'} = $new_custnum;
850 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
851 my $error = $new_cust_pkg->replace($cust_pkg);
853 $dbh->rollback if $oldAutoCommit;
858 my @cancelled_cust_pkg = $self->all_pkgs;
859 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
860 my $error = $cust_pkg->delete;
862 $dbh->rollback if $oldAutoCommit;
867 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
868 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
870 my $error = $cust_main_invoice->delete;
872 $dbh->rollback if $oldAutoCommit;
877 my $error = $self->SUPER::delete;
879 $dbh->rollback if $oldAutoCommit;
883 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
888 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
890 Replaces the OLD_RECORD with this one in the database. If there is an error,
891 returns the error, otherwise returns false.
893 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
894 be set as the invoicing list (see L<"invoicing_list">). Errors return as
895 expected and rollback the entire transaction; it is not necessary to call
896 check_invoicing_list first. Here's an example:
898 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
907 local $SIG{HUP} = 'IGNORE';
908 local $SIG{INT} = 'IGNORE';
909 local $SIG{QUIT} = 'IGNORE';
910 local $SIG{TERM} = 'IGNORE';
911 local $SIG{TSTP} = 'IGNORE';
912 local $SIG{PIPE} = 'IGNORE';
914 # If the mask is blank then try to set it - if we can...
915 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
916 $self->paymask($self->payinfo);
919 # We absolutely have to have an old vs. new record to make this work.
920 if (!defined($old)) {
921 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
924 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
925 && $conf->config('users-allow_comp') ) {
926 return "You are not permitted to create complimentary accounts."
927 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
930 local($ignore_expired_card) = 1
931 if $old->payby =~ /^(CARD|DCRD)$/
932 && $self->payby =~ /^(CARD|DCRD)$/
933 && $old->payinfo eq $self->payinfo;
935 my $oldAutoCommit = $FS::UID::AutoCommit;
936 local $FS::UID::AutoCommit = 0;
939 my $error = $self->SUPER::replace($old);
942 $dbh->rollback if $oldAutoCommit;
946 if ( @param ) { # INVOICING_LIST_ARYREF
947 my $invoicing_list = shift @param;
948 $error = $self->check_invoicing_list( $invoicing_list );
950 $dbh->rollback if $oldAutoCommit;
953 $self->invoicing_list( $invoicing_list );
956 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
957 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
958 # card/check/lec info has changed, want to retry realtime_ invoice events
959 my $error = $self->retry_realtime;
961 $dbh->rollback if $oldAutoCommit;
966 unless ( $import || $skip_fuzzyfiles ) {
967 $error = $self->queue_fuzzyfiles_update;
969 $dbh->rollback if $oldAutoCommit;
970 return "updating fuzzy search cache: $error";
974 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
979 =item queue_fuzzyfiles_update
981 Used by insert & replace to update the fuzzy search cache
985 sub queue_fuzzyfiles_update {
988 local $SIG{HUP} = 'IGNORE';
989 local $SIG{INT} = 'IGNORE';
990 local $SIG{QUIT} = 'IGNORE';
991 local $SIG{TERM} = 'IGNORE';
992 local $SIG{TSTP} = 'IGNORE';
993 local $SIG{PIPE} = 'IGNORE';
995 my $oldAutoCommit = $FS::UID::AutoCommit;
996 local $FS::UID::AutoCommit = 0;
999 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1000 my $error = $queue->insert($self->getfield('last'), $self->company);
1002 $dbh->rollback if $oldAutoCommit;
1003 return "queueing job (transaction rolled back): $error";
1006 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1007 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1008 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1010 $dbh->rollback if $oldAutoCommit;
1011 return "queueing job (transaction rolled back): $error";
1015 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1022 Checks all fields to make sure this is a valid customer record. If there is
1023 an error, returns the error, otherwise returns false. Called by the insert
1024 and replace methods.
1031 #warn "BEFORE: \n". $self->_dump;
1034 $self->ut_numbern('custnum')
1035 || $self->ut_number('agentnum')
1036 || $self->ut_number('refnum')
1037 || $self->ut_name('last')
1038 || $self->ut_name('first')
1039 || $self->ut_textn('company')
1040 || $self->ut_text('address1')
1041 || $self->ut_textn('address2')
1042 || $self->ut_text('city')
1043 || $self->ut_textn('county')
1044 || $self->ut_textn('state')
1045 || $self->ut_country('country')
1046 || $self->ut_anything('comments')
1047 || $self->ut_numbern('referral_custnum')
1049 #barf. need message catalogs. i18n. etc.
1050 $error .= "Please select an advertising source."
1051 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1052 return $error if $error;
1054 return "Unknown agent"
1055 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1057 return "Unknown refnum"
1058 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1060 return "Unknown referring custnum: ". $self->referral_custnum
1061 unless ! $self->referral_custnum
1062 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1064 if ( $self->ss eq '' ) {
1069 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1070 or return "Illegal social security number: ". $self->ss;
1071 $self->ss("$1-$2-$3");
1075 # bad idea to disable, causes billing to fail because of no tax rates later
1076 # unless ( $import ) {
1077 unless ( qsearch('cust_main_county', {
1078 'country' => $self->country,
1081 return "Unknown state/county/country: ".
1082 $self->state. "/". $self->county. "/". $self->country
1083 unless qsearch('cust_main_county',{
1084 'state' => $self->state,
1085 'county' => $self->county,
1086 'country' => $self->country,
1092 $self->ut_phonen('daytime', $self->country)
1093 || $self->ut_phonen('night', $self->country)
1094 || $self->ut_phonen('fax', $self->country)
1095 || $self->ut_zip('zip', $self->country)
1097 return $error if $error;
1100 last first company address1 address2 city county state zip
1101 country daytime night fax
1104 if ( defined $self->dbdef_table->column('ship_last') ) {
1105 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1107 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1111 $self->ut_name('ship_last')
1112 || $self->ut_name('ship_first')
1113 || $self->ut_textn('ship_company')
1114 || $self->ut_text('ship_address1')
1115 || $self->ut_textn('ship_address2')
1116 || $self->ut_text('ship_city')
1117 || $self->ut_textn('ship_county')
1118 || $self->ut_textn('ship_state')
1119 || $self->ut_country('ship_country')
1121 return $error if $error;
1123 #false laziness with above
1124 unless ( qsearchs('cust_main_county', {
1125 'country' => $self->ship_country,
1128 return "Unknown ship_state/ship_county/ship_country: ".
1129 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1130 unless qsearch('cust_main_county',{
1131 'state' => $self->ship_state,
1132 'county' => $self->ship_county,
1133 'country' => $self->ship_country,
1139 $self->ut_phonen('ship_daytime', $self->ship_country)
1140 || $self->ut_phonen('ship_night', $self->ship_country)
1141 || $self->ut_phonen('ship_fax', $self->ship_country)
1142 || $self->ut_zip('ship_zip', $self->ship_country)
1144 return $error if $error;
1146 } else { # ship_ info eq billing info, so don't store dup info in database
1147 $self->setfield("ship_$_", '')
1148 foreach qw( last first company address1 address2 city county state zip
1149 country daytime night fax );
1153 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1154 or return "Illegal payby: ". $self->payby;
1156 $error = $self->ut_numbern('paystart_month')
1157 || $self->ut_numbern('paystart_year')
1158 || $self->ut_numbern('payissue')
1160 return $error if $error;
1162 if ( $self->payip eq '' ) {
1165 $error = $self->ut_ip('payip');
1166 return $error if $error;
1169 # If it is encrypted and the private key is not availaible then we can't
1170 # check the credit card.
1172 my $check_payinfo = 1;
1174 if ($self->is_encrypted($self->payinfo)) {
1180 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1182 my $payinfo = $self->payinfo;
1183 $payinfo =~ s/\D//g;
1184 $payinfo =~ /^(\d{13,16})$/
1185 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1187 $self->payinfo($payinfo);
1189 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1191 return gettext('unknown_card_type')
1192 if cardtype($self->payinfo) eq "Unknown";
1194 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1195 return "Banned credit card" if $ban;
1197 if ( defined $self->dbdef_table->column('paycvv') ) {
1198 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1199 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1200 $self->paycvv =~ /^(\d{4})$/
1201 or return "CVV2 (CID) for American Express cards is four digits.";
1204 $self->paycvv =~ /^(\d{3})$/
1205 or return "CVV2 (CVC2/CID) is three digits.";
1213 my $cardtype = cardtype($payinfo);
1214 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1216 return "Start date or issue number is required for $cardtype cards"
1217 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1219 return "Start month must be between 1 and 12"
1220 if $self->paystart_month
1221 and $self->paystart_month < 1 || $self->paystart_month > 12;
1223 return "Start year must be 1990 or later"
1224 if $self->paystart_year
1225 and $self->paystart_year < 1990;
1227 return "Issue number must be beween 1 and 99"
1229 and $self->payissue < 1 || $self->payissue > 99;
1232 $self->paystart_month('');
1233 $self->paystart_year('');
1234 $self->payissue('');
1237 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1239 my $payinfo = $self->payinfo;
1240 $payinfo =~ s/[^\d\@]//g;
1241 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1242 $payinfo = "$1\@$2";
1243 $self->payinfo($payinfo);
1244 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1246 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1247 return "Banned ACH account" if $ban;
1249 } elsif ( $self->payby eq 'LECB' ) {
1251 my $payinfo = $self->payinfo;
1252 $payinfo =~ s/\D//g;
1253 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1255 $self->payinfo($payinfo);
1256 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1258 } elsif ( $self->payby eq 'BILL' ) {
1260 $error = $self->ut_textn('payinfo');
1261 return "Illegal P.O. number: ". $self->payinfo if $error;
1262 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1264 } elsif ( $self->payby eq 'COMP' ) {
1266 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1267 return "You are not permitted to create complimentary accounts."
1268 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1271 $error = $self->ut_textn('payinfo');
1272 return "Illegal comp account issuer: ". $self->payinfo if $error;
1273 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1275 } elsif ( $self->payby eq 'PREPAY' ) {
1277 my $payinfo = $self->payinfo;
1278 $payinfo =~ s/\W//g; #anything else would just confuse things
1279 $self->payinfo($payinfo);
1280 $error = $self->ut_alpha('payinfo');
1281 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1282 return "Unknown prepayment identifier"
1283 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1284 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1288 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1289 return "Expriation date required"
1290 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1294 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1295 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1296 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1297 ( $m, $y ) = ( $3, "20$2" );
1299 return "Illegal expiration date: ". $self->paydate;
1301 $self->paydate("$y-$m-01");
1302 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1303 return gettext('expired_card')
1305 && !$ignore_expired_card
1306 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1309 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1310 ( ! $conf->exists('require_cardname')
1311 || $self->payby !~ /^(CARD|DCRD)$/ )
1313 $self->payname( $self->first. " ". $self->getfield('last') );
1315 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1316 or return gettext('illegal_name'). " payname: ". $self->payname;
1320 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1323 $self->otaker(getotaker) unless $self->otaker;
1325 #warn "AFTER: \n". $self->_dump;
1327 $self->SUPER::check;
1332 Returns all packages (see L<FS::cust_pkg>) for this customer.
1338 if ( $self->{'_pkgnum'} ) {
1339 values %{ $self->{'_pkgnum'}->cache };
1341 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1345 =item ncancelled_pkgs
1347 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1351 sub ncancelled_pkgs {
1353 if ( $self->{'_pkgnum'} ) {
1354 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1356 @{ [ # force list context
1357 qsearch( 'cust_pkg', {
1358 'custnum' => $self->custnum,
1361 qsearch( 'cust_pkg', {
1362 'custnum' => $self->custnum,
1369 =item suspended_pkgs
1371 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1375 sub suspended_pkgs {
1377 grep { $_->susp } $self->ncancelled_pkgs;
1380 =item unflagged_suspended_pkgs
1382 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1383 customer (thouse packages without the `manual_flag' set).
1387 sub unflagged_suspended_pkgs {
1389 return $self->suspended_pkgs
1390 unless dbdef->table('cust_pkg')->column('manual_flag');
1391 grep { ! $_->manual_flag } $self->suspended_pkgs;
1394 =item unsuspended_pkgs
1396 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1401 sub unsuspended_pkgs {
1403 grep { ! $_->susp } $self->ncancelled_pkgs;
1406 =item num_cancelled_pkgs
1408 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1413 sub num_cancelled_pkgs {
1415 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1419 my( $self, $sql ) = @_;
1420 my $sth = dbh->prepare(
1421 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1422 ) or die dbh->errstr;
1423 $sth->execute($self->custnum) or die $sth->errstr;
1424 $sth->fetchrow_arrayref->[0];
1429 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1430 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1431 on success or a list of errors.
1437 grep { $_->unsuspend } $self->suspended_pkgs;
1442 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1443 Always returns a list: an empty list on success or a list of errors.
1449 grep { $_->suspend } $self->unsuspended_pkgs;
1452 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1454 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1455 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1456 success or a list of errors.
1460 sub suspend_if_pkgpart {
1463 grep { $_->suspend }
1464 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1465 $self->unsuspended_pkgs;
1468 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1470 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1471 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1472 on success or a list of errors.
1476 sub suspend_unless_pkgpart {
1479 grep { $_->suspend }
1480 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1481 $self->unsuspended_pkgs;
1484 =item cancel [ OPTION => VALUE ... ]
1486 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1488 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1490 I<quiet> can be set true to supress email cancellation notices.
1492 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1494 I<ban> can be set true to ban this customer's credit card or ACH information,
1497 Always returns a list: an empty list on success or a list of errors.
1505 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1507 #should try decryption (we might have the private key)
1508 # and if not maybe queue a job for the server that does?
1509 return ( "Can't (yet) ban encrypted credit cards" )
1510 if $self->is_encrypted($self->payinfo);
1512 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1513 my $error = $ban->insert;
1514 return ( $error ) if $error;
1518 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1521 sub _banned_pay_hashref {
1532 'payby' => $payby2ban{$self->payby},
1533 'payinfo' => md5_base64($self->payinfo),
1540 Returns the agent (see L<FS::agent>) for this customer.
1546 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1551 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1552 conjunction with the collect method.
1554 Options are passed as name-value pairs.
1556 Currently available options are:
1558 resetup - if set true, re-charges setup fees.
1560 time - bills the customer as if it were that time. Specified as a UNIX
1561 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1562 L<Date::Parse> for conversion functions. For example:
1566 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1569 If there is an error, returns the error, otherwise returns false.
1574 my( $self, %options ) = @_;
1575 return '' if $self->payby eq 'COMP';
1576 warn "bill customer ". $self->custnum. "\n" if $DEBUG;
1578 my $time = $options{'time'} || time;
1583 local $SIG{HUP} = 'IGNORE';
1584 local $SIG{INT} = 'IGNORE';
1585 local $SIG{QUIT} = 'IGNORE';
1586 local $SIG{TERM} = 'IGNORE';
1587 local $SIG{TSTP} = 'IGNORE';
1588 local $SIG{PIPE} = 'IGNORE';
1590 my $oldAutoCommit = $FS::UID::AutoCommit;
1591 local $FS::UID::AutoCommit = 0;
1594 $self->select_for_update; #mutex
1596 # find the packages which are due for billing, find out how much they are
1597 # & generate invoice database.
1599 my( $total_setup, $total_recur ) = ( 0, 0 );
1600 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1601 my @cust_bill_pkg = ();
1603 #my $taxable_charged = 0;##
1608 foreach my $cust_pkg (
1609 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1612 #NO!! next if $cust_pkg->cancel;
1613 next if $cust_pkg->getfield('cancel');
1615 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
1617 #? to avoid use of uninitialized value errors... ?
1618 $cust_pkg->setfield('bill', '')
1619 unless defined($cust_pkg->bill);
1621 my $part_pkg = $cust_pkg->part_pkg;
1623 my %hash = $cust_pkg->hash;
1624 my $old_cust_pkg = new FS::cust_pkg \%hash;
1630 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1632 warn " bill setup\n" if $DEBUG;
1634 $setup = eval { $cust_pkg->calc_setup( $time ) };
1636 $dbh->rollback if $oldAutoCommit;
1640 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1646 if ( $part_pkg->getfield('freq') ne '0' &&
1647 ! $cust_pkg->getfield('susp') &&
1648 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1651 warn " bill recur\n" if $DEBUG;
1653 # XXX shared with $recur_prog
1654 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1656 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1658 $dbh->rollback if $oldAutoCommit;
1662 #change this bit to use Date::Manip? CAREFUL with timezones (see
1663 # mailing list archive)
1664 my ($sec,$min,$hour,$mday,$mon,$year) =
1665 (localtime($sdate) )[0,1,2,3,4,5];
1667 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1668 # only for figuring next bill date, nothing else, so, reset $sdate again
1670 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1671 $cust_pkg->last_bill($sdate)
1672 if $cust_pkg->dbdef_table->column('last_bill');
1674 if ( $part_pkg->freq =~ /^\d+$/ ) {
1675 $mon += $part_pkg->freq;
1676 until ( $mon < 12 ) { $mon -= 12; $year++; }
1677 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1679 $mday += $weeks * 7;
1680 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1683 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1687 $dbh->rollback if $oldAutoCommit;
1688 return "unparsable frequency: ". $part_pkg->freq;
1690 $cust_pkg->setfield('bill',
1691 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1694 warn "\$setup is undefined" unless defined($setup);
1695 warn "\$recur is undefined" unless defined($recur);
1696 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1698 if ( $cust_pkg->modified ) {
1700 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1702 $error=$cust_pkg->replace($old_cust_pkg);
1703 if ( $error ) { #just in case
1704 $dbh->rollback if $oldAutoCommit;
1705 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1708 $setup = sprintf( "%.2f", $setup );
1709 $recur = sprintf( "%.2f", $recur );
1710 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1711 $dbh->rollback if $oldAutoCommit;
1712 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1714 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1715 $dbh->rollback if $oldAutoCommit;
1716 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1718 if ( $setup != 0 || $recur != 0 ) {
1719 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1721 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1722 'pkgnum' => $cust_pkg->pkgnum,
1726 'edate' => $cust_pkg->bill,
1727 'details' => \@details,
1729 push @cust_bill_pkg, $cust_bill_pkg;
1730 $total_setup += $setup;
1731 $total_recur += $recur;
1733 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1735 my @taxes = qsearch( 'cust_main_county', {
1736 'state' => $self->state,
1737 'county' => $self->county,
1738 'country' => $self->country,
1739 'taxclass' => $part_pkg->taxclass,
1742 @taxes = qsearch( 'cust_main_county', {
1743 'state' => $self->state,
1744 'county' => $self->county,
1745 'country' => $self->country,
1750 #one more try at a whole-country tax rate
1752 @taxes = qsearch( 'cust_main_county', {
1755 'country' => $self->country,
1760 # maybe eliminate this entirely, along with all the 0% records
1762 $dbh->rollback if $oldAutoCommit;
1764 "fatal: can't find tax rate for state/county/country/taxclass ".
1765 join('/', ( map $self->$_(), qw(state county country) ),
1766 $part_pkg->taxclass ). "\n";
1769 foreach my $tax ( @taxes ) {
1771 my $taxable_charged = 0;
1772 $taxable_charged += $setup
1773 unless $part_pkg->setuptax =~ /^Y$/i
1774 || $tax->setuptax =~ /^Y$/i;
1775 $taxable_charged += $recur
1776 unless $part_pkg->recurtax =~ /^Y$/i
1777 || $tax->recurtax =~ /^Y$/i;
1778 next unless $taxable_charged;
1780 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1781 my ($mon,$year) = (localtime($sdate) )[4,5];
1783 my $freq = $part_pkg->freq || 1;
1784 if ( $freq !~ /(\d+)$/ ) {
1785 $dbh->rollback if $oldAutoCommit;
1786 return "daily/weekly package definitions not (yet?)".
1787 " compatible with monthly tax exemptions";
1789 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1790 foreach my $which_month ( 1 .. $freq ) {
1792 'custnum' => $self->custnum,
1793 'taxnum' => $tax->taxnum,
1794 'year' => 1900+$year,
1797 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1798 until ( $mon < 13 ) { $mon -= 12; $year++; }
1799 my $cust_tax_exempt =
1800 qsearchs('cust_tax_exempt', \%hash)
1801 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1802 my $remaining_exemption = sprintf("%.2f",
1803 $tax->exempt_amount - $cust_tax_exempt->amount );
1804 if ( $remaining_exemption > 0 ) {
1805 my $addl = $remaining_exemption > $taxable_per_month
1806 ? $taxable_per_month
1807 : $remaining_exemption;
1808 $taxable_charged -= $addl;
1809 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1810 $cust_tax_exempt->hash,
1812 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1814 $error = $new_cust_tax_exempt->exemptnum
1815 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1816 : $new_cust_tax_exempt->insert;
1818 $dbh->rollback if $oldAutoCommit;
1819 return "fatal: can't update cust_tax_exempt: $error";
1822 } # if $remaining_exemption > 0
1824 } #foreach $which_month
1826 } #if $tax->exempt_amount
1828 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1830 #$tax += $taxable_charged * $cust_main_county->tax / 100
1831 $tax{ $tax->taxname || 'Tax' } +=
1832 $taxable_charged * $tax->tax / 100
1834 } #foreach my $tax ( @taxes )
1836 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1838 } #if $setup != 0 || $recur != 0
1840 } #if $cust_pkg->modified
1842 } #foreach my $cust_pkg
1844 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1845 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1847 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1848 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1852 # unless ( $self->tax =~ /Y/i
1853 # || $self->payby eq 'COMP'
1854 # || $taxable_charged == 0 ) {
1855 # my $cust_main_county = qsearchs('cust_main_county',{
1856 # 'state' => $self->state,
1857 # 'county' => $self->county,
1858 # 'country' => $self->country,
1859 # } ) or die "fatal: can't find tax rate for state/county/country ".
1860 # $self->state. "/". $self->county. "/". $self->country. "\n";
1861 # my $tax = sprintf( "%.2f",
1862 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1865 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1867 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1868 my $tax = sprintf("%.2f", $tax{$taxname} );
1869 $charged = sprintf( "%.2f", $charged+$tax );
1871 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1877 'itemdesc' => $taxname,
1879 push @cust_bill_pkg, $cust_bill_pkg;
1882 } else { #1.4 schema
1885 foreach ( values %tax ) { $tax += $_ };
1886 $tax = sprintf("%.2f", $tax);
1888 $charged = sprintf( "%.2f", $charged+$tax );
1890 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1897 push @cust_bill_pkg, $cust_bill_pkg;
1902 my $cust_bill = new FS::cust_bill ( {
1903 'custnum' => $self->custnum,
1905 'charged' => $charged,
1907 $error = $cust_bill->insert;
1909 $dbh->rollback if $oldAutoCommit;
1910 return "can't create invoice for customer #". $self->custnum. ": $error";
1913 my $invnum = $cust_bill->invnum;
1915 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1917 $cust_bill_pkg->invnum($invnum);
1918 $error = $cust_bill_pkg->insert;
1920 $dbh->rollback if $oldAutoCommit;
1921 return "can't create invoice line item for customer #". $self->custnum.
1926 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1930 =item collect OPTIONS
1932 (Attempt to) collect money for this customer's outstanding invoices (see
1933 L<FS::cust_bill>). Usually used after the bill method.
1935 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1936 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1937 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1939 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1940 and the invoice events web interface.
1942 If there is an error, returns the error, otherwise returns false.
1944 Options are passed as name-value pairs.
1946 Currently available options are:
1948 invoice_time - Use this time when deciding when to print invoices and
1949 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>
1950 for conversion functions.
1952 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1955 retry_card - Deprecated alias for 'retry'
1957 batch_card - This option is deprecated. See the invoice events web interface
1958 to control whether cards are batched or run against a realtime gateway.
1960 report_badcard - This option is deprecated.
1962 force_print - This option is deprecated; see the invoice events web interface.
1964 quiet - set true to surpress email card/ACH decline notices.
1969 my( $self, %options ) = @_;
1970 my $invoice_time = $options{'invoice_time'} || time;
1973 local $SIG{HUP} = 'IGNORE';
1974 local $SIG{INT} = 'IGNORE';
1975 local $SIG{QUIT} = 'IGNORE';
1976 local $SIG{TERM} = 'IGNORE';
1977 local $SIG{TSTP} = 'IGNORE';
1978 local $SIG{PIPE} = 'IGNORE';
1980 my $oldAutoCommit = $FS::UID::AutoCommit;
1981 local $FS::UID::AutoCommit = 0;
1984 $self->select_for_update; #mutex
1986 my $balance = $self->balance;
1987 warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG;
1988 unless ( $balance > 0 ) { #redundant?????
1989 $dbh->rollback if $oldAutoCommit; #hmm
1993 if ( exists($options{'retry_card'}) ) {
1994 carp 'retry_card option passed to collect is deprecated; use retry';
1995 $options{'retry'} ||= $options{'retry_card'};
1997 if ( exists($options{'retry'}) && $options{'retry'} ) {
1998 my $error = $self->retry_realtime;
2000 $dbh->rollback if $oldAutoCommit;
2005 foreach my $cust_bill ( $self->open_cust_bill ) {
2007 # don't try to charge for the same invoice if it's already in a batch
2008 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2010 last if $self->balance <= 0;
2012 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2015 foreach my $part_bill_event (
2016 sort { $a->seconds <=> $b->seconds
2017 || $a->weight <=> $b->weight
2018 || $a->eventpart <=> $b->eventpart }
2019 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2020 && ! qsearch( 'cust_bill_event', {
2021 'invnum' => $cust_bill->invnum,
2022 'eventpart' => $_->eventpart,
2026 qsearch('part_bill_event', { 'payby' => $self->payby,
2027 'disabled' => '', } )
2030 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2031 || $self->balance <= 0; # or if balance<=0
2033 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
2035 my $cust_main = $self; #for callback
2039 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2040 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2041 $error = eval $part_bill_event->eventcode;
2045 my $statustext = '';
2049 } elsif ( $error ) {
2051 $statustext = $error;
2056 #add cust_bill_event
2057 my $cust_bill_event = new FS::cust_bill_event {
2058 'invnum' => $cust_bill->invnum,
2059 'eventpart' => $part_bill_event->eventpart,
2060 #'_date' => $invoice_time,
2062 'status' => $status,
2063 'statustext' => $statustext,
2065 $error = $cust_bill_event->insert;
2067 #$dbh->rollback if $oldAutoCommit;
2068 #return "error: $error";
2070 # gah, even with transactions.
2071 $dbh->commit if $oldAutoCommit; #well.
2072 my $e = 'WARNING: Event run but database not updated - '.
2073 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2074 ', eventpart '. $part_bill_event->eventpart.
2085 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2090 =item retry_realtime
2092 Schedules realtime credit card / electronic check / LEC billing events for
2093 for retry. Useful if card information has changed or manual retry is desired.
2094 The 'collect' method must be called to actually retry the transaction.
2096 Implementation details: For each of this customer's open invoices, changes
2097 the status of the first "done" (with statustext error) realtime processing
2102 sub retry_realtime {
2105 local $SIG{HUP} = 'IGNORE';
2106 local $SIG{INT} = 'IGNORE';
2107 local $SIG{QUIT} = 'IGNORE';
2108 local $SIG{TERM} = 'IGNORE';
2109 local $SIG{TSTP} = 'IGNORE';
2110 local $SIG{PIPE} = 'IGNORE';
2112 my $oldAutoCommit = $FS::UID::AutoCommit;
2113 local $FS::UID::AutoCommit = 0;
2116 foreach my $cust_bill (
2117 grep { $_->cust_bill_event }
2118 $self->open_cust_bill
2120 my @cust_bill_event =
2121 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2123 #$_->part_bill_event->plan eq 'realtime-card'
2124 $_->part_bill_event->eventcode =~
2125 /\$cust_bill\->realtime_(card|ach|lec)/
2126 && $_->status eq 'done'
2129 $cust_bill->cust_bill_event;
2130 next unless @cust_bill_event;
2131 my $error = $cust_bill_event[0]->retry;
2133 $dbh->rollback if $oldAutoCommit;
2134 return "error scheduling invoice event for retry: $error";
2139 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2144 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2146 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2147 via a Business::OnlinePayment realtime gateway. See
2148 L<http://420.am/business-onlinepayment> for supported gateways.
2150 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2152 Available options are: I<description>, I<invnum>, I<quiet>
2154 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2155 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2156 if set, will override the value from the customer record.
2158 I<description> is a free-text field passed to the gateway. It defaults to
2159 "Internet services".
2161 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2162 specified invoice. If you don't specify an I<invnum> you might want to
2163 call the B<apply_payments> method.
2165 I<quiet> can be set true to surpress email decline notices.
2167 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2172 my( $self, $method, $amount, %options ) = @_;
2174 warn "$self $method $amount\n";
2175 warn " $_ => $options{$_}\n" foreach keys %options;
2178 $options{'description'} ||= 'Internet services';
2180 eval "use Business::OnlinePayment";
2183 my $payinfo = exists($options{'payinfo'})
2184 ? $options{'payinfo'}
2192 if ( $options{'invnum'} ) {
2193 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2194 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2196 map { $_->part_pkg->taxclass }
2198 map { $_->cust_pkg }
2199 $cust_bill->cust_bill_pkg;
2200 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2201 #different taxclasses
2202 $taxclass = $taxclasses[0];
2206 #look for an agent gateway override first
2208 if ( $method eq 'CC' ) {
2209 $cardtype = cardtype($payinfo);
2210 } elsif ( $method eq 'ECHECK' ) {
2213 $cardtype = $method;
2217 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2218 cardtype => $cardtype,
2219 taxclass => $taxclass, } )
2220 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2222 taxclass => $taxclass, } )
2223 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2224 cardtype => $cardtype,
2226 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2228 taxclass => '', } );
2230 my $payment_gateway = '';
2231 my( $processor, $login, $password, $action, @bop_options );
2232 if ( $override ) { #use a payment gateway override
2234 $payment_gateway = $override->payment_gateway;
2236 $processor = $payment_gateway->gateway_module;
2237 $login = $payment_gateway->gateway_username;
2238 $password = $payment_gateway->gateway_password;
2239 $action = $payment_gateway->gateway_action;
2240 @bop_options = $payment_gateway->options;
2242 } else { #use the standard settings from the config
2244 ( $processor, $login, $password, $action, @bop_options ) =
2245 $self->default_payment_gateway($method);
2253 my $address = exists($options{'address1'})
2254 ? $options{'address1'}
2256 my $address2 = exists($options{'address2'})
2257 ? $options{'address2'}
2259 $address .= ", ". $address2 if length($address2);
2261 my $o_payname = exists($options{'payname'})
2262 ? $options{'payname'}
2264 my($payname, $payfirst, $paylast);
2265 if ( $o_payname && $method ne 'ECHECK' ) {
2266 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2267 or return "Illegal payname $payname";
2268 ($payfirst, $paylast) = ($1, $2);
2270 $payfirst = $self->getfield('first');
2271 $paylast = $self->getfield('last');
2272 $payname = "$payfirst $paylast";
2275 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2276 if ( $conf->exists('emailinvoiceauto')
2277 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2278 push @invoicing_list, $self->all_emails;
2281 my $email = ($conf->exists('business-onlinepayment-email-override'))
2282 ? $conf->config('business-onlinepayment-email-override')
2283 : $invoicing_list[0];
2287 my $payip = exists($options{'payip'})
2290 $content{customer_ip} = $payip
2293 if ( $method eq 'CC' ) {
2295 $content{card_number} = $payinfo;
2296 my $paydate = exists($options{'paydate'})
2297 ? $options{'paydate'}
2299 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2300 $content{expiration} = "$2/$1";
2302 my $paycvv = exists($options{'paycvv'})
2303 ? $options{'paycvv'}
2305 $content{cvv2} = $self->paycvv
2308 my $paystart_month = exists($options{'paystart_month'})
2309 ? $options{'paystart_month'}
2310 : $self->paystart_month;
2312 my $paystart_year = exists($options{'paystart_year'})
2313 ? $options{'paystart_year'}
2314 : $self->paystart_year;
2316 $content{card_start} = "$paystart_month/$paystart_year"
2317 if $paystart_month && $paystart_year;
2319 my $payissue = exists($options{'payissue'})
2320 ? $options{'payissue'}
2322 $content{issue_number} = $payissue if $payissue;
2324 $content{recurring_billing} = 'YES'
2325 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2327 'payinfo' => $payinfo,
2330 } elsif ( $method eq 'ECHECK' ) {
2331 ( $content{account_number}, $content{routing_code} ) =
2332 split('@', $payinfo);
2333 $content{bank_name} = $o_payname;
2334 $content{account_type} = 'CHECKING';
2335 $content{account_name} = $payname;
2336 $content{customer_org} = $self->company ? 'B' : 'I';
2337 $content{customer_ssn} = exists($options{'ss'})
2340 } elsif ( $method eq 'LEC' ) {
2341 $content{phone} = $payinfo;
2345 # run transaction(s)
2348 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2350 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2351 $transaction->content(
2354 'password' => $password,
2355 'action' => $action1,
2356 'description' => $options{'description'},
2357 'amount' => $amount,
2358 'invoice_number' => $options{'invnum'},
2359 'customer_id' => $self->custnum,
2360 'last_name' => $paylast,
2361 'first_name' => $payfirst,
2363 'address' => $address,
2364 'city' => ( exists($options{'city'})
2367 'state' => ( exists($options{'state'})
2370 'zip' => ( exists($options{'zip'})
2373 'country' => ( exists($options{'country'})
2374 ? $options{'country'}
2376 'referer' => 'http://cleanwhisker.420.am/',
2378 'phone' => $self->daytime || $self->night,
2381 $transaction->submit();
2383 if ( $transaction->is_success() && $action2 ) {
2384 my $auth = $transaction->authorization;
2385 my $ordernum = $transaction->can('order_number')
2386 ? $transaction->order_number
2390 new Business::OnlinePayment( $processor, @bop_options );
2397 password => $password,
2398 order_number => $ordernum,
2400 authorization => $auth,
2401 description => $options{'description'},
2404 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2405 transaction_sequence_num local_transaction_date
2406 local_transaction_time AVS_result_code )) {
2407 $capture{$field} = $transaction->$field() if $transaction->can($field);
2410 $capture->content( %capture );
2414 unless ( $capture->is_success ) {
2415 my $e = "Authorization sucessful but capture failed, custnum #".
2416 $self->custnum. ': '. $capture->result_code.
2417 ": ". $capture->error_message;
2425 # remove paycvv after initial transaction
2428 #false laziness w/misc/process/payment.cgi - check both to make sure working
2430 if ( defined $self->dbdef_table->column('paycvv')
2431 && length($self->paycvv)
2432 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2434 my $error = $self->remove_cvv;
2436 warn "error removing cvv: $error\n";
2444 if ( $transaction->is_success() ) {
2446 my %method2payby = (
2453 if ( $payment_gateway ) { # agent override
2454 $paybatch = $payment_gateway->gatewaynum. '-';
2457 $paybatch .= "$processor:". $transaction->authorization;
2459 $paybatch .= ':'. $transaction->order_number
2460 if $transaction->can('order_number')
2461 && length($transaction->order_number);
2463 my $cust_pay = new FS::cust_pay ( {
2464 'custnum' => $self->custnum,
2465 'invnum' => $options{'invnum'},
2468 'payby' => $method2payby{$method},
2469 'payinfo' => $payinfo,
2470 'paybatch' => $paybatch,
2472 my $error = $cust_pay->insert;
2474 $cust_pay->invnum(''); #try again with no specific invnum
2475 my $error2 = $cust_pay->insert;
2477 # gah, even with transactions.
2478 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2479 "error inserting payment ($processor): $error2".
2480 " (previously tried insert with invnum #$options{'invnum'}" .
2486 return ''; #no error
2490 my $perror = "$processor error: ". $transaction->error_message;
2492 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2493 && $conf->exists('emaildecline')
2494 && grep { $_ ne 'POST' } $self->invoicing_list
2495 && ! grep { $transaction->error_message =~ /$_/ }
2496 $conf->config('emaildecline-exclude')
2498 my @templ = $conf->config('declinetemplate');
2499 my $template = new Text::Template (
2501 SOURCE => [ map "$_\n", @templ ],
2502 ) or return "($perror) can't create template: $Text::Template::ERROR";
2503 $template->compile()
2504 or return "($perror) can't compile template: $Text::Template::ERROR";
2506 my $templ_hash = { error => $transaction->error_message };
2508 my $error = send_email(
2509 'from' => $conf->config('invoice_from'),
2510 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2511 'subject' => 'Your payment could not be processed',
2512 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2515 $perror .= " (also received error sending decline notification: $error)"
2525 =item default_payment_gateway
2529 sub default_payment_gateway {
2530 my( $self, $method ) = @_;
2532 die "Real-time processing not enabled\n"
2533 unless $conf->exists('business-onlinepayment');
2536 my $bop_config = 'business-onlinepayment';
2537 $bop_config .= '-ach'
2538 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2539 my ( $processor, $login, $password, $action, @bop_options ) =
2540 $conf->config($bop_config);
2541 $action ||= 'normal authorization';
2542 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2543 die "No real-time processor is enabled - ".
2544 "did you set the business-onlinepayment configuration value?\n"
2547 ( $processor, $login, $password, $action, @bop_options )
2552 Removes the I<paycvv> field from the database directly.
2554 If there is an error, returns the error, otherwise returns false.
2560 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2561 or return dbh->errstr;
2562 $sth->execute($self->custnum)
2563 or return $sth->errstr;
2568 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2570 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2571 via a Business::OnlinePayment realtime gateway. See
2572 L<http://420.am/business-onlinepayment> for supported gateways.
2574 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2576 Available options are: I<amount>, I<reason>, I<paynum>
2578 Most gateways require a reference to an original payment transaction to refund,
2579 so you probably need to specify a I<paynum>.
2581 I<amount> defaults to the original amount of the payment if not specified.
2583 I<reason> specifies a reason for the refund.
2585 Implementation note: If I<amount> is unspecified or equal to the amount of the
2586 orignal payment, first an attempt is made to "void" the transaction via
2587 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2588 the normal attempt is made to "refund" ("credit") the transaction via the
2589 gateway is attempted.
2591 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2592 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2593 #if set, will override the value from the customer record.
2595 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2596 #specified invoice. If you don't specify an I<invnum> you might want to
2597 #call the B<apply_payments> method.
2601 #some false laziness w/realtime_bop, not enough to make it worth merging
2602 #but some useful small subs should be pulled out
2603 sub realtime_refund_bop {
2604 my( $self, $method, %options ) = @_;
2606 warn "$self $method refund\n";
2607 warn " $_ => $options{$_}\n" foreach keys %options;
2610 eval "use Business::OnlinePayment";
2614 # look up the original payment and optionally a gateway for that payment
2618 my $amount = $options{'amount'};
2620 my( $processor, $login, $password, @bop_options ) ;
2621 my( $auth, $order_number ) = ( '', '', '' );
2623 if ( $options{'paynum'} ) {
2625 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2626 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2627 or return "Unknown paynum $options{'paynum'}";
2628 $amount ||= $cust_pay->paid;
2630 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2631 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2632 $cust_pay->paybatch;
2633 my $gatewaynum = '';
2634 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2636 if ( $gatewaynum ) { #gateway for the payment to be refunded
2638 my $payment_gateway =
2639 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2640 die "payment gateway $gatewaynum not found"
2641 unless $payment_gateway;
2643 $processor = $payment_gateway->gateway_module;
2644 $login = $payment_gateway->gateway_username;
2645 $password = $payment_gateway->gateway_password;
2646 @bop_options = $payment_gateway->options;
2648 } else { #try the default gateway
2650 my( $conf_processor, $unused_action );
2651 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2652 $self->default_payment_gateway($method);
2654 return "processor of payment $options{'paynum'} $processor does not".
2655 " match default processor $conf_processor"
2656 unless $processor eq $conf_processor;
2661 } else { # didn't specify a paynum, so look for agent gateway overrides
2662 # like a normal transaction
2665 if ( $method eq 'CC' ) {
2666 $cardtype = cardtype($self->payinfo);
2667 } elsif ( $method eq 'ECHECK' ) {
2670 $cardtype = $method;
2673 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2674 cardtype => $cardtype,
2676 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2678 taxclass => '', } );
2680 if ( $override ) { #use a payment gateway override
2682 my $payment_gateway = $override->payment_gateway;
2684 $processor = $payment_gateway->gateway_module;
2685 $login = $payment_gateway->gateway_username;
2686 $password = $payment_gateway->gateway_password;
2687 #$action = $payment_gateway->gateway_action;
2688 @bop_options = $payment_gateway->options;
2690 } else { #use the standard settings from the config
2693 ( $processor, $login, $password, $unused_action, @bop_options ) =
2694 $self->default_payment_gateway($method);
2699 return "neither amount nor paynum specified" unless $amount;
2704 'password' => $password,
2705 'order_number' => $order_number,
2706 'amount' => $amount,
2707 'referer' => 'http://cleanwhisker.420.am/',
2709 $content{authorization} = $auth
2710 if length($auth); #echeck/ACH transactions have an order # but no auth
2711 #(at least with authorize.net)
2713 #first try void if applicable
2714 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2715 warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2716 my $void = new Business::OnlinePayment( $processor, @bop_options );
2717 $void->content( 'action' => 'void', %content );
2719 if ( $void->is_success ) {
2720 my $error = $cust_pay->void($options{'reason'});
2722 # gah, even with transactions.
2723 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2724 "error voiding payment: $error";
2728 warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2733 warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2737 my $address = $self->address1;
2738 $address .= ", ". $self->address2 if $self->address2;
2740 my($payname, $payfirst, $paylast);
2741 if ( $self->payname && $method ne 'ECHECK' ) {
2742 $payname = $self->payname;
2743 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2744 or return "Illegal payname $payname";
2745 ($payfirst, $paylast) = ($1, $2);
2747 $payfirst = $self->getfield('first');
2748 $paylast = $self->getfield('last');
2749 $payname = "$payfirst $paylast";
2753 if ( $method eq 'CC' ) {
2756 $content{card_number} = $payinfo = $cust_pay->payinfo;
2757 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2758 #$content{expiration} = "$2/$1";
2760 $content{card_number} = $payinfo = $self->payinfo;
2761 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2762 $content{expiration} = "$2/$1";
2765 } elsif ( $method eq 'ECHECK' ) {
2766 ( $content{account_number}, $content{routing_code} ) =
2767 split('@', $payinfo = $self->payinfo);
2768 $content{bank_name} = $self->payname;
2769 $content{account_type} = 'CHECKING';
2770 $content{account_name} = $payname;
2771 $content{customer_org} = $self->company ? 'B' : 'I';
2772 $content{customer_ssn} = $self->ss;
2773 } elsif ( $method eq 'LEC' ) {
2774 $content{phone} = $payinfo = $self->payinfo;
2778 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2779 my %sub_content = $refund->content(
2780 'action' => 'credit',
2781 'customer_id' => $self->custnum,
2782 'last_name' => $paylast,
2783 'first_name' => $payfirst,
2785 'address' => $address,
2786 'city' => $self->city,
2787 'state' => $self->state,
2788 'zip' => $self->zip,
2789 'country' => $self->country,
2792 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2796 return "$processor error: ". $refund->error_message
2797 unless $refund->is_success();
2799 my %method2payby = (
2805 my $paybatch = "$processor:". $refund->authorization;
2806 $paybatch .= ':'. $refund->order_number
2807 if $refund->can('order_number') && $refund->order_number;
2809 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2810 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2811 last unless @cust_bill_pay;
2812 my $cust_bill_pay = pop @cust_bill_pay;
2813 my $error = $cust_bill_pay->delete;
2817 my $cust_refund = new FS::cust_refund ( {
2818 'custnum' => $self->custnum,
2819 'paynum' => $options{'paynum'},
2820 'refund' => $amount,
2822 'payby' => $method2payby{$method},
2823 'payinfo' => $payinfo,
2824 'paybatch' => $paybatch,
2825 'reason' => $options{'reason'} || 'card or ACH refund',
2827 my $error = $cust_refund->insert;
2829 $cust_refund->paynum(''); #try again with no specific paynum
2830 my $error2 = $cust_refund->insert;
2832 # gah, even with transactions.
2833 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2834 "error inserting refund ($processor): $error2".
2835 " (previously tried insert with paynum #$options{'paynum'}" .
2848 Returns the total owed for this customer on all invoices
2849 (see L<FS::cust_bill/owed>).
2855 $self->total_owed_date(2145859200); #12/31/2037
2858 =item total_owed_date TIME
2860 Returns the total owed for this customer on all invoices with date earlier than
2861 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2862 see L<Time::Local> and L<Date::Parse> for conversion functions.
2866 sub total_owed_date {
2870 foreach my $cust_bill (
2871 grep { $_->_date <= $time }
2872 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2874 $total_bill += $cust_bill->owed;
2876 sprintf( "%.2f", $total_bill );
2879 =item apply_credits OPTION => VALUE ...
2881 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2882 to outstanding invoice balances in chronological order (or reverse
2883 chronological order if the I<order> option is set to B<newest>) and returns the
2884 value of any remaining unapplied credits available for refund (see
2885 L<FS::cust_refund>).
2893 return 0 unless $self->total_credited;
2895 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2896 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2898 my @invoices = $self->open_cust_bill;
2899 @invoices = sort { $b->_date <=> $a->_date } @invoices
2900 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2903 foreach my $cust_bill ( @invoices ) {
2906 if ( !defined($credit) || $credit->credited == 0) {
2907 $credit = pop @credits or last;
2910 if ($cust_bill->owed >= $credit->credited) {
2911 $amount=$credit->credited;
2913 $amount=$cust_bill->owed;
2916 my $cust_credit_bill = new FS::cust_credit_bill ( {
2917 'crednum' => $credit->crednum,
2918 'invnum' => $cust_bill->invnum,
2919 'amount' => $amount,
2921 my $error = $cust_credit_bill->insert;
2922 die $error if $error;
2924 redo if ($cust_bill->owed > 0);
2928 return $self->total_credited;
2931 =item apply_payments
2933 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2934 to outstanding invoice balances in chronological order.
2936 #and returns the value of any remaining unapplied payments.
2940 sub apply_payments {
2945 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2946 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2948 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2949 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2953 foreach my $cust_bill ( @invoices ) {
2956 if ( !defined($payment) || $payment->unapplied == 0 ) {
2957 $payment = pop @payments or last;
2960 if ( $cust_bill->owed >= $payment->unapplied ) {
2961 $amount = $payment->unapplied;
2963 $amount = $cust_bill->owed;
2966 my $cust_bill_pay = new FS::cust_bill_pay ( {
2967 'paynum' => $payment->paynum,
2968 'invnum' => $cust_bill->invnum,
2969 'amount' => $amount,
2971 my $error = $cust_bill_pay->insert;
2972 die $error if $error;
2974 redo if ( $cust_bill->owed > 0);
2978 return $self->total_unapplied_payments;
2981 =item total_credited
2983 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2984 customer. See L<FS::cust_credit/credited>.
2988 sub total_credited {
2990 my $total_credit = 0;
2991 foreach my $cust_credit ( qsearch('cust_credit', {
2992 'custnum' => $self->custnum,
2994 $total_credit += $cust_credit->credited;
2996 sprintf( "%.2f", $total_credit );
2999 =item total_unapplied_payments
3001 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3002 See L<FS::cust_pay/unapplied>.
3006 sub total_unapplied_payments {
3008 my $total_unapplied = 0;
3009 foreach my $cust_pay ( qsearch('cust_pay', {
3010 'custnum' => $self->custnum,
3012 $total_unapplied += $cust_pay->unapplied;
3014 sprintf( "%.2f", $total_unapplied );
3019 Returns the balance for this customer (total_owed minus total_credited
3020 minus total_unapplied_payments).
3027 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3031 =item balance_date TIME
3033 Returns the balance for this customer, only considering invoices with date
3034 earlier than TIME (total_owed_date minus total_credited minus
3035 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3036 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3045 $self->total_owed_date($time)
3046 - $self->total_credited
3047 - $self->total_unapplied_payments
3051 =item paydate_monthyear
3053 Returns a two-element list consisting of the month and year of this customer's
3054 paydate (credit card expiration date for CARD customers)
3058 sub paydate_monthyear {
3060 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3062 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3069 =item payinfo_masked
3071 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.
3073 Credit Cards - Mask all but the last four characters.
3074 Checks - Mask all but last 2 of account number and bank routing number.
3075 Others - Do nothing, return the unmasked string.
3079 sub payinfo_masked {
3081 return $self->paymask;
3084 =item invoicing_list [ ARRAYREF ]
3086 If an arguement is given, sets these email addresses as invoice recipients
3087 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3088 (except as warnings), so use check_invoicing_list first.
3090 Returns a list of email addresses (with svcnum entries expanded).
3092 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3093 check it without disturbing anything by passing nothing.
3095 This interface may change in the future.
3099 sub invoicing_list {
3100 my( $self, $arrayref ) = @_;
3102 my @cust_main_invoice;
3103 if ( $self->custnum ) {
3104 @cust_main_invoice =
3105 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3107 @cust_main_invoice = ();
3109 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3110 #warn $cust_main_invoice->destnum;
3111 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3112 #warn $cust_main_invoice->destnum;
3113 my $error = $cust_main_invoice->delete;
3114 warn $error if $error;
3117 if ( $self->custnum ) {
3118 @cust_main_invoice =
3119 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3121 @cust_main_invoice = ();
3123 my %seen = map { $_->address => 1 } @cust_main_invoice;
3124 foreach my $address ( @{$arrayref} ) {
3125 next if exists $seen{$address} && $seen{$address};
3126 $seen{$address} = 1;
3127 my $cust_main_invoice = new FS::cust_main_invoice ( {
3128 'custnum' => $self->custnum,
3131 my $error = $cust_main_invoice->insert;
3132 warn $error if $error;
3135 if ( $self->custnum ) {
3137 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3143 =item check_invoicing_list ARRAYREF
3145 Checks these arguements as valid input for the invoicing_list method. If there
3146 is an error, returns the error, otherwise returns false.
3150 sub check_invoicing_list {
3151 my( $self, $arrayref ) = @_;
3152 foreach my $address ( @{$arrayref} ) {
3154 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3155 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3158 my $cust_main_invoice = new FS::cust_main_invoice ( {
3159 'custnum' => $self->custnum,
3162 my $error = $self->custnum
3163 ? $cust_main_invoice->check
3164 : $cust_main_invoice->checkdest
3166 return $error if $error;
3171 =item set_default_invoicing_list
3173 Sets the invoicing list to all accounts associated with this customer,
3174 overwriting any previous invoicing list.
3178 sub set_default_invoicing_list {
3180 $self->invoicing_list($self->all_emails);
3185 Returns the email addresses of all accounts provisioned for this customer.
3192 foreach my $cust_pkg ( $self->all_pkgs ) {
3193 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3195 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3196 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3198 $list{$_}=1 foreach map { $_->email } @svc_acct;
3203 =item invoicing_list_addpost
3205 Adds postal invoicing to this customer. If this customer is already configured
3206 to receive postal invoices, does nothing.
3210 sub invoicing_list_addpost {
3212 return if grep { $_ eq 'POST' } $self->invoicing_list;
3213 my @invoicing_list = $self->invoicing_list;
3214 push @invoicing_list, 'POST';
3215 $self->invoicing_list(\@invoicing_list);
3218 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3220 Returns an array of customers referred by this customer (referral_custnum set
3221 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3222 customers referred by customers referred by this customer and so on, inclusive.
3223 The default behavior is DEPTH 1 (no recursion).
3227 sub referral_cust_main {
3229 my $depth = @_ ? shift : 1;
3230 my $exclude = @_ ? shift : {};
3233 map { $exclude->{$_->custnum}++; $_; }
3234 grep { ! $exclude->{ $_->custnum } }
3235 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3239 map { $_->referral_cust_main($depth-1, $exclude) }
3246 =item referral_cust_main_ncancelled
3248 Same as referral_cust_main, except only returns customers with uncancelled
3253 sub referral_cust_main_ncancelled {
3255 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3258 =item referral_cust_pkg [ DEPTH ]
3260 Like referral_cust_main, except returns a flat list of all unsuspended (and
3261 uncancelled) packages for each customer. The number of items in this list may
3262 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3266 sub referral_cust_pkg {
3268 my $depth = @_ ? shift : 1;
3270 map { $_->unsuspended_pkgs }
3271 grep { $_->unsuspended_pkgs }
3272 $self->referral_cust_main($depth);
3275 =item referring_cust_main
3277 Returns the single cust_main record for the customer who referred this customer
3278 (referral_custnum), or false.
3282 sub referring_cust_main {
3284 return '' unless $self->referral_custnum;
3285 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3288 =item credit AMOUNT, REASON
3290 Applies a credit to this customer. If there is an error, returns the error,
3291 otherwise returns false.
3296 my( $self, $amount, $reason ) = @_;
3297 my $cust_credit = new FS::cust_credit {
3298 'custnum' => $self->custnum,
3299 'amount' => $amount,
3300 'reason' => $reason,
3302 $cust_credit->insert;
3305 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3307 Creates a one-time charge for this customer. If there is an error, returns
3308 the error, otherwise returns false.
3313 my ( $self, $amount ) = ( shift, shift );
3314 my $pkg = @_ ? shift : 'One-time charge';
3315 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3316 my $taxclass = @_ ? shift : '';
3318 local $SIG{HUP} = 'IGNORE';
3319 local $SIG{INT} = 'IGNORE';
3320 local $SIG{QUIT} = 'IGNORE';
3321 local $SIG{TERM} = 'IGNORE';
3322 local $SIG{TSTP} = 'IGNORE';
3323 local $SIG{PIPE} = 'IGNORE';
3325 my $oldAutoCommit = $FS::UID::AutoCommit;
3326 local $FS::UID::AutoCommit = 0;
3329 my $part_pkg = new FS::part_pkg ( {
3331 'comment' => $comment,
3332 #'setup' => $amount,
3335 'plandata' => "setup_fee=$amount",
3338 'taxclass' => $taxclass,
3341 my $error = $part_pkg->insert;
3343 $dbh->rollback if $oldAutoCommit;
3347 my $pkgpart = $part_pkg->pkgpart;
3348 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3349 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3350 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3351 $error = $type_pkgs->insert;
3353 $dbh->rollback if $oldAutoCommit;
3358 my $cust_pkg = new FS::cust_pkg ( {
3359 'custnum' => $self->custnum,
3360 'pkgpart' => $pkgpart,
3363 $error = $cust_pkg->insert;
3365 $dbh->rollback if $oldAutoCommit;
3369 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3376 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3382 sort { $a->_date <=> $b->_date }
3383 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3386 =item open_cust_bill
3388 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3393 sub open_cust_bill {
3395 grep { $_->owed > 0 } $self->cust_bill;
3400 Returns all the credits (see L<FS::cust_credit>) for this customer.
3406 sort { $a->_date <=> $b->_date }
3407 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3412 Returns all the payments (see L<FS::cust_pay>) for this customer.
3418 sort { $a->_date <=> $b->_date }
3419 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3424 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3430 sort { $a->_date <=> $b->_date }
3431 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3437 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3443 sort { $a->_date <=> $b->_date }
3444 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3447 =item select_for_update
3449 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3454 sub select_for_update {
3456 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3461 Returns a name string for this customer, either "Company (Last, First)" or
3468 my $name = $self->contact;
3469 $name = $self->company. " ($name)" if $self->company;
3475 Returns a name string for this (service/shipping) contact, either
3476 "Company (Last, First)" or "Last, First".
3482 if ( $self->get('ship_last') ) {
3483 my $name = $self->ship_contact;
3484 $name = $self->ship_company. " ($name)" if $self->ship_company;
3493 Returns this customer's full (billing) contact name only, "Last, First"
3499 $self->get('last'). ', '. $self->first;
3504 Returns this customer's full (shipping) contact name only, "Last, First"
3510 $self->get('ship_last')
3511 ? $self->get('ship_last'). ', '. $self->ship_first
3517 Returns a status string for this customer, currently:
3521 =item prospect - No packages have ever been ordered
3523 =item active - One or more recurring packages is active
3525 =item suspended - All non-cancelled recurring packages are suspended
3527 =item cancelled - All recurring packages are cancelled
3535 for my $status (qw( prospect active suspended cancelled )) {
3536 my $method = $status.'_sql';
3537 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3538 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3539 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3540 return $status if $sth->fetchrow_arrayref->[0];
3546 Returns a hex triplet color string for this customer's status.
3551 'prospect' => '000000',
3552 'active' => '00CC00',
3553 'suspended' => 'FF9900',
3554 'cancelled' => 'FF0000',
3558 $statuscolor{$self->status};
3563 =head1 CLASS METHODS
3569 Returns an SQL expression identifying prospective cust_main records (customers
3570 with no packages ever ordered)
3574 sub prospect_sql { "
3575 0 = ( SELECT COUNT(*) FROM cust_pkg
3576 WHERE cust_pkg.custnum = cust_main.custnum
3582 Returns an SQL expression identifying active cust_main records.
3587 0 < ( SELECT COUNT(*) FROM cust_pkg
3588 WHERE cust_pkg.custnum = cust_main.custnum
3589 AND ". FS::cust_pkg->active_sql. "
3596 Returns an SQL expression identifying suspended cust_main records.
3600 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3601 my $recurring_sql = "
3602 '0' != ( select freq from part_pkg
3603 where cust_pkg.pkgpart = part_pkg.pkgpart )
3606 sub suspended_sql { susp_sql(@_); }
3608 0 < ( SELECT COUNT(*) FROM cust_pkg
3609 WHERE cust_pkg.custnum = cust_main.custnum
3611 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3613 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3614 WHERE cust_pkg.custnum = cust_main.custnum
3615 AND ". FS::cust_pkg->active_sql. "
3622 Returns an SQL expression identifying cancelled cust_main records.
3626 sub cancelled_sql { cancel_sql(@_); }
3628 0 < ( SELECT COUNT(*) FROM cust_pkg
3629 WHERE cust_pkg.custnum = cust_main.custnum
3631 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3632 WHERE cust_pkg.custnum = cust_main.custnum
3634 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3638 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3640 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3641 records. Currently, only I<last> or I<company> may be specified (the
3642 appropriate ship_ field is also searched if applicable).
3644 Additional options are the same as FS::Record::qsearch
3649 my( $self, $fuzzy, $hash, @opt) = @_;
3654 check_and_rebuild_fuzzyfiles();
3655 foreach my $field ( keys %$fuzzy ) {
3656 my $sub = \&{"all_$field"};
3658 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3660 foreach ( keys %match ) {
3661 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3662 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3663 if defined dbdef->table('cust_main')->column('ship_last');
3668 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3680 =item smart_search OPTION => VALUE ...
3682 Accepts the following options: I<search>, the string to search for. The string
3683 will be searched for as a customer number, last name or company name, first
3684 searching for an exact match then fuzzy and substring matches.
3686 Any additional options treated as an additional qualifier on the search
3689 Returns a (possibly empty) array of FS::cust_main objects.
3695 my $search = delete $options{'search'};
3698 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3700 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3702 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3705 my $q_value = dbh->quote($value);
3708 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3709 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3710 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3711 if defined dbdef->table('cust_main')->column('ship_last');
3714 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3716 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3718 #still some false laziness w/ search/cust_main.cgi
3721 push @cust_main, qsearch( 'cust_main',
3722 { 'last' => { 'op' => 'ILIKE',
3723 'value' => "%$q_value%" },
3727 push @cust_main, qsearch( 'cust_main',
3728 { 'ship_last' => { 'op' => 'ILIKE',
3729 'value' => "%$q_value%" },
3734 if defined dbdef->table('cust_main')->column('ship_last');
3736 push @cust_main, qsearch( 'cust_main',
3737 { 'company' => { 'op' => 'ILIKE',
3738 'value' => "%$q_value%" },
3742 push @cust_main, qsearch( 'cust_main',
3743 { 'ship_company' => { 'op' => 'ILIKE',
3744 'value' => "%$q_value%" },
3748 if defined dbdef->table('cust_main')->column('ship_last');
3751 push @cust_main, FS::cust_main->fuzzy_search(
3752 { 'last' => $value },
3755 push @cust_main, FS::cust_main->fuzzy_search(
3756 { 'company' => $value },
3768 =item check_and_rebuild_fuzzyfiles
3772 sub check_and_rebuild_fuzzyfiles {
3773 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3774 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3775 or &rebuild_fuzzyfiles;
3778 =item rebuild_fuzzyfiles
3782 sub rebuild_fuzzyfiles {
3784 use Fcntl qw(:flock);
3786 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3790 open(LASTLOCK,">>$dir/cust_main.last")
3791 or die "can't open $dir/cust_main.last: $!";
3792 flock(LASTLOCK,LOCK_EX)
3793 or die "can't lock $dir/cust_main.last: $!";
3795 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3797 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3798 if defined dbdef->table('cust_main')->column('ship_last');
3800 open (LASTCACHE,">$dir/cust_main.last.tmp")
3801 or die "can't open $dir/cust_main.last.tmp: $!";
3802 print LASTCACHE join("\n", @all_last), "\n";
3803 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3805 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3810 open(COMPANYLOCK,">>$dir/cust_main.company")
3811 or die "can't open $dir/cust_main.company: $!";
3812 flock(COMPANYLOCK,LOCK_EX)
3813 or die "can't lock $dir/cust_main.company: $!";
3815 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3817 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3818 if defined dbdef->table('cust_main')->column('ship_last');
3820 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3821 or die "can't open $dir/cust_main.company.tmp: $!";
3822 print COMPANYCACHE join("\n", @all_company), "\n";
3823 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3825 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3835 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3836 open(LASTCACHE,"<$dir/cust_main.last")
3837 or die "can't open $dir/cust_main.last: $!";
3838 my @array = map { chomp; $_; } <LASTCACHE>;
3848 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3849 open(COMPANYCACHE,"<$dir/cust_main.company")
3850 or die "can't open $dir/cust_main.last: $!";
3851 my @array = map { chomp; $_; } <COMPANYCACHE>;
3856 =item append_fuzzyfiles LASTNAME COMPANY
3860 sub append_fuzzyfiles {
3861 my( $last, $company ) = @_;
3863 &check_and_rebuild_fuzzyfiles;
3865 use Fcntl qw(:flock);
3867 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3871 open(LAST,">>$dir/cust_main.last")
3872 or die "can't open $dir/cust_main.last: $!";
3874 or die "can't lock $dir/cust_main.last: $!";
3876 print LAST "$last\n";
3879 or die "can't unlock $dir/cust_main.last: $!";
3885 open(COMPANY,">>$dir/cust_main.company")
3886 or die "can't open $dir/cust_main.company: $!";
3887 flock(COMPANY,LOCK_EX)
3888 or die "can't lock $dir/cust_main.company: $!";
3890 print COMPANY "$company\n";
3892 flock(COMPANY,LOCK_UN)
3893 or die "can't unlock $dir/cust_main.company: $!";
3907 #warn join('-',keys %$param);
3908 my $fh = $param->{filehandle};
3909 my $agentnum = $param->{agentnum};
3910 my $refnum = $param->{refnum};
3911 my $pkgpart = $param->{pkgpart};
3912 my @fields = @{$param->{fields}};
3914 eval "use Date::Parse;";
3916 eval "use Text::CSV_XS;";
3919 my $csv = new Text::CSV_XS;
3926 local $SIG{HUP} = 'IGNORE';
3927 local $SIG{INT} = 'IGNORE';
3928 local $SIG{QUIT} = 'IGNORE';
3929 local $SIG{TERM} = 'IGNORE';
3930 local $SIG{TSTP} = 'IGNORE';
3931 local $SIG{PIPE} = 'IGNORE';
3933 my $oldAutoCommit = $FS::UID::AutoCommit;
3934 local $FS::UID::AutoCommit = 0;
3937 #while ( $columns = $csv->getline($fh) ) {
3939 while ( defined($line=<$fh>) ) {
3941 $csv->parse($line) or do {
3942 $dbh->rollback if $oldAutoCommit;
3943 return "can't parse: ". $csv->error_input();
3946 my @columns = $csv->fields();
3947 #warn join('-',@columns);
3950 agentnum => $agentnum,
3952 country => $conf->config('countrydefault') || 'US',
3953 payby => 'BILL', #default
3954 paydate => '12/2037', #default
3956 my $billtime = time;
3957 my %cust_pkg = ( pkgpart => $pkgpart );
3958 foreach my $field ( @fields ) {
3959 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3960 #$cust_pkg{$1} = str2time( shift @$columns );
3961 if ( $1 eq 'setup' ) {
3962 $billtime = str2time(shift @columns);
3964 $cust_pkg{$1} = str2time( shift @columns );
3967 #$cust_main{$field} = shift @$columns;
3968 $cust_main{$field} = shift @columns;
3972 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3973 my $cust_main = new FS::cust_main ( \%cust_main );
3975 tie my %hash, 'Tie::RefHash'; #this part is important
3976 $hash{$cust_pkg} = [] if $pkgpart;
3977 my $error = $cust_main->insert( \%hash );
3980 $dbh->rollback if $oldAutoCommit;
3981 return "can't insert customer for $line: $error";
3984 #false laziness w/bill.cgi
3985 $error = $cust_main->bill( 'time' => $billtime );
3987 $dbh->rollback if $oldAutoCommit;
3988 return "can't bill customer for $line: $error";
3991 $cust_main->apply_payments;
3992 $cust_main->apply_credits;
3994 $error = $cust_main->collect();
3996 $dbh->rollback if $oldAutoCommit;
3997 return "can't collect customer for $line: $error";
4003 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4005 return "Empty file!" unless $imported;
4017 #warn join('-',keys %$param);
4018 my $fh = $param->{filehandle};
4019 my @fields = @{$param->{fields}};
4021 eval "use Date::Parse;";
4023 eval "use Text::CSV_XS;";
4026 my $csv = new Text::CSV_XS;
4033 local $SIG{HUP} = 'IGNORE';
4034 local $SIG{INT} = 'IGNORE';
4035 local $SIG{QUIT} = 'IGNORE';
4036 local $SIG{TERM} = 'IGNORE';
4037 local $SIG{TSTP} = 'IGNORE';
4038 local $SIG{PIPE} = 'IGNORE';
4040 my $oldAutoCommit = $FS::UID::AutoCommit;
4041 local $FS::UID::AutoCommit = 0;
4044 #while ( $columns = $csv->getline($fh) ) {
4046 while ( defined($line=<$fh>) ) {
4048 $csv->parse($line) or do {
4049 $dbh->rollback if $oldAutoCommit;
4050 return "can't parse: ". $csv->error_input();
4053 my @columns = $csv->fields();
4054 #warn join('-',@columns);
4057 foreach my $field ( @fields ) {
4058 $row{$field} = shift @columns;
4061 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4062 unless ( $cust_main ) {
4063 $dbh->rollback if $oldAutoCommit;
4064 return "unknown custnum $row{'custnum'}";
4067 if ( $row{'amount'} > 0 ) {
4068 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4070 $dbh->rollback if $oldAutoCommit;
4074 } elsif ( $row{'amount'} < 0 ) {
4075 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4078 $dbh->rollback if $oldAutoCommit;
4088 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4090 return "Empty file!" unless $imported;
4102 The delete method should possibly take an FS::cust_main object reference
4103 instead of a scalar customer number.
4105 Bill and collect options should probably be passed as references instead of a
4108 There should probably be a configuration file with a list of allowed credit
4111 No multiple currency support (probably a larger project than just this module).
4113 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4117 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4118 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4119 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.