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);
21 use String::Approx qw(amatch);
22 use Business::CreditCard 0.28;
24 use FS::UID qw( getotaker dbh );
25 use FS::Record qw( qsearchs qsearch dbdef );
26 use FS::Misc qw( send_email );
27 use FS::Msgcat qw(gettext);
31 use FS::cust_bill_pkg;
33 use FS::cust_pay_void;
36 use FS::part_referral;
37 use FS::cust_main_county;
39 use FS::cust_main_invoice;
40 use FS::cust_credit_bill;
41 use FS::cust_bill_pay;
42 use FS::prepay_credit;
45 use FS::part_bill_event;
46 use FS::cust_bill_event;
47 use FS::cust_tax_exempt;
48 use FS::cust_tax_exempt_pkg;
50 use FS::payment_gateway;
51 use FS::agent_payment_gateway;
54 @ISA = qw( FS::Record );
56 @EXPORT_OK = qw( smart_search );
58 $realtime_bop_decline_quiet = 0;
60 # 1 is mostly method/subroutine entry and options
61 # 2 traces progress of some operations
62 # 3 is even more information including possibly sensitive data
64 $me = '[FS::cust_main]';
68 $ignore_expired_card = 0;
70 @encrypted_fields = ('payinfo', 'paycvv');
72 #ask FS::UID to run this stuff for us later
73 #$FS::UID::callback{'FS::cust_main'} = sub {
74 install_callback FS::UID sub {
76 #yes, need it for stuff below (prolly should be cached)
81 my ( $hashref, $cache ) = @_;
82 if ( exists $hashref->{'pkgnum'} ) {
83 #@{ $self->{'_pkgnum'} } = ();
84 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
85 $self->{'_pkgnum'} = $subcache;
86 #push @{ $self->{'_pkgnum'} },
87 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
93 FS::cust_main - Object methods for cust_main records
99 $record = new FS::cust_main \%hash;
100 $record = new FS::cust_main { 'column' => 'value' };
102 $error = $record->insert;
104 $error = $new_record->replace($old_record);
106 $error = $record->delete;
108 $error = $record->check;
110 @cust_pkg = $record->all_pkgs;
112 @cust_pkg = $record->ncancelled_pkgs;
114 @cust_pkg = $record->suspended_pkgs;
116 $error = $record->bill;
117 $error = $record->bill %options;
118 $error = $record->bill 'time' => $time;
120 $error = $record->collect;
121 $error = $record->collect %options;
122 $error = $record->collect 'invoice_time' => $time,
127 An FS::cust_main object represents a customer. FS::cust_main inherits from
128 FS::Record. The following fields are currently supported:
132 =item custnum - primary key (assigned automatically for new customers)
134 =item agentnum - agent (see L<FS::agent>)
136 =item refnum - Advertising source (see L<FS::part_referral>)
142 =item ss - social security number (optional)
144 =item company - (optional)
148 =item address2 - (optional)
152 =item county - (optional, see L<FS::cust_main_county>)
154 =item state - (see L<FS::cust_main_county>)
158 =item country - (see L<FS::cust_main_county>)
160 =item daytime - phone (optional)
162 =item night - phone (optional)
164 =item fax - phone (optional)
166 =item ship_first - name
168 =item ship_last - name
170 =item ship_company - (optional)
174 =item ship_address2 - (optional)
178 =item ship_county - (optional, see L<FS::cust_main_county>)
180 =item ship_state - (see L<FS::cust_main_county>)
184 =item ship_country - (see L<FS::cust_main_county>)
186 =item ship_daytime - phone (optional)
188 =item ship_night - phone (optional)
190 =item ship_fax - phone (optional)
194 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>)
198 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
203 my($self,$payinfo) = @_;
204 if ( defined($payinfo) ) {
205 $self->paymask($payinfo);
206 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
208 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
216 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
220 =item paymask - Masked payment type
226 Mask all but the last four characters.
230 Mask all but last 2 of account number and bank routing number.
234 Do nothing, return the unmasked string.
243 # If it doesn't exist then generate it
244 my $paymask=$self->getfield('paymask');
245 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
246 $value = $self->payinfo;
249 if ( defined($value) && !$self->is_encrypted($value)) {
250 my $payinfo = $value;
251 my $payby = $self->payby;
252 if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
253 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
254 } elsif ($payby eq 'CHEK' ||
255 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
256 my( $account, $aba ) = split('@', $payinfo );
257 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
258 } else { # Tie up loose ends
261 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
262 } elsif (defined($value) && $self->is_encrypted($value)) {
268 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
270 =item paystart_month - start date month (maestro/solo cards only)
272 =item paystart_year - start date year (maestro/solo cards only)
274 =item payissue - issue number (maestro/solo cards only)
276 =item payname - name on card or billing name
278 =item payip - IP address from which payment information was received
280 =item tax - tax exempt, empty or `Y'
282 =item otaker - order taker (assigned automatically, see L<FS::UID>)
284 =item comments - comments (optional)
286 =item referral_custnum - referring customer number
288 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
298 Creates a new customer. To add the customer to the database, see L<"insert">.
300 Note that this stores the hash reference, not a distinct copy of the hash it
301 points to. You can ask the object for a copy with the I<hash> method.
305 sub table { 'cust_main'; }
307 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
309 Adds this customer to the database. If there is an error, returns the error,
310 otherwise returns false.
312 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
313 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
314 are inserted atomicly, or the transaction is rolled back. Passing an empty
315 hash reference is equivalent to not supplying this parameter. There should be
316 a better explanation of this, but until then, here's an example:
319 tie %hash, 'Tie::RefHash'; #this part is important
321 $cust_pkg => [ $svc_acct ],
324 $cust_main->insert( \%hash );
326 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
327 be set as the invoicing list (see L<"invoicing_list">). Errors return as
328 expected and rollback the entire transaction; it is not necessary to call
329 check_invoicing_list first. The invoicing_list is set after the records in the
330 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
331 invoicing_list destination to the newly-created svc_acct. Here's an example:
333 $cust_main->insert( {}, [ $email, 'POST' ] );
335 Currently available options are: I<depend_jobnum> and I<noexport>.
337 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
338 on the supplied jobnum (they will not run until the specific job completes).
339 This can be used to defer provisioning until some action completes (such
340 as running the customer's credit card successfully).
342 The I<noexport> option is deprecated. If I<noexport> is set true, no
343 provisioning jobs (exports) are scheduled. (You can schedule them later with
344 the B<reexport> method.)
350 my $cust_pkgs = @_ ? shift : {};
351 my $invoicing_list = @_ ? shift : '';
353 warn "$me insert called with options ".
354 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
357 local $SIG{HUP} = 'IGNORE';
358 local $SIG{INT} = 'IGNORE';
359 local $SIG{QUIT} = 'IGNORE';
360 local $SIG{TERM} = 'IGNORE';
361 local $SIG{TSTP} = 'IGNORE';
362 local $SIG{PIPE} = 'IGNORE';
364 my $oldAutoCommit = $FS::UID::AutoCommit;
365 local $FS::UID::AutoCommit = 0;
368 my $prepay_identifier = '';
369 my( $amount, $seconds ) = ( 0, 0 );
371 if ( $self->payby eq 'PREPAY' ) {
373 $self->payby('BILL');
374 $prepay_identifier = $self->payinfo;
377 warn " looking up prepaid card $prepay_identifier\n"
380 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
382 $dbh->rollback if $oldAutoCommit;
383 #return "error applying prepaid card (transaction rolled back): $error";
387 $payby = 'PREP' if $amount;
389 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
392 $self->payby('BILL');
393 $amount = $self->paid;
397 warn " inserting $self\n"
400 my $error = $self->SUPER::insert;
402 $dbh->rollback if $oldAutoCommit;
403 #return "inserting cust_main record (transaction rolled back): $error";
407 warn " setting invoicing list\n"
410 if ( $invoicing_list ) {
411 $error = $self->check_invoicing_list( $invoicing_list );
413 $dbh->rollback if $oldAutoCommit;
414 return "checking invoicing_list (transaction rolled back): $error";
416 $self->invoicing_list( $invoicing_list );
419 warn " ordering packages\n"
422 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
424 $dbh->rollback if $oldAutoCommit;
429 $dbh->rollback if $oldAutoCommit;
430 return "No svc_acct record to apply pre-paid time";
434 warn " inserting initial $payby payment of $amount\n"
436 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
438 $dbh->rollback if $oldAutoCommit;
439 return "inserting payment (transaction rolled back): $error";
443 unless ( $import || $skip_fuzzyfiles ) {
444 warn " queueing fuzzyfiles update\n"
446 $error = $self->queue_fuzzyfiles_update;
448 $dbh->rollback if $oldAutoCommit;
449 return "updating fuzzy search cache: $error";
453 warn " insert complete; committing transaction\n"
456 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
461 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
463 Like the insert method on an existing record, this method orders a package
464 and included services atomicaly. Pass a Tie::RefHash data structure to this
465 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
466 be a better explanation of this, but until then, here's an example:
469 tie %hash, 'Tie::RefHash'; #this part is important
471 $cust_pkg => [ $svc_acct ],
474 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
476 Services can be new, in which case they are inserted, or existing unaudited
477 services, in which case they are linked to the newly-created package.
479 Currently available options are: I<depend_jobnum> and I<noexport>.
481 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
482 on the supplied jobnum (they will not run until the specific job completes).
483 This can be used to defer provisioning until some action completes (such
484 as running the customer's credit card successfully).
486 The I<noexport> option is deprecated. If I<noexport> is set true, no
487 provisioning jobs (exports) are scheduled. (You can schedule them later with
488 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
489 on the cust_main object is not recommended, as existing services will also be
496 my $cust_pkgs = shift;
499 my %svc_options = ();
500 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
501 if exists $options{'depend_jobnum'};
502 warn "$me order_pkgs called with options ".
503 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
506 local $SIG{HUP} = 'IGNORE';
507 local $SIG{INT} = 'IGNORE';
508 local $SIG{QUIT} = 'IGNORE';
509 local $SIG{TERM} = 'IGNORE';
510 local $SIG{TSTP} = 'IGNORE';
511 local $SIG{PIPE} = 'IGNORE';
513 my $oldAutoCommit = $FS::UID::AutoCommit;
514 local $FS::UID::AutoCommit = 0;
517 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
519 foreach my $cust_pkg ( keys %$cust_pkgs ) {
520 $cust_pkg->custnum( $self->custnum );
521 my $error = $cust_pkg->insert;
523 $dbh->rollback if $oldAutoCommit;
524 return "inserting cust_pkg (transaction rolled back): $error";
526 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
527 if ( $svc_something->svcnum ) {
528 my $old_cust_svc = $svc_something->cust_svc;
529 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
530 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
531 $error = $new_cust_svc->replace($old_cust_svc);
533 $svc_something->pkgnum( $cust_pkg->pkgnum );
534 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
535 $svc_something->seconds( $svc_something->seconds + $$seconds );
538 $error = $svc_something->insert(%svc_options);
541 $dbh->rollback if $oldAutoCommit;
542 #return "inserting svc_ (transaction rolled back): $error";
548 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
552 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
554 Recharges this (existing) customer with the specified prepaid card (see
555 L<FS::prepay_credit>), specified either by I<identifier> or as an
556 FS::prepay_credit object. If there is an error, returns the error, otherwise
559 Optionally, two scalar references can be passed as well. They will have their
560 values filled in with the amount and number of seconds applied by this prepaid
565 sub recharge_prepay {
566 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
568 local $SIG{HUP} = 'IGNORE';
569 local $SIG{INT} = 'IGNORE';
570 local $SIG{QUIT} = 'IGNORE';
571 local $SIG{TERM} = 'IGNORE';
572 local $SIG{TSTP} = 'IGNORE';
573 local $SIG{PIPE} = 'IGNORE';
575 my $oldAutoCommit = $FS::UID::AutoCommit;
576 local $FS::UID::AutoCommit = 0;
579 my( $amount, $seconds ) = ( 0, 0 );
581 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
582 || $self->increment_seconds($seconds)
583 || $self->insert_cust_pay_prepay( $amount,
585 ? $prepay_credit->identifier
590 $dbh->rollback if $oldAutoCommit;
594 if ( defined($amountref) ) { $$amountref = $amount; }
595 if ( defined($secondsref) ) { $$secondsref = $seconds; }
597 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
602 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
604 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
605 specified either by I<identifier> or as an FS::prepay_credit object.
607 References to I<amount> and I<seconds> scalars should be passed as arguments
608 and will be incremented by the values of the prepaid card.
610 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
611 check or set this customer's I<agentnum>.
613 If there is an error, returns the error, otherwise returns false.
619 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
621 local $SIG{HUP} = 'IGNORE';
622 local $SIG{INT} = 'IGNORE';
623 local $SIG{QUIT} = 'IGNORE';
624 local $SIG{TERM} = 'IGNORE';
625 local $SIG{TSTP} = 'IGNORE';
626 local $SIG{PIPE} = 'IGNORE';
628 my $oldAutoCommit = $FS::UID::AutoCommit;
629 local $FS::UID::AutoCommit = 0;
632 unless ( ref($prepay_credit) ) {
634 my $identifier = $prepay_credit;
636 $prepay_credit = qsearchs(
638 { 'identifier' => $prepay_credit },
643 unless ( $prepay_credit ) {
644 $dbh->rollback if $oldAutoCommit;
645 return "Invalid prepaid card: ". $identifier;
650 if ( $prepay_credit->agentnum ) {
651 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
652 $dbh->rollback if $oldAutoCommit;
653 return "prepaid card not valid for agent ". $self->agentnum;
655 $self->agentnum($prepay_credit->agentnum);
658 my $error = $prepay_credit->delete;
660 $dbh->rollback if $oldAutoCommit;
661 return "removing prepay_credit (transaction rolled back): $error";
664 $$amountref += $prepay_credit->amount;
665 $$secondsref += $prepay_credit->seconds;
667 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
672 =item increment_seconds SECONDS
674 Updates this customer's single or primary account (see L<FS::svc_acct>) by
675 the specified number of seconds. If there is an error, returns the error,
676 otherwise returns false.
680 sub increment_seconds {
681 my( $self, $seconds ) = @_;
682 warn "$me increment_seconds called: $seconds seconds\n"
685 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
686 $self->ncancelled_pkgs;
689 return 'No packages with primary or single services found'.
690 ' to apply pre-paid time';
691 } elsif ( scalar(@cust_pkg) > 1 ) {
692 #maybe have a way to specify the package/account?
693 return 'Multiple packages found to apply pre-paid time';
696 my $cust_pkg = $cust_pkg[0];
697 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
701 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
704 return 'No account found to apply pre-paid time';
705 } elsif ( scalar(@cust_svc) > 1 ) {
706 return 'Multiple accounts found to apply pre-paid time';
709 my $svc_acct = $cust_svc[0]->svc_x;
710 warn " found service svcnum ". $svc_acct->pkgnum.
711 ' ('. $svc_acct->email. ")\n"
714 $svc_acct->increment_seconds($seconds);
718 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
720 Inserts a prepayment in the specified amount for this customer. An optional
721 second argument can specify the prepayment identifier for tracking purposes.
722 If there is an error, returns the error, otherwise returns false.
726 sub insert_cust_pay_prepay {
727 shift->insert_cust_pay('PREP', @_);
730 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
732 Inserts a cash payment in the specified amount for this customer. An optional
733 second argument can specify the payment identifier for tracking purposes.
734 If there is an error, returns the error, otherwise returns false.
738 sub insert_cust_pay_cash {
739 shift->insert_cust_pay('CASH', @_);
742 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
744 Inserts a Western Union payment in the specified amount for this customer. An
745 optional second argument can specify the prepayment identifier for tracking
746 purposes. If there is an error, returns the error, otherwise returns false.
750 sub insert_cust_pay_west {
751 shift->insert_cust_pay('WEST', @_);
754 sub insert_cust_pay {
755 my( $self, $payby, $amount ) = splice(@_, 0, 3);
756 my $payinfo = scalar(@_) ? shift : '';
758 my $cust_pay = new FS::cust_pay {
759 'custnum' => $self->custnum,
760 'paid' => sprintf('%.2f', $amount),
761 #'_date' => #date the prepaid card was purchased???
763 'payinfo' => $payinfo,
771 This method is deprecated. See the I<depend_jobnum> option to the insert and
772 order_pkgs methods for a better way to defer provisioning.
774 Re-schedules all exports by calling the B<reexport> method of all associated
775 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
776 otherwise returns false.
783 carp "WARNING: FS::cust_main::reexport is deprectated; ".
784 "use the depend_jobnum option to insert or order_pkgs to delay export";
786 local $SIG{HUP} = 'IGNORE';
787 local $SIG{INT} = 'IGNORE';
788 local $SIG{QUIT} = 'IGNORE';
789 local $SIG{TERM} = 'IGNORE';
790 local $SIG{TSTP} = 'IGNORE';
791 local $SIG{PIPE} = 'IGNORE';
793 my $oldAutoCommit = $FS::UID::AutoCommit;
794 local $FS::UID::AutoCommit = 0;
797 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
798 my $error = $cust_pkg->reexport;
800 $dbh->rollback if $oldAutoCommit;
805 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
810 =item delete NEW_CUSTNUM
812 This deletes the customer. If there is an error, returns the error, otherwise
815 This will completely remove all traces of the customer record. This is not
816 what you want when a customer cancels service; for that, cancel all of the
817 customer's packages (see L</cancel>).
819 If the customer has any uncancelled packages, you need to pass a new (valid)
820 customer number for those packages to be transferred to. Cancelled packages
821 will be deleted. Did I mention that this is NOT what you want when a customer
822 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
824 You can't delete a customer with invoices (see L<FS::cust_bill>),
825 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
826 refunds (see L<FS::cust_refund>).
833 local $SIG{HUP} = 'IGNORE';
834 local $SIG{INT} = 'IGNORE';
835 local $SIG{QUIT} = 'IGNORE';
836 local $SIG{TERM} = 'IGNORE';
837 local $SIG{TSTP} = 'IGNORE';
838 local $SIG{PIPE} = 'IGNORE';
840 my $oldAutoCommit = $FS::UID::AutoCommit;
841 local $FS::UID::AutoCommit = 0;
844 if ( $self->cust_bill ) {
845 $dbh->rollback if $oldAutoCommit;
846 return "Can't delete a customer with invoices";
848 if ( $self->cust_credit ) {
849 $dbh->rollback if $oldAutoCommit;
850 return "Can't delete a customer with credits";
852 if ( $self->cust_pay ) {
853 $dbh->rollback if $oldAutoCommit;
854 return "Can't delete a customer with payments";
856 if ( $self->cust_refund ) {
857 $dbh->rollback if $oldAutoCommit;
858 return "Can't delete a customer with refunds";
861 my @cust_pkg = $self->ncancelled_pkgs;
863 my $new_custnum = shift;
864 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
865 $dbh->rollback if $oldAutoCommit;
866 return "Invalid new customer number: $new_custnum";
868 foreach my $cust_pkg ( @cust_pkg ) {
869 my %hash = $cust_pkg->hash;
870 $hash{'custnum'} = $new_custnum;
871 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
872 my $error = $new_cust_pkg->replace($cust_pkg);
874 $dbh->rollback if $oldAutoCommit;
879 my @cancelled_cust_pkg = $self->all_pkgs;
880 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
881 my $error = $cust_pkg->delete;
883 $dbh->rollback if $oldAutoCommit;
888 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
889 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
891 my $error = $cust_main_invoice->delete;
893 $dbh->rollback if $oldAutoCommit;
898 my $error = $self->SUPER::delete;
900 $dbh->rollback if $oldAutoCommit;
904 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
909 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
911 Replaces the OLD_RECORD with this one in the database. If there is an error,
912 returns the error, otherwise returns false.
914 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
915 be set as the invoicing list (see L<"invoicing_list">). Errors return as
916 expected and rollback the entire transaction; it is not necessary to call
917 check_invoicing_list first. Here's an example:
919 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
927 warn "$me replace called\n"
930 local $SIG{HUP} = 'IGNORE';
931 local $SIG{INT} = 'IGNORE';
932 local $SIG{QUIT} = 'IGNORE';
933 local $SIG{TERM} = 'IGNORE';
934 local $SIG{TSTP} = 'IGNORE';
935 local $SIG{PIPE} = 'IGNORE';
937 # If the mask is blank then try to set it - if we can...
938 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
939 $self->paymask($self->payinfo);
942 # We absolutely have to have an old vs. new record to make this work.
943 if (!defined($old)) {
944 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
947 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
948 && $conf->config('users-allow_comp') ) {
949 return "You are not permitted to create complimentary accounts."
950 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
953 local($ignore_expired_card) = 1
954 if $old->payby =~ /^(CARD|DCRD)$/
955 && $self->payby =~ /^(CARD|DCRD)$/
956 && $old->payinfo eq $self->payinfo;
958 my $oldAutoCommit = $FS::UID::AutoCommit;
959 local $FS::UID::AutoCommit = 0;
962 my $error = $self->SUPER::replace($old);
965 $dbh->rollback if $oldAutoCommit;
969 if ( @param ) { # INVOICING_LIST_ARYREF
970 my $invoicing_list = shift @param;
971 $error = $self->check_invoicing_list( $invoicing_list );
973 $dbh->rollback if $oldAutoCommit;
976 $self->invoicing_list( $invoicing_list );
979 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
980 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
981 # card/check/lec info has changed, want to retry realtime_ invoice events
982 my $error = $self->retry_realtime;
984 $dbh->rollback if $oldAutoCommit;
989 unless ( $import || $skip_fuzzyfiles ) {
990 $error = $self->queue_fuzzyfiles_update;
992 $dbh->rollback if $oldAutoCommit;
993 return "updating fuzzy search cache: $error";
997 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1002 =item queue_fuzzyfiles_update
1004 Used by insert & replace to update the fuzzy search cache
1008 sub queue_fuzzyfiles_update {
1011 local $SIG{HUP} = 'IGNORE';
1012 local $SIG{INT} = 'IGNORE';
1013 local $SIG{QUIT} = 'IGNORE';
1014 local $SIG{TERM} = 'IGNORE';
1015 local $SIG{TSTP} = 'IGNORE';
1016 local $SIG{PIPE} = 'IGNORE';
1018 my $oldAutoCommit = $FS::UID::AutoCommit;
1019 local $FS::UID::AutoCommit = 0;
1022 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1023 my $error = $queue->insert($self->getfield('last'), $self->company);
1025 $dbh->rollback if $oldAutoCommit;
1026 return "queueing job (transaction rolled back): $error";
1029 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1030 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1031 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1033 $dbh->rollback if $oldAutoCommit;
1034 return "queueing job (transaction rolled back): $error";
1038 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1045 Checks all fields to make sure this is a valid customer record. If there is
1046 an error, returns the error, otherwise returns false. Called by the insert
1047 and replace methods.
1054 warn "$me check BEFORE: \n". $self->_dump
1058 $self->ut_numbern('custnum')
1059 || $self->ut_number('agentnum')
1060 || $self->ut_number('refnum')
1061 || $self->ut_name('last')
1062 || $self->ut_name('first')
1063 || $self->ut_textn('company')
1064 || $self->ut_text('address1')
1065 || $self->ut_textn('address2')
1066 || $self->ut_text('city')
1067 || $self->ut_textn('county')
1068 || $self->ut_textn('state')
1069 || $self->ut_country('country')
1070 || $self->ut_anything('comments')
1071 || $self->ut_numbern('referral_custnum')
1073 #barf. need message catalogs. i18n. etc.
1074 $error .= "Please select an advertising source."
1075 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1076 return $error if $error;
1078 return "Unknown agent"
1079 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1081 return "Unknown refnum"
1082 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1084 return "Unknown referring custnum: ". $self->referral_custnum
1085 unless ! $self->referral_custnum
1086 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1088 if ( $self->ss eq '' ) {
1093 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1094 or return "Illegal social security number: ". $self->ss;
1095 $self->ss("$1-$2-$3");
1099 # bad idea to disable, causes billing to fail because of no tax rates later
1100 # unless ( $import ) {
1101 unless ( qsearch('cust_main_county', {
1102 'country' => $self->country,
1105 return "Unknown state/county/country: ".
1106 $self->state. "/". $self->county. "/". $self->country
1107 unless qsearch('cust_main_county',{
1108 'state' => $self->state,
1109 'county' => $self->county,
1110 'country' => $self->country,
1116 $self->ut_phonen('daytime', $self->country)
1117 || $self->ut_phonen('night', $self->country)
1118 || $self->ut_phonen('fax', $self->country)
1119 || $self->ut_zip('zip', $self->country)
1121 return $error if $error;
1124 last first company address1 address2 city county state zip
1125 country daytime night fax
1128 if ( defined $self->dbdef_table->column('ship_last') ) {
1129 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1131 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1135 $self->ut_name('ship_last')
1136 || $self->ut_name('ship_first')
1137 || $self->ut_textn('ship_company')
1138 || $self->ut_text('ship_address1')
1139 || $self->ut_textn('ship_address2')
1140 || $self->ut_text('ship_city')
1141 || $self->ut_textn('ship_county')
1142 || $self->ut_textn('ship_state')
1143 || $self->ut_country('ship_country')
1145 return $error if $error;
1147 #false laziness with above
1148 unless ( qsearchs('cust_main_county', {
1149 'country' => $self->ship_country,
1152 return "Unknown ship_state/ship_county/ship_country: ".
1153 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1154 unless qsearch('cust_main_county',{
1155 'state' => $self->ship_state,
1156 'county' => $self->ship_county,
1157 'country' => $self->ship_country,
1163 $self->ut_phonen('ship_daytime', $self->ship_country)
1164 || $self->ut_phonen('ship_night', $self->ship_country)
1165 || $self->ut_phonen('ship_fax', $self->ship_country)
1166 || $self->ut_zip('ship_zip', $self->ship_country)
1168 return $error if $error;
1170 } else { # ship_ info eq billing info, so don't store dup info in database
1171 $self->setfield("ship_$_", '')
1172 foreach qw( last first company address1 address2 city county state zip
1173 country daytime night fax );
1177 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1178 or return "Illegal payby: ". $self->payby;
1180 $error = $self->ut_numbern('paystart_month')
1181 || $self->ut_numbern('paystart_year')
1182 || $self->ut_numbern('payissue')
1184 return $error if $error;
1186 if ( $self->payip eq '' ) {
1189 $error = $self->ut_ip('payip');
1190 return $error if $error;
1193 # If it is encrypted and the private key is not availaible then we can't
1194 # check the credit card.
1196 my $check_payinfo = 1;
1198 if ($self->is_encrypted($self->payinfo)) {
1204 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1206 my $payinfo = $self->payinfo;
1207 $payinfo =~ s/\D//g;
1208 $payinfo =~ /^(\d{13,16})$/
1209 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1211 $self->payinfo($payinfo);
1213 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1215 return gettext('unknown_card_type')
1216 if cardtype($self->payinfo) eq "Unknown";
1218 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1220 return 'Banned credit card: banned on '.
1221 time2str('%a %h %o at %r', $ban->_date).
1222 ' by '. $ban->otaker.
1223 ' (ban# '. $ban->bannum. ')';
1226 if ( defined $self->dbdef_table->column('paycvv') ) {
1227 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1228 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1229 $self->paycvv =~ /^(\d{4})$/
1230 or return "CVV2 (CID) for American Express cards is four digits.";
1233 $self->paycvv =~ /^(\d{3})$/
1234 or return "CVV2 (CVC2/CID) is three digits.";
1242 my $cardtype = cardtype($payinfo);
1243 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1245 return "Start date or issue number is required for $cardtype cards"
1246 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1248 return "Start month must be between 1 and 12"
1249 if $self->paystart_month
1250 and $self->paystart_month < 1 || $self->paystart_month > 12;
1252 return "Start year must be 1990 or later"
1253 if $self->paystart_year
1254 and $self->paystart_year < 1990;
1256 return "Issue number must be beween 1 and 99"
1258 and $self->payissue < 1 || $self->payissue > 99;
1261 $self->paystart_month('');
1262 $self->paystart_year('');
1263 $self->payissue('');
1266 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1268 my $payinfo = $self->payinfo;
1269 $payinfo =~ s/[^\d\@]//g;
1270 if ( $conf->exists('echeck-nonus') ) {
1271 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1272 $payinfo = "$1\@$2";
1274 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1275 $payinfo = "$1\@$2";
1277 $self->payinfo($payinfo);
1278 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1280 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1282 return 'Banned ACH account: banned on '.
1283 time2str('%a %h %o at %r', $ban->_date).
1284 ' by '. $ban->otaker.
1285 ' (ban# '. $ban->bannum. ')';
1288 } elsif ( $self->payby eq 'LECB' ) {
1290 my $payinfo = $self->payinfo;
1291 $payinfo =~ s/\D//g;
1292 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1294 $self->payinfo($payinfo);
1295 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1297 } elsif ( $self->payby eq 'BILL' ) {
1299 $error = $self->ut_textn('payinfo');
1300 return "Illegal P.O. number: ". $self->payinfo if $error;
1301 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1303 } elsif ( $self->payby eq 'COMP' ) {
1305 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1306 return "You are not permitted to create complimentary accounts."
1307 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1310 $error = $self->ut_textn('payinfo');
1311 return "Illegal comp account issuer: ". $self->payinfo if $error;
1312 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1314 } elsif ( $self->payby eq 'PREPAY' ) {
1316 my $payinfo = $self->payinfo;
1317 $payinfo =~ s/\W//g; #anything else would just confuse things
1318 $self->payinfo($payinfo);
1319 $error = $self->ut_alpha('payinfo');
1320 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1321 return "Unknown prepayment identifier"
1322 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1323 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1327 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1328 return "Expiration date required"
1329 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1333 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1334 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1335 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1336 ( $m, $y ) = ( $3, "20$2" );
1338 return "Illegal expiration date: ". $self->paydate;
1340 $self->paydate("$y-$m-01");
1341 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1342 return gettext('expired_card')
1344 && !$ignore_expired_card
1345 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1348 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1349 ( ! $conf->exists('require_cardname')
1350 || $self->payby !~ /^(CARD|DCRD)$/ )
1352 $self->payname( $self->first. " ". $self->getfield('last') );
1354 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1355 or return gettext('illegal_name'). " payname: ". $self->payname;
1359 foreach my $flag (qw( tax spool_cdr )) {
1360 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1364 $self->otaker(getotaker) unless $self->otaker;
1366 warn "$me check AFTER: \n". $self->_dump
1369 $self->SUPER::check;
1374 Returns all packages (see L<FS::cust_pkg>) for this customer.
1380 if ( $self->{'_pkgnum'} ) {
1381 values %{ $self->{'_pkgnum'}->cache };
1383 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1387 =item ncancelled_pkgs
1389 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1393 sub ncancelled_pkgs {
1395 if ( $self->{'_pkgnum'} ) {
1396 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1398 @{ [ # force list context
1399 qsearch( 'cust_pkg', {
1400 'custnum' => $self->custnum,
1403 qsearch( 'cust_pkg', {
1404 'custnum' => $self->custnum,
1411 =item suspended_pkgs
1413 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1417 sub suspended_pkgs {
1419 grep { $_->susp } $self->ncancelled_pkgs;
1422 =item unflagged_suspended_pkgs
1424 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1425 customer (thouse packages without the `manual_flag' set).
1429 sub unflagged_suspended_pkgs {
1431 return $self->suspended_pkgs
1432 unless dbdef->table('cust_pkg')->column('manual_flag');
1433 grep { ! $_->manual_flag } $self->suspended_pkgs;
1436 =item unsuspended_pkgs
1438 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1443 sub unsuspended_pkgs {
1445 grep { ! $_->susp } $self->ncancelled_pkgs;
1448 =item num_cancelled_pkgs
1450 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1455 sub num_cancelled_pkgs {
1457 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1461 my( $self, $sql ) = @_;
1462 my $sth = dbh->prepare(
1463 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1464 ) or die dbh->errstr;
1465 $sth->execute($self->custnum) or die $sth->errstr;
1466 $sth->fetchrow_arrayref->[0];
1471 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1472 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1473 on success or a list of errors.
1479 grep { $_->unsuspend } $self->suspended_pkgs;
1484 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1486 Returns a list: an empty list on success or a list of errors.
1492 grep { $_->suspend } $self->unsuspended_pkgs;
1495 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1497 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1498 PKGPARTs (see L<FS::part_pkg>).
1500 Returns a list: an empty list on success or a list of errors.
1504 sub suspend_if_pkgpart {
1507 grep { $_->suspend }
1508 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1509 $self->unsuspended_pkgs;
1512 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1514 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1515 listed PKGPARTs (see L<FS::part_pkg>).
1517 Returns a list: an empty list on success or a list of errors.
1521 sub suspend_unless_pkgpart {
1524 grep { $_->suspend }
1525 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1526 $self->unsuspended_pkgs;
1529 =item cancel [ OPTION => VALUE ... ]
1531 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1533 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1535 I<quiet> can be set true to supress email cancellation notices.
1537 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1539 I<ban> can be set true to ban this customer's credit card or ACH information,
1542 Always returns a list: an empty list on success or a list of errors.
1550 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1552 #should try decryption (we might have the private key)
1553 # and if not maybe queue a job for the server that does?
1554 return ( "Can't (yet) ban encrypted credit cards" )
1555 if $self->is_encrypted($self->payinfo);
1557 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1558 my $error = $ban->insert;
1559 return ( $error ) if $error;
1563 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1566 sub _banned_pay_hashref {
1577 'payby' => $payby2ban{$self->payby},
1578 'payinfo' => md5_base64($self->payinfo),
1585 Returns the agent (see L<FS::agent>) for this customer.
1591 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1596 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1597 conjunction with the collect method.
1599 Options are passed as name-value pairs.
1601 Currently available options are:
1603 resetup - if set true, re-charges setup fees.
1605 time - bills the customer as if it were that time. Specified as a UNIX
1606 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1607 L<Date::Parse> for conversion functions. For example:
1611 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1614 If there is an error, returns the error, otherwise returns false.
1619 my( $self, %options ) = @_;
1620 return '' if $self->payby eq 'COMP';
1621 warn "$me bill customer ". $self->custnum. "\n"
1624 my $time = $options{'time'} || time;
1629 local $SIG{HUP} = 'IGNORE';
1630 local $SIG{INT} = 'IGNORE';
1631 local $SIG{QUIT} = 'IGNORE';
1632 local $SIG{TERM} = 'IGNORE';
1633 local $SIG{TSTP} = 'IGNORE';
1634 local $SIG{PIPE} = 'IGNORE';
1636 my $oldAutoCommit = $FS::UID::AutoCommit;
1637 local $FS::UID::AutoCommit = 0;
1640 $self->select_for_update; #mutex
1642 #create a new invoice
1643 #(we'll remove it later if it doesn't actually need to be generated [contains
1644 # no line items] and we're inside a transaciton so nothing else will see it)
1645 my $cust_bill = new FS::cust_bill ( {
1646 'custnum' => $self->custnum,
1648 #'charged' => $charged,
1651 $error = $cust_bill->insert;
1653 $dbh->rollback if $oldAutoCommit;
1654 return "can't create invoice for customer #". $self->custnum. ": $error";
1656 my $invnum = $cust_bill->invnum;
1659 # find the packages which are due for billing, find out how much they are
1660 # & generate invoice database.
1663 my( $total_setup, $total_recur ) = ( 0, 0 );
1665 my @precommit_hooks = ();
1667 foreach my $cust_pkg (
1668 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1671 #NO!! next if $cust_pkg->cancel;
1672 next if $cust_pkg->getfield('cancel');
1674 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1676 #? to avoid use of uninitialized value errors... ?
1677 $cust_pkg->setfield('bill', '')
1678 unless defined($cust_pkg->bill);
1680 my $part_pkg = $cust_pkg->part_pkg;
1682 my %hash = $cust_pkg->hash;
1683 my $old_cust_pkg = new FS::cust_pkg \%hash;
1692 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1694 warn " bill setup\n" if $DEBUG > 1;
1696 $setup = eval { $cust_pkg->calc_setup( $time ) };
1698 $dbh->rollback if $oldAutoCommit;
1699 return "$@ running calc_setup for $cust_pkg\n";
1702 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1706 # bill recurring fee
1711 if ( $part_pkg->getfield('freq') ne '0' &&
1712 ! $cust_pkg->getfield('susp') &&
1713 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1716 warn " bill recur\n" if $DEBUG > 1;
1718 # XXX shared with $recur_prog
1719 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1721 #over two params! lets at least switch to a hashref for the rest...
1722 my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1724 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1726 $dbh->rollback if $oldAutoCommit;
1727 return "$@ running calc_recur for $cust_pkg\n";
1730 #change this bit to use Date::Manip? CAREFUL with timezones (see
1731 # mailing list archive)
1732 my ($sec,$min,$hour,$mday,$mon,$year) =
1733 (localtime($sdate) )[0,1,2,3,4,5];
1735 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1736 # only for figuring next bill date, nothing else, so, reset $sdate again
1738 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1739 $cust_pkg->last_bill($sdate)
1740 if $cust_pkg->dbdef_table->column('last_bill');
1742 if ( $part_pkg->freq =~ /^\d+$/ ) {
1743 $mon += $part_pkg->freq;
1744 until ( $mon < 12 ) { $mon -= 12; $year++; }
1745 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1747 $mday += $weeks * 7;
1748 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1751 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1755 $dbh->rollback if $oldAutoCommit;
1756 return "unparsable frequency: ". $part_pkg->freq;
1758 $cust_pkg->setfield('bill',
1759 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1762 warn "\$setup is undefined" unless defined($setup);
1763 warn "\$recur is undefined" unless defined($recur);
1764 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1767 # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1770 if ( $cust_pkg->modified ) {
1772 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1775 $error=$cust_pkg->replace($old_cust_pkg);
1776 if ( $error ) { #just in case
1777 $dbh->rollback if $oldAutoCommit;
1778 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1781 $setup = sprintf( "%.2f", $setup );
1782 $recur = sprintf( "%.2f", $recur );
1783 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1784 $dbh->rollback if $oldAutoCommit;
1785 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1787 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1788 $dbh->rollback if $oldAutoCommit;
1789 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1792 if ( $setup != 0 || $recur != 0 ) {
1794 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1796 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1797 'invnum' => $invnum,
1798 'pkgnum' => $cust_pkg->pkgnum,
1802 'edate' => $cust_pkg->bill,
1803 'details' => \@details,
1805 $error = $cust_bill_pkg->insert;
1807 $dbh->rollback if $oldAutoCommit;
1808 return "can't create invoice line item for invoice #$invnum: $error";
1810 $total_setup += $setup;
1811 $total_recur += $recur;
1817 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1820 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1823 my %taxhash = map { $_ => $self->get("$prefix$_") }
1824 qw( state county country );
1826 $taxhash{'taxclass'} = $part_pkg->taxclass;
1828 my @taxes = qsearch( 'cust_main_county', \%taxhash );
1831 $taxhash{'taxclass'} = '';
1832 @taxes = qsearch( 'cust_main_county', \%taxhash );
1835 #one more try at a whole-country tax rate
1837 $taxhash{$_} = '' foreach qw( state county );
1838 @taxes = qsearch( 'cust_main_county', \%taxhash );
1841 # maybe eliminate this entirely, along with all the 0% records
1843 $dbh->rollback if $oldAutoCommit;
1845 "fatal: can't find tax rate for state/county/country/taxclass ".
1846 join('/', ( map $self->get("$prefix$_"),
1847 qw(state county country)
1849 $part_pkg->taxclass ). "\n";
1852 foreach my $tax ( @taxes ) {
1854 my $taxable_charged = 0;
1855 $taxable_charged += $setup
1856 unless $part_pkg->setuptax =~ /^Y$/i
1857 || $tax->setuptax =~ /^Y$/i;
1858 $taxable_charged += $recur
1859 unless $part_pkg->recurtax =~ /^Y$/i
1860 || $tax->recurtax =~ /^Y$/i;
1861 next unless $taxable_charged;
1863 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1864 #my ($mon,$year) = (localtime($sdate) )[4,5];
1865 my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1867 my $freq = $part_pkg->freq || 1;
1868 if ( $freq !~ /(\d+)$/ ) {
1869 $dbh->rollback if $oldAutoCommit;
1870 return "daily/weekly package definitions not (yet?)".
1871 " compatible with monthly tax exemptions";
1873 my $taxable_per_month =
1874 sprintf("%.2f", $taxable_charged / $freq );
1876 #call the whole thing off if this customer has any old
1877 #exemption records...
1878 my @cust_tax_exempt =
1879 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1880 if ( @cust_tax_exempt ) {
1881 $dbh->rollback if $oldAutoCommit;
1883 'this customer still has old-style tax exemption records; '.
1884 'run bin/fs-migrate-cust_tax_exempt?';
1887 foreach my $which_month ( 1 .. $freq ) {
1889 #maintain the new exemption table now
1892 FROM cust_tax_exempt_pkg
1893 LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1894 LEFT JOIN cust_bill USING ( invnum )
1900 my $sth = dbh->prepare($sql) or do {
1901 $dbh->rollback if $oldAutoCommit;
1902 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1910 $dbh->rollback if $oldAutoCommit;
1911 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1913 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1915 my $remaining_exemption =
1916 $tax->exempt_amount - $existing_exemption;
1917 if ( $remaining_exemption > 0 ) {
1918 my $addl = $remaining_exemption > $taxable_per_month
1919 ? $taxable_per_month
1920 : $remaining_exemption;
1921 $taxable_charged -= $addl;
1923 my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1924 'billpkgnum' => $cust_bill_pkg->billpkgnum,
1925 'taxnum' => $tax->taxnum,
1926 'year' => 1900+$year,
1928 'amount' => sprintf("%.2f", $addl ),
1930 $error = $cust_tax_exempt_pkg->insert;
1932 $dbh->rollback if $oldAutoCommit;
1933 return "fatal: can't insert cust_tax_exempt_pkg: $error";
1935 } # if $remaining_exemption > 0
1939 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1940 until ( $mon < 13 ) { $mon -= 12; $year++; }
1942 } #foreach $which_month
1944 } #if $tax->exempt_amount
1946 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1948 #$tax += $taxable_charged * $cust_main_county->tax / 100
1949 $tax{ $tax->taxname || 'Tax' } +=
1950 $taxable_charged * $tax->tax / 100
1952 } #foreach my $tax ( @taxes )
1954 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1956 } #if $setup != 0 || $recur != 0
1958 } #if $cust_pkg->modified
1960 } #foreach my $cust_pkg
1962 unless ( $cust_bill->cust_bill_pkg ) {
1963 $cust_bill->delete; #don't create an invoice w/o line items
1964 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1968 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1970 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1971 my $tax = sprintf("%.2f", $tax{$taxname} );
1972 $charged = sprintf( "%.2f", $charged+$tax );
1974 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1975 'invnum' => $invnum,
1981 'itemdesc' => $taxname,
1983 $error = $cust_bill_pkg->insert;
1985 $dbh->rollback if $oldAutoCommit;
1986 return "can't create invoice line item for invoice #$invnum: $error";
1988 $total_setup += $tax;
1992 $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1993 $error = $cust_bill->replace;
1995 $dbh->rollback if $oldAutoCommit;
1996 return "can't update charged for invoice #$invnum: $error";
1999 foreach my $hook ( @precommit_hooks ) {
2001 &{$hook}; #($self) ?
2004 $dbh->rollback if $oldAutoCommit;
2005 return "$@ running precommit hook $hook\n";
2009 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2013 =item collect OPTIONS
2015 (Attempt to) collect money for this customer's outstanding invoices (see
2016 L<FS::cust_bill>). Usually used after the bill method.
2018 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2019 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2020 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2022 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2023 and the invoice events web interface.
2025 If there is an error, returns the error, otherwise returns false.
2027 Options are passed as name-value pairs.
2029 Currently available options are:
2031 invoice_time - Use this time when deciding when to print invoices and
2032 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>
2033 for conversion functions.
2035 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2038 quiet - set true to surpress email card/ACH decline notices.
2040 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2046 my( $self, %options ) = @_;
2047 my $invoice_time = $options{'invoice_time'} || time;
2050 local $SIG{HUP} = 'IGNORE';
2051 local $SIG{INT} = 'IGNORE';
2052 local $SIG{QUIT} = 'IGNORE';
2053 local $SIG{TERM} = 'IGNORE';
2054 local $SIG{TSTP} = 'IGNORE';
2055 local $SIG{PIPE} = 'IGNORE';
2057 my $oldAutoCommit = $FS::UID::AutoCommit;
2058 local $FS::UID::AutoCommit = 0;
2061 $self->select_for_update; #mutex
2063 my $balance = $self->balance;
2064 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2066 unless ( $balance > 0 ) { #redundant?????
2067 $dbh->rollback if $oldAutoCommit; #hmm
2071 if ( exists($options{'retry_card'}) ) {
2072 carp 'retry_card option passed to collect is deprecated; use retry';
2073 $options{'retry'} ||= $options{'retry_card'};
2075 if ( exists($options{'retry'}) && $options{'retry'} ) {
2076 my $error = $self->retry_realtime;
2078 $dbh->rollback if $oldAutoCommit;
2084 if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2085 $extra_sql = " AND freq = '1m' ";
2087 $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2090 foreach my $cust_bill ( $self->open_cust_bill ) {
2092 # don't try to charge for the same invoice if it's already in a batch
2093 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2095 last if $self->balance <= 0;
2097 warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2100 foreach my $part_bill_event (
2101 sort { $a->seconds <=> $b->seconds
2102 || $a->weight <=> $b->weight
2103 || $a->eventpart <=> $b->eventpart }
2104 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2105 && ! qsearch( 'cust_bill_event', {
2106 'invnum' => $cust_bill->invnum,
2107 'eventpart' => $_->eventpart,
2112 'table' => 'part_bill_event',
2113 'hashref' => { 'payby' => $self->payby,
2114 'disabled' => '', },
2115 'extra_sql' => $extra_sql,
2119 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2120 || $self->balance <= 0; # or if balance<=0
2122 warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
2124 my $cust_main = $self; #for callback
2128 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2129 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2130 $error = eval $part_bill_event->eventcode;
2134 my $statustext = '';
2138 } elsif ( $error ) {
2140 $statustext = $error;
2145 #add cust_bill_event
2146 my $cust_bill_event = new FS::cust_bill_event {
2147 'invnum' => $cust_bill->invnum,
2148 'eventpart' => $part_bill_event->eventpart,
2149 #'_date' => $invoice_time,
2151 'status' => $status,
2152 'statustext' => $statustext,
2154 $error = $cust_bill_event->insert;
2156 #$dbh->rollback if $oldAutoCommit;
2157 #return "error: $error";
2159 # gah, even with transactions.
2160 $dbh->commit if $oldAutoCommit; #well.
2161 my $e = 'WARNING: Event run but database not updated - '.
2162 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2163 ', eventpart '. $part_bill_event->eventpart.
2174 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2179 =item retry_realtime
2181 Schedules realtime credit card / electronic check / LEC billing events for
2182 for retry. Useful if card information has changed or manual retry is desired.
2183 The 'collect' method must be called to actually retry the transaction.
2185 Implementation details: For each of this customer's open invoices, changes
2186 the status of the first "done" (with statustext error) realtime processing
2191 sub retry_realtime {
2194 local $SIG{HUP} = 'IGNORE';
2195 local $SIG{INT} = 'IGNORE';
2196 local $SIG{QUIT} = 'IGNORE';
2197 local $SIG{TERM} = 'IGNORE';
2198 local $SIG{TSTP} = 'IGNORE';
2199 local $SIG{PIPE} = 'IGNORE';
2201 my $oldAutoCommit = $FS::UID::AutoCommit;
2202 local $FS::UID::AutoCommit = 0;
2205 foreach my $cust_bill (
2206 grep { $_->cust_bill_event }
2207 $self->open_cust_bill
2209 my @cust_bill_event =
2210 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2212 #$_->part_bill_event->plan eq 'realtime-card'
2213 $_->part_bill_event->eventcode =~
2214 /\$cust_bill\->realtime_(card|ach|lec)/
2215 && $_->status eq 'done'
2218 $cust_bill->cust_bill_event;
2219 next unless @cust_bill_event;
2220 my $error = $cust_bill_event[0]->retry;
2222 $dbh->rollback if $oldAutoCommit;
2223 return "error scheduling invoice event for retry: $error";
2228 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2233 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2235 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2236 via a Business::OnlinePayment realtime gateway. See
2237 L<http://420.am/business-onlinepayment> for supported gateways.
2239 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2241 Available options are: I<description>, I<invnum>, I<quiet>
2243 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2244 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2245 if set, will override the value from the customer record.
2247 I<description> is a free-text field passed to the gateway. It defaults to
2248 "Internet services".
2250 If an I<invnum> is specified, this payment (if successful) is applied to the
2251 specified invoice. If you don't specify an I<invnum> you might want to
2252 call the B<apply_payments> method.
2254 I<quiet> can be set true to surpress email decline notices.
2256 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2261 my( $self, $method, $amount, %options ) = @_;
2263 warn "$me realtime_bop: $method $amount\n";
2264 warn " $_ => $options{$_}\n" foreach keys %options;
2267 $options{'description'} ||= 'Internet services';
2269 eval "use Business::OnlinePayment";
2272 my $payinfo = exists($options{'payinfo'})
2273 ? $options{'payinfo'}
2281 if ( $options{'invnum'} ) {
2282 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2283 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2285 map { $_->part_pkg->taxclass }
2287 map { $_->cust_pkg }
2288 $cust_bill->cust_bill_pkg;
2289 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2290 #different taxclasses
2291 $taxclass = $taxclasses[0];
2295 #look for an agent gateway override first
2297 if ( $method eq 'CC' ) {
2298 $cardtype = cardtype($payinfo);
2299 } elsif ( $method eq 'ECHECK' ) {
2302 $cardtype = $method;
2306 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2307 cardtype => $cardtype,
2308 taxclass => $taxclass, } )
2309 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2311 taxclass => $taxclass, } )
2312 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2313 cardtype => $cardtype,
2315 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2317 taxclass => '', } );
2319 my $payment_gateway = '';
2320 my( $processor, $login, $password, $action, @bop_options );
2321 if ( $override ) { #use a payment gateway override
2323 $payment_gateway = $override->payment_gateway;
2325 $processor = $payment_gateway->gateway_module;
2326 $login = $payment_gateway->gateway_username;
2327 $password = $payment_gateway->gateway_password;
2328 $action = $payment_gateway->gateway_action;
2329 @bop_options = $payment_gateway->options;
2331 } else { #use the standard settings from the config
2333 ( $processor, $login, $password, $action, @bop_options ) =
2334 $self->default_payment_gateway($method);
2342 my $address = exists($options{'address1'})
2343 ? $options{'address1'}
2345 my $address2 = exists($options{'address2'})
2346 ? $options{'address2'}
2348 $address .= ", ". $address2 if length($address2);
2350 my $o_payname = exists($options{'payname'})
2351 ? $options{'payname'}
2353 my($payname, $payfirst, $paylast);
2354 if ( $o_payname && $method ne 'ECHECK' ) {
2355 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2356 or return "Illegal payname $payname";
2357 ($payfirst, $paylast) = ($1, $2);
2359 $payfirst = $self->getfield('first');
2360 $paylast = $self->getfield('last');
2361 $payname = "$payfirst $paylast";
2364 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2365 if ( $conf->exists('emailinvoiceauto')
2366 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2367 push @invoicing_list, $self->all_emails;
2370 my $email = ($conf->exists('business-onlinepayment-email-override'))
2371 ? $conf->config('business-onlinepayment-email-override')
2372 : $invoicing_list[0];
2376 my $payip = exists($options{'payip'})
2379 $content{customer_ip} = $payip
2382 if ( $method eq 'CC' ) {
2384 $content{card_number} = $payinfo;
2385 my $paydate = exists($options{'paydate'})
2386 ? $options{'paydate'}
2388 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2389 $content{expiration} = "$2/$1";
2391 my $paycvv = exists($options{'paycvv'})
2392 ? $options{'paycvv'}
2394 $content{cvv2} = $self->paycvv
2397 my $paystart_month = exists($options{'paystart_month'})
2398 ? $options{'paystart_month'}
2399 : $self->paystart_month;
2401 my $paystart_year = exists($options{'paystart_year'})
2402 ? $options{'paystart_year'}
2403 : $self->paystart_year;
2405 $content{card_start} = "$paystart_month/$paystart_year"
2406 if $paystart_month && $paystart_year;
2408 my $payissue = exists($options{'payissue'})
2409 ? $options{'payissue'}
2411 $content{issue_number} = $payissue if $payissue;
2413 $content{recurring_billing} = 'YES'
2414 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2416 'payinfo' => $payinfo,
2419 } elsif ( $method eq 'ECHECK' ) {
2420 ( $content{account_number}, $content{routing_code} ) =
2421 split('@', $payinfo);
2422 $content{bank_name} = $o_payname;
2423 $content{account_type} = 'CHECKING';
2424 $content{account_name} = $payname;
2425 $content{customer_org} = $self->company ? 'B' : 'I';
2426 $content{customer_ssn} = exists($options{'ss'})
2429 } elsif ( $method eq 'LEC' ) {
2430 $content{phone} = $payinfo;
2434 # run transaction(s)
2437 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2439 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2440 $transaction->content(
2443 'password' => $password,
2444 'action' => $action1,
2445 'description' => $options{'description'},
2446 'amount' => $amount,
2447 'invoice_number' => $options{'invnum'},
2448 'customer_id' => $self->custnum,
2449 'last_name' => $paylast,
2450 'first_name' => $payfirst,
2452 'address' => $address,
2453 'city' => ( exists($options{'city'})
2456 'state' => ( exists($options{'state'})
2459 'zip' => ( exists($options{'zip'})
2462 'country' => ( exists($options{'country'})
2463 ? $options{'country'}
2465 'referer' => 'http://cleanwhisker.420.am/',
2467 'phone' => $self->daytime || $self->night,
2470 $transaction->submit();
2472 if ( $transaction->is_success() && $action2 ) {
2473 my $auth = $transaction->authorization;
2474 my $ordernum = $transaction->can('order_number')
2475 ? $transaction->order_number
2479 new Business::OnlinePayment( $processor, @bop_options );
2486 password => $password,
2487 order_number => $ordernum,
2489 authorization => $auth,
2490 description => $options{'description'},
2493 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2494 transaction_sequence_num local_transaction_date
2495 local_transaction_time AVS_result_code )) {
2496 $capture{$field} = $transaction->$field() if $transaction->can($field);
2499 $capture->content( %capture );
2503 unless ( $capture->is_success ) {
2504 my $e = "Authorization successful but capture failed, custnum #".
2505 $self->custnum. ': '. $capture->result_code.
2506 ": ". $capture->error_message;
2514 # remove paycvv after initial transaction
2517 #false laziness w/misc/process/payment.cgi - check both to make sure working
2519 if ( defined $self->dbdef_table->column('paycvv')
2520 && length($self->paycvv)
2521 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2523 my $error = $self->remove_cvv;
2525 warn "WARNING: error removing cvv: $error\n";
2533 if ( $transaction->is_success() ) {
2535 my %method2payby = (
2542 if ( $payment_gateway ) { # agent override
2543 $paybatch = $payment_gateway->gatewaynum. '-';
2546 $paybatch .= "$processor:". $transaction->authorization;
2548 $paybatch .= ':'. $transaction->order_number
2549 if $transaction->can('order_number')
2550 && length($transaction->order_number);
2552 my $cust_pay = new FS::cust_pay ( {
2553 'custnum' => $self->custnum,
2554 'invnum' => $options{'invnum'},
2557 'payby' => $method2payby{$method},
2558 'payinfo' => $payinfo,
2559 'paybatch' => $paybatch,
2561 my $error = $cust_pay->insert;
2563 $cust_pay->invnum(''); #try again with no specific invnum
2564 my $error2 = $cust_pay->insert;
2566 # gah, even with transactions.
2567 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2568 "error inserting payment ($processor): $error2".
2569 " (previously tried insert with invnum #$options{'invnum'}" .
2575 return ''; #no error
2579 my $perror = "$processor error: ". $transaction->error_message;
2581 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2582 && $conf->exists('emaildecline')
2583 && grep { $_ ne 'POST' } $self->invoicing_list
2584 && ! grep { $transaction->error_message =~ /$_/ }
2585 $conf->config('emaildecline-exclude')
2587 my @templ = $conf->config('declinetemplate');
2588 my $template = new Text::Template (
2590 SOURCE => [ map "$_\n", @templ ],
2591 ) or return "($perror) can't create template: $Text::Template::ERROR";
2592 $template->compile()
2593 or return "($perror) can't compile template: $Text::Template::ERROR";
2595 my $templ_hash = { error => $transaction->error_message };
2597 my $error = send_email(
2598 'from' => $conf->config('invoice_from'),
2599 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2600 'subject' => 'Your payment could not be processed',
2601 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2604 $perror .= " (also received error sending decline notification: $error)"
2614 =item default_payment_gateway
2618 sub default_payment_gateway {
2619 my( $self, $method ) = @_;
2621 die "Real-time processing not enabled\n"
2622 unless $conf->exists('business-onlinepayment');
2625 my $bop_config = 'business-onlinepayment';
2626 $bop_config .= '-ach'
2627 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2628 my ( $processor, $login, $password, $action, @bop_options ) =
2629 $conf->config($bop_config);
2630 $action ||= 'normal authorization';
2631 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2632 die "No real-time processor is enabled - ".
2633 "did you set the business-onlinepayment configuration value?\n"
2636 ( $processor, $login, $password, $action, @bop_options )
2641 Removes the I<paycvv> field from the database directly.
2643 If there is an error, returns the error, otherwise returns false.
2649 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2650 or return dbh->errstr;
2651 $sth->execute($self->custnum)
2652 or return $sth->errstr;
2657 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2659 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2660 via a Business::OnlinePayment realtime gateway. See
2661 L<http://420.am/business-onlinepayment> for supported gateways.
2663 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2665 Available options are: I<amount>, I<reason>, I<paynum>
2667 Most gateways require a reference to an original payment transaction to refund,
2668 so you probably need to specify a I<paynum>.
2670 I<amount> defaults to the original amount of the payment if not specified.
2672 I<reason> specifies a reason for the refund.
2674 Implementation note: If I<amount> is unspecified or equal to the amount of the
2675 orignal payment, first an attempt is made to "void" the transaction via
2676 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2677 the normal attempt is made to "refund" ("credit") the transaction via the
2678 gateway is attempted.
2680 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2681 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2682 #if set, will override the value from the customer record.
2684 #If an I<invnum> is specified, this payment (if successful) is applied to the
2685 #specified invoice. If you don't specify an I<invnum> you might want to
2686 #call the B<apply_payments> method.
2690 #some false laziness w/realtime_bop, not enough to make it worth merging
2691 #but some useful small subs should be pulled out
2692 sub realtime_refund_bop {
2693 my( $self, $method, %options ) = @_;
2695 warn "$me realtime_refund_bop: $method refund\n";
2696 warn " $_ => $options{$_}\n" foreach keys %options;
2699 eval "use Business::OnlinePayment";
2703 # look up the original payment and optionally a gateway for that payment
2707 my $amount = $options{'amount'};
2709 my( $processor, $login, $password, @bop_options ) ;
2710 my( $auth, $order_number ) = ( '', '', '' );
2712 if ( $options{'paynum'} ) {
2714 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
2715 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2716 or return "Unknown paynum $options{'paynum'}";
2717 $amount ||= $cust_pay->paid;
2719 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2720 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2721 $cust_pay->paybatch;
2722 my $gatewaynum = '';
2723 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2725 if ( $gatewaynum ) { #gateway for the payment to be refunded
2727 my $payment_gateway =
2728 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2729 die "payment gateway $gatewaynum not found"
2730 unless $payment_gateway;
2732 $processor = $payment_gateway->gateway_module;
2733 $login = $payment_gateway->gateway_username;
2734 $password = $payment_gateway->gateway_password;
2735 @bop_options = $payment_gateway->options;
2737 } else { #try the default gateway
2739 my( $conf_processor, $unused_action );
2740 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2741 $self->default_payment_gateway($method);
2743 return "processor of payment $options{'paynum'} $processor does not".
2744 " match default processor $conf_processor"
2745 unless $processor eq $conf_processor;
2750 } else { # didn't specify a paynum, so look for agent gateway overrides
2751 # like a normal transaction
2754 if ( $method eq 'CC' ) {
2755 $cardtype = cardtype($self->payinfo);
2756 } elsif ( $method eq 'ECHECK' ) {
2759 $cardtype = $method;
2762 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2763 cardtype => $cardtype,
2765 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2767 taxclass => '', } );
2769 if ( $override ) { #use a payment gateway override
2771 my $payment_gateway = $override->payment_gateway;
2773 $processor = $payment_gateway->gateway_module;
2774 $login = $payment_gateway->gateway_username;
2775 $password = $payment_gateway->gateway_password;
2776 #$action = $payment_gateway->gateway_action;
2777 @bop_options = $payment_gateway->options;
2779 } else { #use the standard settings from the config
2782 ( $processor, $login, $password, $unused_action, @bop_options ) =
2783 $self->default_payment_gateway($method);
2788 return "neither amount nor paynum specified" unless $amount;
2793 'password' => $password,
2794 'order_number' => $order_number,
2795 'amount' => $amount,
2796 'referer' => 'http://cleanwhisker.420.am/',
2798 $content{authorization} = $auth
2799 if length($auth); #echeck/ACH transactions have an order # but no auth
2800 #(at least with authorize.net)
2802 #first try void if applicable
2803 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2804 warn " attempting void\n" if $DEBUG > 1;
2805 my $void = new Business::OnlinePayment( $processor, @bop_options );
2806 $void->content( 'action' => 'void', %content );
2808 if ( $void->is_success ) {
2809 my $error = $cust_pay->void($options{'reason'});
2811 # gah, even with transactions.
2812 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2813 "error voiding payment: $error";
2817 warn " void successful\n" if $DEBUG > 1;
2822 warn " void unsuccessful, trying refund\n"
2826 my $address = $self->address1;
2827 $address .= ", ". $self->address2 if $self->address2;
2829 my($payname, $payfirst, $paylast);
2830 if ( $self->payname && $method ne 'ECHECK' ) {
2831 $payname = $self->payname;
2832 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2833 or return "Illegal payname $payname";
2834 ($payfirst, $paylast) = ($1, $2);
2836 $payfirst = $self->getfield('first');
2837 $paylast = $self->getfield('last');
2838 $payname = "$payfirst $paylast";
2842 if ( $method eq 'CC' ) {
2845 $content{card_number} = $payinfo = $cust_pay->payinfo;
2846 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2847 #$content{expiration} = "$2/$1";
2849 $content{card_number} = $payinfo = $self->payinfo;
2850 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2851 $content{expiration} = "$2/$1";
2854 } elsif ( $method eq 'ECHECK' ) {
2855 ( $content{account_number}, $content{routing_code} ) =
2856 split('@', $payinfo = $self->payinfo);
2857 $content{bank_name} = $self->payname;
2858 $content{account_type} = 'CHECKING';
2859 $content{account_name} = $payname;
2860 $content{customer_org} = $self->company ? 'B' : 'I';
2861 $content{customer_ssn} = $self->ss;
2862 } elsif ( $method eq 'LEC' ) {
2863 $content{phone} = $payinfo = $self->payinfo;
2867 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2868 my %sub_content = $refund->content(
2869 'action' => 'credit',
2870 'customer_id' => $self->custnum,
2871 'last_name' => $paylast,
2872 'first_name' => $payfirst,
2874 'address' => $address,
2875 'city' => $self->city,
2876 'state' => $self->state,
2877 'zip' => $self->zip,
2878 'country' => $self->country,
2881 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2885 return "$processor error: ". $refund->error_message
2886 unless $refund->is_success();
2888 my %method2payby = (
2894 my $paybatch = "$processor:". $refund->authorization;
2895 $paybatch .= ':'. $refund->order_number
2896 if $refund->can('order_number') && $refund->order_number;
2898 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2899 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2900 last unless @cust_bill_pay;
2901 my $cust_bill_pay = pop @cust_bill_pay;
2902 my $error = $cust_bill_pay->delete;
2906 my $cust_refund = new FS::cust_refund ( {
2907 'custnum' => $self->custnum,
2908 'paynum' => $options{'paynum'},
2909 'refund' => $amount,
2911 'payby' => $method2payby{$method},
2912 'payinfo' => $payinfo,
2913 'paybatch' => $paybatch,
2914 'reason' => $options{'reason'} || 'card or ACH refund',
2916 my $error = $cust_refund->insert;
2918 $cust_refund->paynum(''); #try again with no specific paynum
2919 my $error2 = $cust_refund->insert;
2921 # gah, even with transactions.
2922 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2923 "error inserting refund ($processor): $error2".
2924 " (previously tried insert with paynum #$options{'paynum'}" .
2937 Returns the total owed for this customer on all invoices
2938 (see L<FS::cust_bill/owed>).
2944 $self->total_owed_date(2145859200); #12/31/2037
2947 =item total_owed_date TIME
2949 Returns the total owed for this customer on all invoices with date earlier than
2950 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2951 see L<Time::Local> and L<Date::Parse> for conversion functions.
2955 sub total_owed_date {
2959 foreach my $cust_bill (
2960 grep { $_->_date <= $time }
2961 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2963 $total_bill += $cust_bill->owed;
2965 sprintf( "%.2f", $total_bill );
2968 =item apply_credits OPTION => VALUE ...
2970 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2971 to outstanding invoice balances in chronological order (or reverse
2972 chronological order if the I<order> option is set to B<newest>) and returns the
2973 value of any remaining unapplied credits available for refund (see
2974 L<FS::cust_refund>).
2982 return 0 unless $self->total_credited;
2984 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2985 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2987 my @invoices = $self->open_cust_bill;
2988 @invoices = sort { $b->_date <=> $a->_date } @invoices
2989 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2992 foreach my $cust_bill ( @invoices ) {
2995 if ( !defined($credit) || $credit->credited == 0) {
2996 $credit = pop @credits or last;
2999 if ($cust_bill->owed >= $credit->credited) {
3000 $amount=$credit->credited;
3002 $amount=$cust_bill->owed;
3005 my $cust_credit_bill = new FS::cust_credit_bill ( {
3006 'crednum' => $credit->crednum,
3007 'invnum' => $cust_bill->invnum,
3008 'amount' => $amount,
3010 my $error = $cust_credit_bill->insert;
3011 die $error if $error;
3013 redo if ($cust_bill->owed > 0);
3017 return $self->total_credited;
3020 =item apply_payments
3022 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3023 to outstanding invoice balances in chronological order.
3025 #and returns the value of any remaining unapplied payments.
3029 sub apply_payments {
3034 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3035 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3037 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3038 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3042 foreach my $cust_bill ( @invoices ) {
3045 if ( !defined($payment) || $payment->unapplied == 0 ) {
3046 $payment = pop @payments or last;
3049 if ( $cust_bill->owed >= $payment->unapplied ) {
3050 $amount = $payment->unapplied;
3052 $amount = $cust_bill->owed;
3055 my $cust_bill_pay = new FS::cust_bill_pay ( {
3056 'paynum' => $payment->paynum,
3057 'invnum' => $cust_bill->invnum,
3058 'amount' => $amount,
3060 my $error = $cust_bill_pay->insert;
3061 die $error if $error;
3063 redo if ( $cust_bill->owed > 0);
3067 return $self->total_unapplied_payments;
3070 =item total_credited
3072 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3073 customer. See L<FS::cust_credit/credited>.
3077 sub total_credited {
3079 my $total_credit = 0;
3080 foreach my $cust_credit ( qsearch('cust_credit', {
3081 'custnum' => $self->custnum,
3083 $total_credit += $cust_credit->credited;
3085 sprintf( "%.2f", $total_credit );
3088 =item total_unapplied_payments
3090 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3091 See L<FS::cust_pay/unapplied>.
3095 sub total_unapplied_payments {
3097 my $total_unapplied = 0;
3098 foreach my $cust_pay ( qsearch('cust_pay', {
3099 'custnum' => $self->custnum,
3101 $total_unapplied += $cust_pay->unapplied;
3103 sprintf( "%.2f", $total_unapplied );
3108 Returns the balance for this customer (total_owed minus total_credited
3109 minus total_unapplied_payments).
3116 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3120 =item balance_date TIME
3122 Returns the balance for this customer, only considering invoices with date
3123 earlier than TIME (total_owed_date minus total_credited minus
3124 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3125 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3134 $self->total_owed_date($time)
3135 - $self->total_credited
3136 - $self->total_unapplied_payments
3140 =item paydate_monthyear
3142 Returns a two-element list consisting of the month and year of this customer's
3143 paydate (credit card expiration date for CARD customers)
3147 sub paydate_monthyear {
3149 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3151 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3158 =item payinfo_masked
3160 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.
3162 Credit Cards - Mask all but the last four characters.
3163 Checks - Mask all but last 2 of account number and bank routing number.
3164 Others - Do nothing, return the unmasked string.
3168 sub payinfo_masked {
3170 return $self->paymask;
3173 =item invoicing_list [ ARRAYREF ]
3175 If an arguement is given, sets these email addresses as invoice recipients
3176 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3177 (except as warnings), so use check_invoicing_list first.
3179 Returns a list of email addresses (with svcnum entries expanded).
3181 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3182 check it without disturbing anything by passing nothing.
3184 This interface may change in the future.
3188 sub invoicing_list {
3189 my( $self, $arrayref ) = @_;
3192 my @cust_main_invoice;
3193 if ( $self->custnum ) {
3194 @cust_main_invoice =
3195 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3197 @cust_main_invoice = ();
3199 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3200 #warn $cust_main_invoice->destnum;
3201 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3202 #warn $cust_main_invoice->destnum;
3203 my $error = $cust_main_invoice->delete;
3204 warn $error if $error;
3207 if ( $self->custnum ) {
3208 @cust_main_invoice =
3209 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3211 @cust_main_invoice = ();
3213 my %seen = map { $_->address => 1 } @cust_main_invoice;
3214 foreach my $address ( @{$arrayref} ) {
3215 next if exists $seen{$address} && $seen{$address};
3216 $seen{$address} = 1;
3217 my $cust_main_invoice = new FS::cust_main_invoice ( {
3218 'custnum' => $self->custnum,
3221 my $error = $cust_main_invoice->insert;
3222 warn $error if $error;
3226 if ( $self->custnum ) {
3228 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3235 =item check_invoicing_list ARRAYREF
3237 Checks these arguements as valid input for the invoicing_list method. If there
3238 is an error, returns the error, otherwise returns false.
3242 sub check_invoicing_list {
3243 my( $self, $arrayref ) = @_;
3244 foreach my $address ( @{$arrayref} ) {
3246 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3247 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3250 my $cust_main_invoice = new FS::cust_main_invoice ( {
3251 'custnum' => $self->custnum,
3254 my $error = $self->custnum
3255 ? $cust_main_invoice->check
3256 : $cust_main_invoice->checkdest
3258 return $error if $error;
3263 =item set_default_invoicing_list
3265 Sets the invoicing list to all accounts associated with this customer,
3266 overwriting any previous invoicing list.
3270 sub set_default_invoicing_list {
3272 $self->invoicing_list($self->all_emails);
3277 Returns the email addresses of all accounts provisioned for this customer.
3284 foreach my $cust_pkg ( $self->all_pkgs ) {
3285 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3287 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3288 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3290 $list{$_}=1 foreach map { $_->email } @svc_acct;
3295 =item invoicing_list_addpost
3297 Adds postal invoicing to this customer. If this customer is already configured
3298 to receive postal invoices, does nothing.
3302 sub invoicing_list_addpost {
3304 return if grep { $_ eq 'POST' } $self->invoicing_list;
3305 my @invoicing_list = $self->invoicing_list;
3306 push @invoicing_list, 'POST';
3307 $self->invoicing_list(\@invoicing_list);
3310 =item invoicing_list_emailonly
3312 Returns the list of email invoice recipients (invoicing_list without non-email
3313 destinations such as POST and FAX).
3317 sub invoicing_list_emailonly {
3319 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3322 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3324 Returns an array of customers referred by this customer (referral_custnum set
3325 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3326 customers referred by customers referred by this customer and so on, inclusive.
3327 The default behavior is DEPTH 1 (no recursion).
3331 sub referral_cust_main {
3333 my $depth = @_ ? shift : 1;
3334 my $exclude = @_ ? shift : {};
3337 map { $exclude->{$_->custnum}++; $_; }
3338 grep { ! $exclude->{ $_->custnum } }
3339 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3343 map { $_->referral_cust_main($depth-1, $exclude) }
3350 =item referral_cust_main_ncancelled
3352 Same as referral_cust_main, except only returns customers with uncancelled
3357 sub referral_cust_main_ncancelled {
3359 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3362 =item referral_cust_pkg [ DEPTH ]
3364 Like referral_cust_main, except returns a flat list of all unsuspended (and
3365 uncancelled) packages for each customer. The number of items in this list may
3366 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3370 sub referral_cust_pkg {
3372 my $depth = @_ ? shift : 1;
3374 map { $_->unsuspended_pkgs }
3375 grep { $_->unsuspended_pkgs }
3376 $self->referral_cust_main($depth);
3379 =item referring_cust_main
3381 Returns the single cust_main record for the customer who referred this customer
3382 (referral_custnum), or false.
3386 sub referring_cust_main {
3388 return '' unless $self->referral_custnum;
3389 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3392 =item credit AMOUNT, REASON
3394 Applies a credit to this customer. If there is an error, returns the error,
3395 otherwise returns false.
3400 my( $self, $amount, $reason ) = @_;
3401 my $cust_credit = new FS::cust_credit {
3402 'custnum' => $self->custnum,
3403 'amount' => $amount,
3404 'reason' => $reason,
3406 $cust_credit->insert;
3409 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3411 Creates a one-time charge for this customer. If there is an error, returns
3412 the error, otherwise returns false.
3417 my ( $self, $amount ) = ( shift, shift );
3418 my $pkg = @_ ? shift : 'One-time charge';
3419 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3420 my $taxclass = @_ ? shift : '';
3422 local $SIG{HUP} = 'IGNORE';
3423 local $SIG{INT} = 'IGNORE';
3424 local $SIG{QUIT} = 'IGNORE';
3425 local $SIG{TERM} = 'IGNORE';
3426 local $SIG{TSTP} = 'IGNORE';
3427 local $SIG{PIPE} = 'IGNORE';
3429 my $oldAutoCommit = $FS::UID::AutoCommit;
3430 local $FS::UID::AutoCommit = 0;
3433 my $part_pkg = new FS::part_pkg ( {
3435 'comment' => $comment,
3436 #'setup' => $amount,
3439 'plandata' => "setup_fee=$amount",
3442 'taxclass' => $taxclass,
3445 my $error = $part_pkg->insert;
3447 $dbh->rollback if $oldAutoCommit;
3451 my $pkgpart = $part_pkg->pkgpart;
3452 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3453 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3454 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3455 $error = $type_pkgs->insert;
3457 $dbh->rollback if $oldAutoCommit;
3462 my $cust_pkg = new FS::cust_pkg ( {
3463 'custnum' => $self->custnum,
3464 'pkgpart' => $pkgpart,
3467 $error = $cust_pkg->insert;
3469 $dbh->rollback if $oldAutoCommit;
3473 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3480 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3486 sort { $a->_date <=> $b->_date }
3487 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3490 =item open_cust_bill
3492 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3497 sub open_cust_bill {
3499 grep { $_->owed > 0 } $self->cust_bill;
3504 Returns all the credits (see L<FS::cust_credit>) for this customer.
3510 sort { $a->_date <=> $b->_date }
3511 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3516 Returns all the payments (see L<FS::cust_pay>) for this customer.
3522 sort { $a->_date <=> $b->_date }
3523 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3528 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3534 sort { $a->_date <=> $b->_date }
3535 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3541 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3547 sort { $a->_date <=> $b->_date }
3548 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3551 =item select_for_update
3553 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3558 sub select_for_update {
3560 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3565 Returns a name string for this customer, either "Company (Last, First)" or
3572 my $name = $self->contact;
3573 $name = $self->company. " ($name)" if $self->company;
3579 Returns a name string for this (service/shipping) contact, either
3580 "Company (Last, First)" or "Last, First".
3586 if ( $self->get('ship_last') ) {
3587 my $name = $self->ship_contact;
3588 $name = $self->ship_company. " ($name)" if $self->ship_company;
3597 Returns this customer's full (billing) contact name only, "Last, First"
3603 $self->get('last'). ', '. $self->first;
3608 Returns this customer's full (shipping) contact name only, "Last, First"
3614 $self->get('ship_last')
3615 ? $self->get('ship_last'). ', '. $self->ship_first
3621 Returns this customer's full country name
3627 code2country($self->country);
3632 Returns a status string for this customer, currently:
3636 =item prospect - No packages have ever been ordered
3638 =item active - One or more recurring packages is active
3640 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3642 =item suspended - All non-cancelled recurring packages are suspended
3644 =item cancelled - All recurring packages are cancelled
3652 for my $status (qw( prospect active inactive suspended cancelled )) {
3653 my $method = $status.'_sql';
3654 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3655 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3656 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3657 return $status if $sth->fetchrow_arrayref->[0];
3663 Returns a hex triplet color string for this customer's status.
3672 'prospect' => '7e0079', #'000000', #black? naw, purple
3673 'active' => '00CC00', #green
3674 'inactive' => '0000CC', #blue
3675 'suspended' => 'FF9900', #yellow
3676 'cancelled' => 'FF0000', #red
3679 $statuscolor{$self->status};
3684 =head1 CLASS METHODS
3690 Returns an SQL expression identifying prospective cust_main records (customers
3691 with no packages ever ordered)
3695 use vars qw($select_count_pkgs);
3696 $select_count_pkgs =
3697 "SELECT COUNT(*) FROM cust_pkg
3698 WHERE cust_pkg.custnum = cust_main.custnum";
3700 sub prospect_sql { "
3701 0 = ( $select_count_pkgs )
3706 Returns an SQL expression identifying active cust_main records (customers with
3707 no active recurring packages, but otherwise unsuspended/uncancelled).
3712 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3718 Returns an SQL expression identifying inactive cust_main records (customers with
3719 active recurring packages).
3723 sub inactive_sql { "
3724 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3726 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3732 Returns an SQL expression identifying suspended cust_main records.
3737 sub suspended_sql { susp_sql(@_); }
3739 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3741 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3747 Returns an SQL expression identifying cancelled cust_main records.
3751 sub cancelled_sql { cancel_sql(@_); }
3754 my $recurring_sql = FS::cust_pkg->recurring_sql;
3755 #my $recurring_sql = "
3756 # '0' != ( select freq from part_pkg
3757 # where cust_pkg.pkgpart = part_pkg.pkgpart )
3761 0 < ( $select_count_pkgs )
3762 AND 0 = ( $select_count_pkgs AND $recurring_sql
3763 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3769 =item uncancelled_sql
3771 Returns an SQL expression identifying un-cancelled cust_main records.
3775 sub uncancelled_sql { uncancel_sql(@_); }
3776 sub uncancel_sql { "
3777 ( 0 < ( $select_count_pkgs
3778 AND ( cust_pkg.cancel IS NULL
3779 OR cust_pkg.cancel = 0
3782 OR 0 = ( $select_count_pkgs )
3786 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3788 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3789 records. Currently, only I<last> or I<company> may be specified (the
3790 appropriate ship_ field is also searched if applicable).
3792 Additional options are the same as FS::Record::qsearch
3797 my( $self, $fuzzy, $hash, @opt) = @_;
3802 check_and_rebuild_fuzzyfiles();
3803 foreach my $field ( keys %$fuzzy ) {
3804 my $sub = \&{"all_$field"};
3806 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3808 foreach ( keys %match ) {
3809 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3810 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3811 if defined dbdef->table('cust_main')->column('ship_last');
3816 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3828 =item smart_search OPTION => VALUE ...
3830 Accepts the following options: I<search>, the string to search for. The string
3831 will be searched for as a customer number, last name or company name, first
3832 searching for an exact match then fuzzy and substring matches.
3834 Any additional options treated as an additional qualifier on the search
3837 Returns a (possibly empty) array of FS::cust_main objects.
3843 my $search = delete $options{'search'};
3845 #here is the agent virtualization
3846 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
3849 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3851 push @cust_main, qsearch( {
3852 'table' => 'cust_main',
3853 'hashref' => { 'custnum' => $1, %options },
3854 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3857 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3860 my $q_value = dbh->quote($value);
3863 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3864 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3865 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3866 if defined dbdef->table('cust_main')->column('ship_last');
3869 push @cust_main, qsearch( {
3870 'table' => 'cust_main',
3871 'hashref' => \%options,
3872 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
3875 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3877 #still some false laziness w/ search/cust_main.cgi
3880 push @cust_main, qsearch( {
3881 'table' => 'cust_main',
3882 'hashref' => { 'last' => { 'op' => 'ILIKE',
3883 'value' => "%$q_value%" },
3886 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
3888 push @cust_main, qsearch( {
3889 'table' => 'cust_main',
3890 'hashref' => { 'ship_last' => { 'op' => 'ILIKE',
3891 'value' => "%$q_value%" },
3894 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3896 if defined dbdef->table('cust_main')->column('ship_last');
3898 push @cust_main, qsearch( {
3899 'table' => 'cust_main',
3900 'hashref' => { 'company' => { 'op' => 'ILIKE',
3901 'value' => "%$q_value%" },
3904 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3906 push @cust_main, qsearch( {
3907 'table' => 'cust_main',
3908 'hashref' => { 'ship_company' => { 'op' => 'ILIKE',
3909 'value' => "%$q_value%" },
3912 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3914 if defined dbdef->table('cust_main')->column('ship_last');
3917 push @cust_main, FS::cust_main->fuzzy_search(
3918 { 'last' => $value }, #fuzzy hashref
3921 " AND $agentnums_sql", #extra_sql #agent virtualization
3923 push @cust_main, FS::cust_main->fuzzy_search(
3924 { 'company' => $value }, #fuzzy hashref
3927 " AND $agentnums_sql", #extra_sql #agent virtualization
3938 =item check_and_rebuild_fuzzyfiles
3942 sub check_and_rebuild_fuzzyfiles {
3943 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3944 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3945 or &rebuild_fuzzyfiles;
3948 =item rebuild_fuzzyfiles
3952 sub rebuild_fuzzyfiles {
3954 use Fcntl qw(:flock);
3956 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3957 mkdir $dir, 0700 unless -d $dir;
3961 open(LASTLOCK,">>$dir/cust_main.last")
3962 or die "can't open $dir/cust_main.last: $!";
3963 flock(LASTLOCK,LOCK_EX)
3964 or die "can't lock $dir/cust_main.last: $!";
3966 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3968 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3969 if defined dbdef->table('cust_main')->column('ship_last');
3971 open (LASTCACHE,">$dir/cust_main.last.tmp")
3972 or die "can't open $dir/cust_main.last.tmp: $!";
3973 print LASTCACHE join("\n", @all_last), "\n";
3974 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3976 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3981 open(COMPANYLOCK,">>$dir/cust_main.company")
3982 or die "can't open $dir/cust_main.company: $!";
3983 flock(COMPANYLOCK,LOCK_EX)
3984 or die "can't lock $dir/cust_main.company: $!";
3986 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3988 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3989 if defined dbdef->table('cust_main')->column('ship_last');
3991 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3992 or die "can't open $dir/cust_main.company.tmp: $!";
3993 print COMPANYCACHE join("\n", @all_company), "\n";
3994 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3996 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
4006 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4007 open(LASTCACHE,"<$dir/cust_main.last")
4008 or die "can't open $dir/cust_main.last: $!";
4009 my @array = map { chomp; $_; } <LASTCACHE>;
4019 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4020 open(COMPANYCACHE,"<$dir/cust_main.company")
4021 or die "can't open $dir/cust_main.last: $!";
4022 my @array = map { chomp; $_; } <COMPANYCACHE>;
4027 =item append_fuzzyfiles LASTNAME COMPANY
4031 sub append_fuzzyfiles {
4032 my( $last, $company ) = @_;
4034 &check_and_rebuild_fuzzyfiles;
4036 use Fcntl qw(:flock);
4038 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4042 open(LAST,">>$dir/cust_main.last")
4043 or die "can't open $dir/cust_main.last: $!";
4045 or die "can't lock $dir/cust_main.last: $!";
4047 print LAST "$last\n";
4050 or die "can't unlock $dir/cust_main.last: $!";
4056 open(COMPANY,">>$dir/cust_main.company")
4057 or die "can't open $dir/cust_main.company: $!";
4058 flock(COMPANY,LOCK_EX)
4059 or die "can't lock $dir/cust_main.company: $!";
4061 print COMPANY "$company\n";
4063 flock(COMPANY,LOCK_UN)
4064 or die "can't unlock $dir/cust_main.company: $!";
4078 #warn join('-',keys %$param);
4079 my $fh = $param->{filehandle};
4080 my $agentnum = $param->{agentnum};
4081 my $refnum = $param->{refnum};
4082 my $pkgpart = $param->{pkgpart};
4083 my @fields = @{$param->{fields}};
4085 eval "use Text::CSV_XS;";
4088 my $csv = new Text::CSV_XS;
4095 local $SIG{HUP} = 'IGNORE';
4096 local $SIG{INT} = 'IGNORE';
4097 local $SIG{QUIT} = 'IGNORE';
4098 local $SIG{TERM} = 'IGNORE';
4099 local $SIG{TSTP} = 'IGNORE';
4100 local $SIG{PIPE} = 'IGNORE';
4102 my $oldAutoCommit = $FS::UID::AutoCommit;
4103 local $FS::UID::AutoCommit = 0;
4106 #while ( $columns = $csv->getline($fh) ) {
4108 while ( defined($line=<$fh>) ) {
4110 $csv->parse($line) or do {
4111 $dbh->rollback if $oldAutoCommit;
4112 return "can't parse: ". $csv->error_input();
4115 my @columns = $csv->fields();
4116 #warn join('-',@columns);
4119 agentnum => $agentnum,
4121 country => $conf->config('countrydefault') || 'US',
4122 payby => 'BILL', #default
4123 paydate => '12/2037', #default
4125 my $billtime = time;
4126 my %cust_pkg = ( pkgpart => $pkgpart );
4127 foreach my $field ( @fields ) {
4128 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4129 #$cust_pkg{$1} = str2time( shift @$columns );
4130 if ( $1 eq 'setup' ) {
4131 $billtime = str2time(shift @columns);
4133 $cust_pkg{$1} = str2time( shift @columns );
4136 #$cust_main{$field} = shift @$columns;
4137 $cust_main{$field} = shift @columns;
4141 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4142 my $cust_main = new FS::cust_main ( \%cust_main );
4144 tie my %hash, 'Tie::RefHash'; #this part is important
4145 $hash{$cust_pkg} = [] if $pkgpart;
4146 my $error = $cust_main->insert( \%hash );
4149 $dbh->rollback if $oldAutoCommit;
4150 return "can't insert customer for $line: $error";
4153 #false laziness w/bill.cgi
4154 $error = $cust_main->bill( 'time' => $billtime );
4156 $dbh->rollback if $oldAutoCommit;
4157 return "can't bill customer for $line: $error";
4160 $cust_main->apply_payments;
4161 $cust_main->apply_credits;
4163 $error = $cust_main->collect();
4165 $dbh->rollback if $oldAutoCommit;
4166 return "can't collect customer for $line: $error";
4172 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4174 return "Empty file!" unless $imported;
4186 #warn join('-',keys %$param);
4187 my $fh = $param->{filehandle};
4188 my @fields = @{$param->{fields}};
4190 eval "use Text::CSV_XS;";
4193 my $csv = new Text::CSV_XS;
4200 local $SIG{HUP} = 'IGNORE';
4201 local $SIG{INT} = 'IGNORE';
4202 local $SIG{QUIT} = 'IGNORE';
4203 local $SIG{TERM} = 'IGNORE';
4204 local $SIG{TSTP} = 'IGNORE';
4205 local $SIG{PIPE} = 'IGNORE';
4207 my $oldAutoCommit = $FS::UID::AutoCommit;
4208 local $FS::UID::AutoCommit = 0;
4211 #while ( $columns = $csv->getline($fh) ) {
4213 while ( defined($line=<$fh>) ) {
4215 $csv->parse($line) or do {
4216 $dbh->rollback if $oldAutoCommit;
4217 return "can't parse: ". $csv->error_input();
4220 my @columns = $csv->fields();
4221 #warn join('-',@columns);
4224 foreach my $field ( @fields ) {
4225 $row{$field} = shift @columns;
4228 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4229 unless ( $cust_main ) {
4230 $dbh->rollback if $oldAutoCommit;
4231 return "unknown custnum $row{'custnum'}";
4234 if ( $row{'amount'} > 0 ) {
4235 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4237 $dbh->rollback if $oldAutoCommit;
4241 } elsif ( $row{'amount'} < 0 ) {
4242 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4245 $dbh->rollback if $oldAutoCommit;
4255 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4257 return "Empty file!" unless $imported;
4269 The delete method should possibly take an FS::cust_main object reference
4270 instead of a scalar customer number.
4272 Bill and collect options should probably be passed as references instead of a
4275 There should probably be a configuration file with a list of allowed credit
4278 No multiple currency support (probably a larger project than just this module).
4280 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4284 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4285 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4286 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.