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 my $curuser = $FS::CurrentUser::CurrentUser;
948 if ( $self->payby eq 'COMP'
949 && $self->payby ne $old->payby
950 && ! $curuser->access_right('Complimentary customer')
953 return "You are not permitted to create complimentary accounts.";
956 local($ignore_expired_card) = 1
957 if $old->payby =~ /^(CARD|DCRD)$/
958 && $self->payby =~ /^(CARD|DCRD)$/
959 && $old->payinfo eq $self->payinfo;
961 my $oldAutoCommit = $FS::UID::AutoCommit;
962 local $FS::UID::AutoCommit = 0;
965 my $error = $self->SUPER::replace($old);
968 $dbh->rollback if $oldAutoCommit;
972 if ( @param ) { # INVOICING_LIST_ARYREF
973 my $invoicing_list = shift @param;
974 $error = $self->check_invoicing_list( $invoicing_list );
976 $dbh->rollback if $oldAutoCommit;
979 $self->invoicing_list( $invoicing_list );
982 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
983 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
984 # card/check/lec info has changed, want to retry realtime_ invoice events
985 my $error = $self->retry_realtime;
987 $dbh->rollback if $oldAutoCommit;
992 unless ( $import || $skip_fuzzyfiles ) {
993 $error = $self->queue_fuzzyfiles_update;
995 $dbh->rollback if $oldAutoCommit;
996 return "updating fuzzy search cache: $error";
1000 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1005 =item queue_fuzzyfiles_update
1007 Used by insert & replace to update the fuzzy search cache
1011 sub queue_fuzzyfiles_update {
1014 local $SIG{HUP} = 'IGNORE';
1015 local $SIG{INT} = 'IGNORE';
1016 local $SIG{QUIT} = 'IGNORE';
1017 local $SIG{TERM} = 'IGNORE';
1018 local $SIG{TSTP} = 'IGNORE';
1019 local $SIG{PIPE} = 'IGNORE';
1021 my $oldAutoCommit = $FS::UID::AutoCommit;
1022 local $FS::UID::AutoCommit = 0;
1025 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1026 my $error = $queue->insert($self->getfield('last'), $self->company);
1028 $dbh->rollback if $oldAutoCommit;
1029 return "queueing job (transaction rolled back): $error";
1032 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1033 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1034 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1036 $dbh->rollback if $oldAutoCommit;
1037 return "queueing job (transaction rolled back): $error";
1041 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1048 Checks all fields to make sure this is a valid customer record. If there is
1049 an error, returns the error, otherwise returns false. Called by the insert
1050 and replace methods.
1057 warn "$me check BEFORE: \n". $self->_dump
1061 $self->ut_numbern('custnum')
1062 || $self->ut_number('agentnum')
1063 || $self->ut_number('refnum')
1064 || $self->ut_name('last')
1065 || $self->ut_name('first')
1066 || $self->ut_textn('company')
1067 || $self->ut_text('address1')
1068 || $self->ut_textn('address2')
1069 || $self->ut_text('city')
1070 || $self->ut_textn('county')
1071 || $self->ut_textn('state')
1072 || $self->ut_country('country')
1073 || $self->ut_anything('comments')
1074 || $self->ut_numbern('referral_custnum')
1076 #barf. need message catalogs. i18n. etc.
1077 $error .= "Please select an advertising source."
1078 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1079 return $error if $error;
1081 return "Unknown agent"
1082 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1084 return "Unknown refnum"
1085 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1087 return "Unknown referring custnum: ". $self->referral_custnum
1088 unless ! $self->referral_custnum
1089 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1091 if ( $self->ss eq '' ) {
1096 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1097 or return "Illegal social security number: ". $self->ss;
1098 $self->ss("$1-$2-$3");
1102 # bad idea to disable, causes billing to fail because of no tax rates later
1103 # unless ( $import ) {
1104 unless ( qsearch('cust_main_county', {
1105 'country' => $self->country,
1108 return "Unknown state/county/country: ".
1109 $self->state. "/". $self->county. "/". $self->country
1110 unless qsearch('cust_main_county',{
1111 'state' => $self->state,
1112 'county' => $self->county,
1113 'country' => $self->country,
1119 $self->ut_phonen('daytime', $self->country)
1120 || $self->ut_phonen('night', $self->country)
1121 || $self->ut_phonen('fax', $self->country)
1122 || $self->ut_zip('zip', $self->country)
1124 return $error if $error;
1127 last first company address1 address2 city county state zip
1128 country daytime night fax
1131 if ( defined $self->dbdef_table->column('ship_last') ) {
1132 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1134 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1138 $self->ut_name('ship_last')
1139 || $self->ut_name('ship_first')
1140 || $self->ut_textn('ship_company')
1141 || $self->ut_text('ship_address1')
1142 || $self->ut_textn('ship_address2')
1143 || $self->ut_text('ship_city')
1144 || $self->ut_textn('ship_county')
1145 || $self->ut_textn('ship_state')
1146 || $self->ut_country('ship_country')
1148 return $error if $error;
1150 #false laziness with above
1151 unless ( qsearchs('cust_main_county', {
1152 'country' => $self->ship_country,
1155 return "Unknown ship_state/ship_county/ship_country: ".
1156 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1157 unless qsearch('cust_main_county',{
1158 'state' => $self->ship_state,
1159 'county' => $self->ship_county,
1160 'country' => $self->ship_country,
1166 $self->ut_phonen('ship_daytime', $self->ship_country)
1167 || $self->ut_phonen('ship_night', $self->ship_country)
1168 || $self->ut_phonen('ship_fax', $self->ship_country)
1169 || $self->ut_zip('ship_zip', $self->ship_country)
1171 return $error if $error;
1173 } else { # ship_ info eq billing info, so don't store dup info in database
1174 $self->setfield("ship_$_", '')
1175 foreach qw( last first company address1 address2 city county state zip
1176 country daytime night fax );
1180 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1181 or return "Illegal payby: ". $self->payby;
1183 $error = $self->ut_numbern('paystart_month')
1184 || $self->ut_numbern('paystart_year')
1185 || $self->ut_numbern('payissue')
1187 return $error if $error;
1189 if ( $self->payip eq '' ) {
1192 $error = $self->ut_ip('payip');
1193 return $error if $error;
1196 # If it is encrypted and the private key is not availaible then we can't
1197 # check the credit card.
1199 my $check_payinfo = 1;
1201 if ($self->is_encrypted($self->payinfo)) {
1207 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1209 my $payinfo = $self->payinfo;
1210 $payinfo =~ s/\D//g;
1211 $payinfo =~ /^(\d{13,16})$/
1212 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1214 $self->payinfo($payinfo);
1216 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1218 return gettext('unknown_card_type')
1219 if cardtype($self->payinfo) eq "Unknown";
1221 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1223 return 'Banned credit card: banned on '.
1224 time2str('%a %h %o at %r', $ban->_date).
1225 ' by '. $ban->otaker.
1226 ' (ban# '. $ban->bannum. ')';
1229 if ( defined $self->dbdef_table->column('paycvv') ) {
1230 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1231 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1232 $self->paycvv =~ /^(\d{4})$/
1233 or return "CVV2 (CID) for American Express cards is four digits.";
1236 $self->paycvv =~ /^(\d{3})$/
1237 or return "CVV2 (CVC2/CID) is three digits.";
1245 my $cardtype = cardtype($payinfo);
1246 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1248 return "Start date or issue number is required for $cardtype cards"
1249 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1251 return "Start month must be between 1 and 12"
1252 if $self->paystart_month
1253 and $self->paystart_month < 1 || $self->paystart_month > 12;
1255 return "Start year must be 1990 or later"
1256 if $self->paystart_year
1257 and $self->paystart_year < 1990;
1259 return "Issue number must be beween 1 and 99"
1261 and $self->payissue < 1 || $self->payissue > 99;
1264 $self->paystart_month('');
1265 $self->paystart_year('');
1266 $self->payissue('');
1269 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1271 my $payinfo = $self->payinfo;
1272 $payinfo =~ s/[^\d\@]//g;
1273 if ( $conf->exists('echeck-nonus') ) {
1274 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1275 $payinfo = "$1\@$2";
1277 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1278 $payinfo = "$1\@$2";
1280 $self->payinfo($payinfo);
1281 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1283 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1285 return 'Banned ACH account: banned on '.
1286 time2str('%a %h %o at %r', $ban->_date).
1287 ' by '. $ban->otaker.
1288 ' (ban# '. $ban->bannum. ')';
1291 } elsif ( $self->payby eq 'LECB' ) {
1293 my $payinfo = $self->payinfo;
1294 $payinfo =~ s/\D//g;
1295 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1297 $self->payinfo($payinfo);
1298 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1300 } elsif ( $self->payby eq 'BILL' ) {
1302 $error = $self->ut_textn('payinfo');
1303 return "Illegal P.O. number: ". $self->payinfo if $error;
1304 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1306 } elsif ( $self->payby eq 'COMP' ) {
1308 my $curuser = $FS::CurrentUser::CurrentUser;
1309 if ( ! $self->custnum
1310 && ! $curuser->access_right('Complimentary customer')
1313 return "You are not permitted to create complimentary accounts."
1316 $error = $self->ut_textn('payinfo');
1317 return "Illegal comp account issuer: ". $self->payinfo if $error;
1318 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1320 } elsif ( $self->payby eq 'PREPAY' ) {
1322 my $payinfo = $self->payinfo;
1323 $payinfo =~ s/\W//g; #anything else would just confuse things
1324 $self->payinfo($payinfo);
1325 $error = $self->ut_alpha('payinfo');
1326 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1327 return "Unknown prepayment identifier"
1328 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1329 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1333 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1334 return "Expiration date required"
1335 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1339 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1340 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1341 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1342 ( $m, $y ) = ( $3, "20$2" );
1344 return "Illegal expiration date: ". $self->paydate;
1346 $self->paydate("$y-$m-01");
1347 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1348 return gettext('expired_card')
1350 && !$ignore_expired_card
1351 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1354 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1355 ( ! $conf->exists('require_cardname')
1356 || $self->payby !~ /^(CARD|DCRD)$/ )
1358 $self->payname( $self->first. " ". $self->getfield('last') );
1360 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1361 or return gettext('illegal_name'). " payname: ". $self->payname;
1365 foreach my $flag (qw( tax spool_cdr )) {
1366 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1370 $self->otaker(getotaker) unless $self->otaker;
1372 warn "$me check AFTER: \n". $self->_dump
1375 $self->SUPER::check;
1380 Returns all packages (see L<FS::cust_pkg>) for this customer.
1386 if ( $self->{'_pkgnum'} ) {
1387 values %{ $self->{'_pkgnum'}->cache };
1389 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1393 =item ncancelled_pkgs
1395 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1399 sub ncancelled_pkgs {
1401 if ( $self->{'_pkgnum'} ) {
1402 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1404 @{ [ # force list context
1405 qsearch( 'cust_pkg', {
1406 'custnum' => $self->custnum,
1409 qsearch( 'cust_pkg', {
1410 'custnum' => $self->custnum,
1417 =item suspended_pkgs
1419 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1423 sub suspended_pkgs {
1425 grep { $_->susp } $self->ncancelled_pkgs;
1428 =item unflagged_suspended_pkgs
1430 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1431 customer (thouse packages without the `manual_flag' set).
1435 sub unflagged_suspended_pkgs {
1437 return $self->suspended_pkgs
1438 unless dbdef->table('cust_pkg')->column('manual_flag');
1439 grep { ! $_->manual_flag } $self->suspended_pkgs;
1442 =item unsuspended_pkgs
1444 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1449 sub unsuspended_pkgs {
1451 grep { ! $_->susp } $self->ncancelled_pkgs;
1454 =item num_cancelled_pkgs
1456 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1461 sub num_cancelled_pkgs {
1463 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1467 my( $self, $sql ) = @_;
1468 my $sth = dbh->prepare(
1469 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1470 ) or die dbh->errstr;
1471 $sth->execute($self->custnum) or die $sth->errstr;
1472 $sth->fetchrow_arrayref->[0];
1477 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1478 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1479 on success or a list of errors.
1485 grep { $_->unsuspend } $self->suspended_pkgs;
1490 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1492 Returns a list: an empty list on success or a list of errors.
1498 grep { $_->suspend } $self->unsuspended_pkgs;
1501 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1503 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1504 PKGPARTs (see L<FS::part_pkg>).
1506 Returns a list: an empty list on success or a list of errors.
1510 sub suspend_if_pkgpart {
1513 grep { $_->suspend }
1514 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1515 $self->unsuspended_pkgs;
1518 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1520 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1521 listed PKGPARTs (see L<FS::part_pkg>).
1523 Returns a list: an empty list on success or a list of errors.
1527 sub suspend_unless_pkgpart {
1530 grep { $_->suspend }
1531 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1532 $self->unsuspended_pkgs;
1535 =item cancel [ OPTION => VALUE ... ]
1537 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1539 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1541 I<quiet> can be set true to supress email cancellation notices.
1543 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1545 I<ban> can be set true to ban this customer's credit card or ACH information,
1548 Always returns a list: an empty list on success or a list of errors.
1556 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1558 #should try decryption (we might have the private key)
1559 # and if not maybe queue a job for the server that does?
1560 return ( "Can't (yet) ban encrypted credit cards" )
1561 if $self->is_encrypted($self->payinfo);
1563 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1564 my $error = $ban->insert;
1565 return ( $error ) if $error;
1569 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1572 sub _banned_pay_hashref {
1583 'payby' => $payby2ban{$self->payby},
1584 'payinfo' => md5_base64($self->payinfo),
1591 Returns the agent (see L<FS::agent>) for this customer.
1597 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1602 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1603 conjunction with the collect method.
1605 Options are passed as name-value pairs.
1607 Currently available options are:
1609 resetup - if set true, re-charges setup fees.
1611 time - bills the customer as if it were that time. Specified as a UNIX
1612 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1613 L<Date::Parse> for conversion functions. For example:
1617 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1620 If there is an error, returns the error, otherwise returns false.
1625 my( $self, %options ) = @_;
1626 return '' if $self->payby eq 'COMP';
1627 warn "$me bill customer ". $self->custnum. "\n"
1630 my $time = $options{'time'} || time;
1635 local $SIG{HUP} = 'IGNORE';
1636 local $SIG{INT} = 'IGNORE';
1637 local $SIG{QUIT} = 'IGNORE';
1638 local $SIG{TERM} = 'IGNORE';
1639 local $SIG{TSTP} = 'IGNORE';
1640 local $SIG{PIPE} = 'IGNORE';
1642 my $oldAutoCommit = $FS::UID::AutoCommit;
1643 local $FS::UID::AutoCommit = 0;
1646 $self->select_for_update; #mutex
1648 #create a new invoice
1649 #(we'll remove it later if it doesn't actually need to be generated [contains
1650 # no line items] and we're inside a transaciton so nothing else will see it)
1651 my $cust_bill = new FS::cust_bill ( {
1652 'custnum' => $self->custnum,
1654 #'charged' => $charged,
1657 $error = $cust_bill->insert;
1659 $dbh->rollback if $oldAutoCommit;
1660 return "can't create invoice for customer #". $self->custnum. ": $error";
1662 my $invnum = $cust_bill->invnum;
1665 # find the packages which are due for billing, find out how much they are
1666 # & generate invoice database.
1669 my( $total_setup, $total_recur ) = ( 0, 0 );
1671 my @precommit_hooks = ();
1673 foreach my $cust_pkg (
1674 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1677 #NO!! next if $cust_pkg->cancel;
1678 next if $cust_pkg->getfield('cancel');
1680 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1682 #? to avoid use of uninitialized value errors... ?
1683 $cust_pkg->setfield('bill', '')
1684 unless defined($cust_pkg->bill);
1686 my $part_pkg = $cust_pkg->part_pkg;
1688 my %hash = $cust_pkg->hash;
1689 my $old_cust_pkg = new FS::cust_pkg \%hash;
1698 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1700 warn " bill setup\n" if $DEBUG > 1;
1702 $setup = eval { $cust_pkg->calc_setup( $time ) };
1704 $dbh->rollback if $oldAutoCommit;
1705 return "$@ running calc_setup for $cust_pkg\n";
1708 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1712 # bill recurring fee
1717 if ( $part_pkg->getfield('freq') ne '0' &&
1718 ! $cust_pkg->getfield('susp') &&
1719 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1722 warn " bill recur\n" if $DEBUG > 1;
1724 # XXX shared with $recur_prog
1725 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1727 #over two params! lets at least switch to a hashref for the rest...
1728 my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1730 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1732 $dbh->rollback if $oldAutoCommit;
1733 return "$@ running calc_recur for $cust_pkg\n";
1736 #change this bit to use Date::Manip? CAREFUL with timezones (see
1737 # mailing list archive)
1738 my ($sec,$min,$hour,$mday,$mon,$year) =
1739 (localtime($sdate) )[0,1,2,3,4,5];
1741 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1742 # only for figuring next bill date, nothing else, so, reset $sdate again
1744 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1745 $cust_pkg->last_bill($sdate)
1746 if $cust_pkg->dbdef_table->column('last_bill');
1748 if ( $part_pkg->freq =~ /^\d+$/ ) {
1749 $mon += $part_pkg->freq;
1750 until ( $mon < 12 ) { $mon -= 12; $year++; }
1751 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1753 $mday += $weeks * 7;
1754 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1757 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1761 $dbh->rollback if $oldAutoCommit;
1762 return "unparsable frequency: ". $part_pkg->freq;
1764 $cust_pkg->setfield('bill',
1765 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1768 warn "\$setup is undefined" unless defined($setup);
1769 warn "\$recur is undefined" unless defined($recur);
1770 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1773 # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1776 if ( $cust_pkg->modified ) {
1778 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1781 $error=$cust_pkg->replace($old_cust_pkg);
1782 if ( $error ) { #just in case
1783 $dbh->rollback if $oldAutoCommit;
1784 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1787 $setup = sprintf( "%.2f", $setup );
1788 $recur = sprintf( "%.2f", $recur );
1789 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1790 $dbh->rollback if $oldAutoCommit;
1791 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1793 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1794 $dbh->rollback if $oldAutoCommit;
1795 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1798 if ( $setup != 0 || $recur != 0 ) {
1800 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1802 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1803 'invnum' => $invnum,
1804 'pkgnum' => $cust_pkg->pkgnum,
1808 'edate' => $cust_pkg->bill,
1809 'details' => \@details,
1811 $error = $cust_bill_pkg->insert;
1813 $dbh->rollback if $oldAutoCommit;
1814 return "can't create invoice line item for invoice #$invnum: $error";
1816 $total_setup += $setup;
1817 $total_recur += $recur;
1823 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1826 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1829 my %taxhash = map { $_ => $self->get("$prefix$_") }
1830 qw( state county country );
1832 $taxhash{'taxclass'} = $part_pkg->taxclass;
1834 my @taxes = qsearch( 'cust_main_county', \%taxhash );
1837 $taxhash{'taxclass'} = '';
1838 @taxes = qsearch( 'cust_main_county', \%taxhash );
1841 #one more try at a whole-country tax rate
1843 $taxhash{$_} = '' foreach qw( state county );
1844 @taxes = qsearch( 'cust_main_county', \%taxhash );
1847 # maybe eliminate this entirely, along with all the 0% records
1849 $dbh->rollback if $oldAutoCommit;
1851 "fatal: can't find tax rate for state/county/country/taxclass ".
1852 join('/', ( map $self->get("$prefix$_"),
1853 qw(state county country)
1855 $part_pkg->taxclass ). "\n";
1858 foreach my $tax ( @taxes ) {
1860 my $taxable_charged = 0;
1861 $taxable_charged += $setup
1862 unless $part_pkg->setuptax =~ /^Y$/i
1863 || $tax->setuptax =~ /^Y$/i;
1864 $taxable_charged += $recur
1865 unless $part_pkg->recurtax =~ /^Y$/i
1866 || $tax->recurtax =~ /^Y$/i;
1867 next unless $taxable_charged;
1869 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1870 #my ($mon,$year) = (localtime($sdate) )[4,5];
1871 my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1873 my $freq = $part_pkg->freq || 1;
1874 if ( $freq !~ /(\d+)$/ ) {
1875 $dbh->rollback if $oldAutoCommit;
1876 return "daily/weekly package definitions not (yet?)".
1877 " compatible with monthly tax exemptions";
1879 my $taxable_per_month =
1880 sprintf("%.2f", $taxable_charged / $freq );
1882 #call the whole thing off if this customer has any old
1883 #exemption records...
1884 my @cust_tax_exempt =
1885 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1886 if ( @cust_tax_exempt ) {
1887 $dbh->rollback if $oldAutoCommit;
1889 'this customer still has old-style tax exemption records; '.
1890 'run bin/fs-migrate-cust_tax_exempt?';
1893 foreach my $which_month ( 1 .. $freq ) {
1895 #maintain the new exemption table now
1898 FROM cust_tax_exempt_pkg
1899 LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1900 LEFT JOIN cust_bill USING ( invnum )
1906 my $sth = dbh->prepare($sql) or do {
1907 $dbh->rollback if $oldAutoCommit;
1908 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1916 $dbh->rollback if $oldAutoCommit;
1917 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1919 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1921 my $remaining_exemption =
1922 $tax->exempt_amount - $existing_exemption;
1923 if ( $remaining_exemption > 0 ) {
1924 my $addl = $remaining_exemption > $taxable_per_month
1925 ? $taxable_per_month
1926 : $remaining_exemption;
1927 $taxable_charged -= $addl;
1929 my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1930 'billpkgnum' => $cust_bill_pkg->billpkgnum,
1931 'taxnum' => $tax->taxnum,
1932 'year' => 1900+$year,
1934 'amount' => sprintf("%.2f", $addl ),
1936 $error = $cust_tax_exempt_pkg->insert;
1938 $dbh->rollback if $oldAutoCommit;
1939 return "fatal: can't insert cust_tax_exempt_pkg: $error";
1941 } # if $remaining_exemption > 0
1945 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1946 until ( $mon < 13 ) { $mon -= 12; $year++; }
1948 } #foreach $which_month
1950 } #if $tax->exempt_amount
1952 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1954 #$tax += $taxable_charged * $cust_main_county->tax / 100
1955 $tax{ $tax->taxname || 'Tax' } +=
1956 $taxable_charged * $tax->tax / 100
1958 } #foreach my $tax ( @taxes )
1960 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1962 } #if $setup != 0 || $recur != 0
1964 } #if $cust_pkg->modified
1966 } #foreach my $cust_pkg
1968 unless ( $cust_bill->cust_bill_pkg ) {
1969 $cust_bill->delete; #don't create an invoice w/o line items
1970 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1974 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1976 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1977 my $tax = sprintf("%.2f", $tax{$taxname} );
1978 $charged = sprintf( "%.2f", $charged+$tax );
1980 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1981 'invnum' => $invnum,
1987 'itemdesc' => $taxname,
1989 $error = $cust_bill_pkg->insert;
1991 $dbh->rollback if $oldAutoCommit;
1992 return "can't create invoice line item for invoice #$invnum: $error";
1994 $total_setup += $tax;
1998 $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1999 $error = $cust_bill->replace;
2001 $dbh->rollback if $oldAutoCommit;
2002 return "can't update charged for invoice #$invnum: $error";
2005 foreach my $hook ( @precommit_hooks ) {
2007 &{$hook}; #($self) ?
2010 $dbh->rollback if $oldAutoCommit;
2011 return "$@ running precommit hook $hook\n";
2015 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2019 =item collect OPTIONS
2021 (Attempt to) collect money for this customer's outstanding invoices (see
2022 L<FS::cust_bill>). Usually used after the bill method.
2024 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2025 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2026 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2028 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2029 and the invoice events web interface.
2031 If there is an error, returns the error, otherwise returns false.
2033 Options are passed as name-value pairs.
2035 Currently available options are:
2037 invoice_time - Use this time when deciding when to print invoices and
2038 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>
2039 for conversion functions.
2041 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2044 quiet - set true to surpress email card/ACH decline notices.
2046 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2052 my( $self, %options ) = @_;
2053 my $invoice_time = $options{'invoice_time'} || time;
2056 local $SIG{HUP} = 'IGNORE';
2057 local $SIG{INT} = 'IGNORE';
2058 local $SIG{QUIT} = 'IGNORE';
2059 local $SIG{TERM} = 'IGNORE';
2060 local $SIG{TSTP} = 'IGNORE';
2061 local $SIG{PIPE} = 'IGNORE';
2063 my $oldAutoCommit = $FS::UID::AutoCommit;
2064 local $FS::UID::AutoCommit = 0;
2067 $self->select_for_update; #mutex
2069 my $balance = $self->balance;
2070 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2072 unless ( $balance > 0 ) { #redundant?????
2073 $dbh->rollback if $oldAutoCommit; #hmm
2077 if ( exists($options{'retry_card'}) ) {
2078 carp 'retry_card option passed to collect is deprecated; use retry';
2079 $options{'retry'} ||= $options{'retry_card'};
2081 if ( exists($options{'retry'}) && $options{'retry'} ) {
2082 my $error = $self->retry_realtime;
2084 $dbh->rollback if $oldAutoCommit;
2090 if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2091 $extra_sql = " AND freq = '1m' ";
2093 $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2096 foreach my $cust_bill ( $self->open_cust_bill ) {
2098 # don't try to charge for the same invoice if it's already in a batch
2099 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2101 last if $self->balance <= 0;
2103 warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2106 foreach my $part_bill_event (
2107 sort { $a->seconds <=> $b->seconds
2108 || $a->weight <=> $b->weight
2109 || $a->eventpart <=> $b->eventpart }
2110 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2111 && ! qsearch( 'cust_bill_event', {
2112 'invnum' => $cust_bill->invnum,
2113 'eventpart' => $_->eventpart,
2118 'table' => 'part_bill_event',
2119 'hashref' => { 'payby' => $self->payby,
2120 'disabled' => '', },
2121 'extra_sql' => $extra_sql,
2125 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2126 || $self->balance <= 0; # or if balance<=0
2128 warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
2130 my $cust_main = $self; #for callback
2134 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2135 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2136 $error = eval $part_bill_event->eventcode;
2140 my $statustext = '';
2144 } elsif ( $error ) {
2146 $statustext = $error;
2151 #add cust_bill_event
2152 my $cust_bill_event = new FS::cust_bill_event {
2153 'invnum' => $cust_bill->invnum,
2154 'eventpart' => $part_bill_event->eventpart,
2155 #'_date' => $invoice_time,
2157 'status' => $status,
2158 'statustext' => $statustext,
2160 $error = $cust_bill_event->insert;
2162 #$dbh->rollback if $oldAutoCommit;
2163 #return "error: $error";
2165 # gah, even with transactions.
2166 $dbh->commit if $oldAutoCommit; #well.
2167 my $e = 'WARNING: Event run but database not updated - '.
2168 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2169 ', eventpart '. $part_bill_event->eventpart.
2180 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2185 =item retry_realtime
2187 Schedules realtime credit card / electronic check / LEC billing events for
2188 for retry. Useful if card information has changed or manual retry is desired.
2189 The 'collect' method must be called to actually retry the transaction.
2191 Implementation details: For each of this customer's open invoices, changes
2192 the status of the first "done" (with statustext error) realtime processing
2197 sub retry_realtime {
2200 local $SIG{HUP} = 'IGNORE';
2201 local $SIG{INT} = 'IGNORE';
2202 local $SIG{QUIT} = 'IGNORE';
2203 local $SIG{TERM} = 'IGNORE';
2204 local $SIG{TSTP} = 'IGNORE';
2205 local $SIG{PIPE} = 'IGNORE';
2207 my $oldAutoCommit = $FS::UID::AutoCommit;
2208 local $FS::UID::AutoCommit = 0;
2211 foreach my $cust_bill (
2212 grep { $_->cust_bill_event }
2213 $self->open_cust_bill
2215 my @cust_bill_event =
2216 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2218 #$_->part_bill_event->plan eq 'realtime-card'
2219 $_->part_bill_event->eventcode =~
2220 /\$cust_bill\->realtime_(card|ach|lec)/
2221 && $_->status eq 'done'
2224 $cust_bill->cust_bill_event;
2225 next unless @cust_bill_event;
2226 my $error = $cust_bill_event[0]->retry;
2228 $dbh->rollback if $oldAutoCommit;
2229 return "error scheduling invoice event for retry: $error";
2234 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2239 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2241 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2242 via a Business::OnlinePayment realtime gateway. See
2243 L<http://420.am/business-onlinepayment> for supported gateways.
2245 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2247 Available options are: I<description>, I<invnum>, I<quiet>
2249 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2250 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2251 if set, will override the value from the customer record.
2253 I<description> is a free-text field passed to the gateway. It defaults to
2254 "Internet services".
2256 If an I<invnum> is specified, this payment (if successful) is applied to the
2257 specified invoice. If you don't specify an I<invnum> you might want to
2258 call the B<apply_payments> method.
2260 I<quiet> can be set true to surpress email decline notices.
2262 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2267 my( $self, $method, $amount, %options ) = @_;
2269 warn "$me realtime_bop: $method $amount\n";
2270 warn " $_ => $options{$_}\n" foreach keys %options;
2273 $options{'description'} ||= 'Internet services';
2275 eval "use Business::OnlinePayment";
2278 my $payinfo = exists($options{'payinfo'})
2279 ? $options{'payinfo'}
2287 if ( $options{'invnum'} ) {
2288 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2289 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2291 map { $_->part_pkg->taxclass }
2293 map { $_->cust_pkg }
2294 $cust_bill->cust_bill_pkg;
2295 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2296 #different taxclasses
2297 $taxclass = $taxclasses[0];
2301 #look for an agent gateway override first
2303 if ( $method eq 'CC' ) {
2304 $cardtype = cardtype($payinfo);
2305 } elsif ( $method eq 'ECHECK' ) {
2308 $cardtype = $method;
2312 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2313 cardtype => $cardtype,
2314 taxclass => $taxclass, } )
2315 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2317 taxclass => $taxclass, } )
2318 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2319 cardtype => $cardtype,
2321 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2323 taxclass => '', } );
2325 my $payment_gateway = '';
2326 my( $processor, $login, $password, $action, @bop_options );
2327 if ( $override ) { #use a payment gateway override
2329 $payment_gateway = $override->payment_gateway;
2331 $processor = $payment_gateway->gateway_module;
2332 $login = $payment_gateway->gateway_username;
2333 $password = $payment_gateway->gateway_password;
2334 $action = $payment_gateway->gateway_action;
2335 @bop_options = $payment_gateway->options;
2337 } else { #use the standard settings from the config
2339 ( $processor, $login, $password, $action, @bop_options ) =
2340 $self->default_payment_gateway($method);
2348 my $address = exists($options{'address1'})
2349 ? $options{'address1'}
2351 my $address2 = exists($options{'address2'})
2352 ? $options{'address2'}
2354 $address .= ", ". $address2 if length($address2);
2356 my $o_payname = exists($options{'payname'})
2357 ? $options{'payname'}
2359 my($payname, $payfirst, $paylast);
2360 if ( $o_payname && $method ne 'ECHECK' ) {
2361 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2362 or return "Illegal payname $payname";
2363 ($payfirst, $paylast) = ($1, $2);
2365 $payfirst = $self->getfield('first');
2366 $paylast = $self->getfield('last');
2367 $payname = "$payfirst $paylast";
2370 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2371 if ( $conf->exists('emailinvoiceauto')
2372 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2373 push @invoicing_list, $self->all_emails;
2376 my $email = ($conf->exists('business-onlinepayment-email-override'))
2377 ? $conf->config('business-onlinepayment-email-override')
2378 : $invoicing_list[0];
2382 my $payip = exists($options{'payip'})
2385 $content{customer_ip} = $payip
2388 if ( $method eq 'CC' ) {
2390 $content{card_number} = $payinfo;
2391 my $paydate = exists($options{'paydate'})
2392 ? $options{'paydate'}
2394 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2395 $content{expiration} = "$2/$1";
2397 my $paycvv = exists($options{'paycvv'})
2398 ? $options{'paycvv'}
2400 $content{cvv2} = $self->paycvv
2403 my $paystart_month = exists($options{'paystart_month'})
2404 ? $options{'paystart_month'}
2405 : $self->paystart_month;
2407 my $paystart_year = exists($options{'paystart_year'})
2408 ? $options{'paystart_year'}
2409 : $self->paystart_year;
2411 $content{card_start} = "$paystart_month/$paystart_year"
2412 if $paystart_month && $paystart_year;
2414 my $payissue = exists($options{'payissue'})
2415 ? $options{'payissue'}
2417 $content{issue_number} = $payissue if $payissue;
2419 $content{recurring_billing} = 'YES'
2420 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2422 'payinfo' => $payinfo,
2425 } elsif ( $method eq 'ECHECK' ) {
2426 ( $content{account_number}, $content{routing_code} ) =
2427 split('@', $payinfo);
2428 $content{bank_name} = $o_payname;
2429 $content{account_type} = 'CHECKING';
2430 $content{account_name} = $payname;
2431 $content{customer_org} = $self->company ? 'B' : 'I';
2432 $content{customer_ssn} = exists($options{'ss'})
2435 } elsif ( $method eq 'LEC' ) {
2436 $content{phone} = $payinfo;
2440 # run transaction(s)
2443 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2445 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2446 $transaction->content(
2449 'password' => $password,
2450 'action' => $action1,
2451 'description' => $options{'description'},
2452 'amount' => $amount,
2453 'invoice_number' => $options{'invnum'},
2454 'customer_id' => $self->custnum,
2455 'last_name' => $paylast,
2456 'first_name' => $payfirst,
2458 'address' => $address,
2459 'city' => ( exists($options{'city'})
2462 'state' => ( exists($options{'state'})
2465 'zip' => ( exists($options{'zip'})
2468 'country' => ( exists($options{'country'})
2469 ? $options{'country'}
2471 'referer' => 'http://cleanwhisker.420.am/',
2473 'phone' => $self->daytime || $self->night,
2476 $transaction->submit();
2478 if ( $transaction->is_success() && $action2 ) {
2479 my $auth = $transaction->authorization;
2480 my $ordernum = $transaction->can('order_number')
2481 ? $transaction->order_number
2485 new Business::OnlinePayment( $processor, @bop_options );
2492 password => $password,
2493 order_number => $ordernum,
2495 authorization => $auth,
2496 description => $options{'description'},
2499 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2500 transaction_sequence_num local_transaction_date
2501 local_transaction_time AVS_result_code )) {
2502 $capture{$field} = $transaction->$field() if $transaction->can($field);
2505 $capture->content( %capture );
2509 unless ( $capture->is_success ) {
2510 my $e = "Authorization successful but capture failed, custnum #".
2511 $self->custnum. ': '. $capture->result_code.
2512 ": ". $capture->error_message;
2520 # remove paycvv after initial transaction
2523 #false laziness w/misc/process/payment.cgi - check both to make sure working
2525 if ( defined $self->dbdef_table->column('paycvv')
2526 && length($self->paycvv)
2527 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2529 my $error = $self->remove_cvv;
2531 warn "WARNING: error removing cvv: $error\n";
2539 if ( $transaction->is_success() ) {
2541 my %method2payby = (
2548 if ( $payment_gateway ) { # agent override
2549 $paybatch = $payment_gateway->gatewaynum. '-';
2552 $paybatch .= "$processor:". $transaction->authorization;
2554 $paybatch .= ':'. $transaction->order_number
2555 if $transaction->can('order_number')
2556 && length($transaction->order_number);
2558 my $cust_pay = new FS::cust_pay ( {
2559 'custnum' => $self->custnum,
2560 'invnum' => $options{'invnum'},
2563 'payby' => $method2payby{$method},
2564 'payinfo' => $payinfo,
2565 'paybatch' => $paybatch,
2567 my $error = $cust_pay->insert;
2569 $cust_pay->invnum(''); #try again with no specific invnum
2570 my $error2 = $cust_pay->insert;
2572 # gah, even with transactions.
2573 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2574 "error inserting payment ($processor): $error2".
2575 " (previously tried insert with invnum #$options{'invnum'}" .
2581 return ''; #no error
2585 my $perror = "$processor error: ". $transaction->error_message;
2587 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2588 && $conf->exists('emaildecline')
2589 && grep { $_ ne 'POST' } $self->invoicing_list
2590 && ! grep { $transaction->error_message =~ /$_/ }
2591 $conf->config('emaildecline-exclude')
2593 my @templ = $conf->config('declinetemplate');
2594 my $template = new Text::Template (
2596 SOURCE => [ map "$_\n", @templ ],
2597 ) or return "($perror) can't create template: $Text::Template::ERROR";
2598 $template->compile()
2599 or return "($perror) can't compile template: $Text::Template::ERROR";
2601 my $templ_hash = { error => $transaction->error_message };
2603 my $error = send_email(
2604 'from' => $conf->config('invoice_from'),
2605 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2606 'subject' => 'Your payment could not be processed',
2607 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2610 $perror .= " (also received error sending decline notification: $error)"
2620 =item default_payment_gateway
2624 sub default_payment_gateway {
2625 my( $self, $method ) = @_;
2627 die "Real-time processing not enabled\n"
2628 unless $conf->exists('business-onlinepayment');
2631 my $bop_config = 'business-onlinepayment';
2632 $bop_config .= '-ach'
2633 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2634 my ( $processor, $login, $password, $action, @bop_options ) =
2635 $conf->config($bop_config);
2636 $action ||= 'normal authorization';
2637 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2638 die "No real-time processor is enabled - ".
2639 "did you set the business-onlinepayment configuration value?\n"
2642 ( $processor, $login, $password, $action, @bop_options )
2647 Removes the I<paycvv> field from the database directly.
2649 If there is an error, returns the error, otherwise returns false.
2655 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2656 or return dbh->errstr;
2657 $sth->execute($self->custnum)
2658 or return $sth->errstr;
2663 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2665 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2666 via a Business::OnlinePayment realtime gateway. See
2667 L<http://420.am/business-onlinepayment> for supported gateways.
2669 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2671 Available options are: I<amount>, I<reason>, I<paynum>
2673 Most gateways require a reference to an original payment transaction to refund,
2674 so you probably need to specify a I<paynum>.
2676 I<amount> defaults to the original amount of the payment if not specified.
2678 I<reason> specifies a reason for the refund.
2680 Implementation note: If I<amount> is unspecified or equal to the amount of the
2681 orignal payment, first an attempt is made to "void" the transaction via
2682 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2683 the normal attempt is made to "refund" ("credit") the transaction via the
2684 gateway is attempted.
2686 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2687 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2688 #if set, will override the value from the customer record.
2690 #If an I<invnum> is specified, this payment (if successful) is applied to the
2691 #specified invoice. If you don't specify an I<invnum> you might want to
2692 #call the B<apply_payments> method.
2696 #some false laziness w/realtime_bop, not enough to make it worth merging
2697 #but some useful small subs should be pulled out
2698 sub realtime_refund_bop {
2699 my( $self, $method, %options ) = @_;
2701 warn "$me realtime_refund_bop: $method refund\n";
2702 warn " $_ => $options{$_}\n" foreach keys %options;
2705 eval "use Business::OnlinePayment";
2709 # look up the original payment and optionally a gateway for that payment
2713 my $amount = $options{'amount'};
2715 my( $processor, $login, $password, @bop_options ) ;
2716 my( $auth, $order_number ) = ( '', '', '' );
2718 if ( $options{'paynum'} ) {
2720 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
2721 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2722 or return "Unknown paynum $options{'paynum'}";
2723 $amount ||= $cust_pay->paid;
2725 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2726 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2727 $cust_pay->paybatch;
2728 my $gatewaynum = '';
2729 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2731 if ( $gatewaynum ) { #gateway for the payment to be refunded
2733 my $payment_gateway =
2734 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2735 die "payment gateway $gatewaynum not found"
2736 unless $payment_gateway;
2738 $processor = $payment_gateway->gateway_module;
2739 $login = $payment_gateway->gateway_username;
2740 $password = $payment_gateway->gateway_password;
2741 @bop_options = $payment_gateway->options;
2743 } else { #try the default gateway
2745 my( $conf_processor, $unused_action );
2746 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2747 $self->default_payment_gateway($method);
2749 return "processor of payment $options{'paynum'} $processor does not".
2750 " match default processor $conf_processor"
2751 unless $processor eq $conf_processor;
2756 } else { # didn't specify a paynum, so look for agent gateway overrides
2757 # like a normal transaction
2760 if ( $method eq 'CC' ) {
2761 $cardtype = cardtype($self->payinfo);
2762 } elsif ( $method eq 'ECHECK' ) {
2765 $cardtype = $method;
2768 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2769 cardtype => $cardtype,
2771 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2773 taxclass => '', } );
2775 if ( $override ) { #use a payment gateway override
2777 my $payment_gateway = $override->payment_gateway;
2779 $processor = $payment_gateway->gateway_module;
2780 $login = $payment_gateway->gateway_username;
2781 $password = $payment_gateway->gateway_password;
2782 #$action = $payment_gateway->gateway_action;
2783 @bop_options = $payment_gateway->options;
2785 } else { #use the standard settings from the config
2788 ( $processor, $login, $password, $unused_action, @bop_options ) =
2789 $self->default_payment_gateway($method);
2794 return "neither amount nor paynum specified" unless $amount;
2799 'password' => $password,
2800 'order_number' => $order_number,
2801 'amount' => $amount,
2802 'referer' => 'http://cleanwhisker.420.am/',
2804 $content{authorization} = $auth
2805 if length($auth); #echeck/ACH transactions have an order # but no auth
2806 #(at least with authorize.net)
2808 #first try void if applicable
2809 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2810 warn " attempting void\n" if $DEBUG > 1;
2811 my $void = new Business::OnlinePayment( $processor, @bop_options );
2812 $void->content( 'action' => 'void', %content );
2814 if ( $void->is_success ) {
2815 my $error = $cust_pay->void($options{'reason'});
2817 # gah, even with transactions.
2818 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2819 "error voiding payment: $error";
2823 warn " void successful\n" if $DEBUG > 1;
2828 warn " void unsuccessful, trying refund\n"
2832 my $address = $self->address1;
2833 $address .= ", ". $self->address2 if $self->address2;
2835 my($payname, $payfirst, $paylast);
2836 if ( $self->payname && $method ne 'ECHECK' ) {
2837 $payname = $self->payname;
2838 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2839 or return "Illegal payname $payname";
2840 ($payfirst, $paylast) = ($1, $2);
2842 $payfirst = $self->getfield('first');
2843 $paylast = $self->getfield('last');
2844 $payname = "$payfirst $paylast";
2848 if ( $method eq 'CC' ) {
2851 $content{card_number} = $payinfo = $cust_pay->payinfo;
2852 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2853 #$content{expiration} = "$2/$1";
2855 $content{card_number} = $payinfo = $self->payinfo;
2856 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2857 $content{expiration} = "$2/$1";
2860 } elsif ( $method eq 'ECHECK' ) {
2861 ( $content{account_number}, $content{routing_code} ) =
2862 split('@', $payinfo = $self->payinfo);
2863 $content{bank_name} = $self->payname;
2864 $content{account_type} = 'CHECKING';
2865 $content{account_name} = $payname;
2866 $content{customer_org} = $self->company ? 'B' : 'I';
2867 $content{customer_ssn} = $self->ss;
2868 } elsif ( $method eq 'LEC' ) {
2869 $content{phone} = $payinfo = $self->payinfo;
2873 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2874 my %sub_content = $refund->content(
2875 'action' => 'credit',
2876 'customer_id' => $self->custnum,
2877 'last_name' => $paylast,
2878 'first_name' => $payfirst,
2880 'address' => $address,
2881 'city' => $self->city,
2882 'state' => $self->state,
2883 'zip' => $self->zip,
2884 'country' => $self->country,
2887 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2891 return "$processor error: ". $refund->error_message
2892 unless $refund->is_success();
2894 my %method2payby = (
2900 my $paybatch = "$processor:". $refund->authorization;
2901 $paybatch .= ':'. $refund->order_number
2902 if $refund->can('order_number') && $refund->order_number;
2904 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2905 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2906 last unless @cust_bill_pay;
2907 my $cust_bill_pay = pop @cust_bill_pay;
2908 my $error = $cust_bill_pay->delete;
2912 my $cust_refund = new FS::cust_refund ( {
2913 'custnum' => $self->custnum,
2914 'paynum' => $options{'paynum'},
2915 'refund' => $amount,
2917 'payby' => $method2payby{$method},
2918 'payinfo' => $payinfo,
2919 'paybatch' => $paybatch,
2920 'reason' => $options{'reason'} || 'card or ACH refund',
2922 my $error = $cust_refund->insert;
2924 $cust_refund->paynum(''); #try again with no specific paynum
2925 my $error2 = $cust_refund->insert;
2927 # gah, even with transactions.
2928 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2929 "error inserting refund ($processor): $error2".
2930 " (previously tried insert with paynum #$options{'paynum'}" .
2943 Returns the total owed for this customer on all invoices
2944 (see L<FS::cust_bill/owed>).
2950 $self->total_owed_date(2145859200); #12/31/2037
2953 =item total_owed_date TIME
2955 Returns the total owed for this customer on all invoices with date earlier than
2956 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2957 see L<Time::Local> and L<Date::Parse> for conversion functions.
2961 sub total_owed_date {
2965 foreach my $cust_bill (
2966 grep { $_->_date <= $time }
2967 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2969 $total_bill += $cust_bill->owed;
2971 sprintf( "%.2f", $total_bill );
2974 =item apply_credits OPTION => VALUE ...
2976 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2977 to outstanding invoice balances in chronological order (or reverse
2978 chronological order if the I<order> option is set to B<newest>) and returns the
2979 value of any remaining unapplied credits available for refund (see
2980 L<FS::cust_refund>).
2988 return 0 unless $self->total_credited;
2990 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2991 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2993 my @invoices = $self->open_cust_bill;
2994 @invoices = sort { $b->_date <=> $a->_date } @invoices
2995 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2998 foreach my $cust_bill ( @invoices ) {
3001 if ( !defined($credit) || $credit->credited == 0) {
3002 $credit = pop @credits or last;
3005 if ($cust_bill->owed >= $credit->credited) {
3006 $amount=$credit->credited;
3008 $amount=$cust_bill->owed;
3011 my $cust_credit_bill = new FS::cust_credit_bill ( {
3012 'crednum' => $credit->crednum,
3013 'invnum' => $cust_bill->invnum,
3014 'amount' => $amount,
3016 my $error = $cust_credit_bill->insert;
3017 die $error if $error;
3019 redo if ($cust_bill->owed > 0);
3023 return $self->total_credited;
3026 =item apply_payments
3028 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3029 to outstanding invoice balances in chronological order.
3031 #and returns the value of any remaining unapplied payments.
3035 sub apply_payments {
3040 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3041 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3043 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3044 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3048 foreach my $cust_bill ( @invoices ) {
3051 if ( !defined($payment) || $payment->unapplied == 0 ) {
3052 $payment = pop @payments or last;
3055 if ( $cust_bill->owed >= $payment->unapplied ) {
3056 $amount = $payment->unapplied;
3058 $amount = $cust_bill->owed;
3061 my $cust_bill_pay = new FS::cust_bill_pay ( {
3062 'paynum' => $payment->paynum,
3063 'invnum' => $cust_bill->invnum,
3064 'amount' => $amount,
3066 my $error = $cust_bill_pay->insert;
3067 die $error if $error;
3069 redo if ( $cust_bill->owed > 0);
3073 return $self->total_unapplied_payments;
3076 =item total_credited
3078 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3079 customer. See L<FS::cust_credit/credited>.
3083 sub total_credited {
3085 my $total_credit = 0;
3086 foreach my $cust_credit ( qsearch('cust_credit', {
3087 'custnum' => $self->custnum,
3089 $total_credit += $cust_credit->credited;
3091 sprintf( "%.2f", $total_credit );
3094 =item total_unapplied_payments
3096 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3097 See L<FS::cust_pay/unapplied>.
3101 sub total_unapplied_payments {
3103 my $total_unapplied = 0;
3104 foreach my $cust_pay ( qsearch('cust_pay', {
3105 'custnum' => $self->custnum,
3107 $total_unapplied += $cust_pay->unapplied;
3109 sprintf( "%.2f", $total_unapplied );
3114 Returns the balance for this customer (total_owed minus total_credited
3115 minus total_unapplied_payments).
3122 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3126 =item balance_date TIME
3128 Returns the balance for this customer, only considering invoices with date
3129 earlier than TIME (total_owed_date minus total_credited minus
3130 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3131 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3140 $self->total_owed_date($time)
3141 - $self->total_credited
3142 - $self->total_unapplied_payments
3146 =item paydate_monthyear
3148 Returns a two-element list consisting of the month and year of this customer's
3149 paydate (credit card expiration date for CARD customers)
3153 sub paydate_monthyear {
3155 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3157 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3164 =item payinfo_masked
3166 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.
3168 Credit Cards - Mask all but the last four characters.
3169 Checks - Mask all but last 2 of account number and bank routing number.
3170 Others - Do nothing, return the unmasked string.
3174 sub payinfo_masked {
3176 return $self->paymask;
3179 =item invoicing_list [ ARRAYREF ]
3181 If an arguement is given, sets these email addresses as invoice recipients
3182 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3183 (except as warnings), so use check_invoicing_list first.
3185 Returns a list of email addresses (with svcnum entries expanded).
3187 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3188 check it without disturbing anything by passing nothing.
3190 This interface may change in the future.
3194 sub invoicing_list {
3195 my( $self, $arrayref ) = @_;
3198 my @cust_main_invoice;
3199 if ( $self->custnum ) {
3200 @cust_main_invoice =
3201 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3203 @cust_main_invoice = ();
3205 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3206 #warn $cust_main_invoice->destnum;
3207 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3208 #warn $cust_main_invoice->destnum;
3209 my $error = $cust_main_invoice->delete;
3210 warn $error if $error;
3213 if ( $self->custnum ) {
3214 @cust_main_invoice =
3215 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3217 @cust_main_invoice = ();
3219 my %seen = map { $_->address => 1 } @cust_main_invoice;
3220 foreach my $address ( @{$arrayref} ) {
3221 next if exists $seen{$address} && $seen{$address};
3222 $seen{$address} = 1;
3223 my $cust_main_invoice = new FS::cust_main_invoice ( {
3224 'custnum' => $self->custnum,
3227 my $error = $cust_main_invoice->insert;
3228 warn $error if $error;
3232 if ( $self->custnum ) {
3234 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3241 =item check_invoicing_list ARRAYREF
3243 Checks these arguements as valid input for the invoicing_list method. If there
3244 is an error, returns the error, otherwise returns false.
3248 sub check_invoicing_list {
3249 my( $self, $arrayref ) = @_;
3250 foreach my $address ( @{$arrayref} ) {
3252 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3253 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3256 my $cust_main_invoice = new FS::cust_main_invoice ( {
3257 'custnum' => $self->custnum,
3260 my $error = $self->custnum
3261 ? $cust_main_invoice->check
3262 : $cust_main_invoice->checkdest
3264 return $error if $error;
3269 =item set_default_invoicing_list
3271 Sets the invoicing list to all accounts associated with this customer,
3272 overwriting any previous invoicing list.
3276 sub set_default_invoicing_list {
3278 $self->invoicing_list($self->all_emails);
3283 Returns the email addresses of all accounts provisioned for this customer.
3290 foreach my $cust_pkg ( $self->all_pkgs ) {
3291 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3293 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3294 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3296 $list{$_}=1 foreach map { $_->email } @svc_acct;
3301 =item invoicing_list_addpost
3303 Adds postal invoicing to this customer. If this customer is already configured
3304 to receive postal invoices, does nothing.
3308 sub invoicing_list_addpost {
3310 return if grep { $_ eq 'POST' } $self->invoicing_list;
3311 my @invoicing_list = $self->invoicing_list;
3312 push @invoicing_list, 'POST';
3313 $self->invoicing_list(\@invoicing_list);
3316 =item invoicing_list_emailonly
3318 Returns the list of email invoice recipients (invoicing_list without non-email
3319 destinations such as POST and FAX).
3323 sub invoicing_list_emailonly {
3325 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3328 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3330 Returns an array of customers referred by this customer (referral_custnum set
3331 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3332 customers referred by customers referred by this customer and so on, inclusive.
3333 The default behavior is DEPTH 1 (no recursion).
3337 sub referral_cust_main {
3339 my $depth = @_ ? shift : 1;
3340 my $exclude = @_ ? shift : {};
3343 map { $exclude->{$_->custnum}++; $_; }
3344 grep { ! $exclude->{ $_->custnum } }
3345 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3349 map { $_->referral_cust_main($depth-1, $exclude) }
3356 =item referral_cust_main_ncancelled
3358 Same as referral_cust_main, except only returns customers with uncancelled
3363 sub referral_cust_main_ncancelled {
3365 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3368 =item referral_cust_pkg [ DEPTH ]
3370 Like referral_cust_main, except returns a flat list of all unsuspended (and
3371 uncancelled) packages for each customer. The number of items in this list may
3372 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3376 sub referral_cust_pkg {
3378 my $depth = @_ ? shift : 1;
3380 map { $_->unsuspended_pkgs }
3381 grep { $_->unsuspended_pkgs }
3382 $self->referral_cust_main($depth);
3385 =item referring_cust_main
3387 Returns the single cust_main record for the customer who referred this customer
3388 (referral_custnum), or false.
3392 sub referring_cust_main {
3394 return '' unless $self->referral_custnum;
3395 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3398 =item credit AMOUNT, REASON
3400 Applies a credit to this customer. If there is an error, returns the error,
3401 otherwise returns false.
3406 my( $self, $amount, $reason ) = @_;
3407 my $cust_credit = new FS::cust_credit {
3408 'custnum' => $self->custnum,
3409 'amount' => $amount,
3410 'reason' => $reason,
3412 $cust_credit->insert;
3415 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3417 Creates a one-time charge for this customer. If there is an error, returns
3418 the error, otherwise returns false.
3423 my ( $self, $amount ) = ( shift, shift );
3424 my $pkg = @_ ? shift : 'One-time charge';
3425 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3426 my $taxclass = @_ ? shift : '';
3428 local $SIG{HUP} = 'IGNORE';
3429 local $SIG{INT} = 'IGNORE';
3430 local $SIG{QUIT} = 'IGNORE';
3431 local $SIG{TERM} = 'IGNORE';
3432 local $SIG{TSTP} = 'IGNORE';
3433 local $SIG{PIPE} = 'IGNORE';
3435 my $oldAutoCommit = $FS::UID::AutoCommit;
3436 local $FS::UID::AutoCommit = 0;
3439 my $part_pkg = new FS::part_pkg ( {
3441 'comment' => $comment,
3442 #'setup' => $amount,
3445 'plandata' => "setup_fee=$amount",
3448 'taxclass' => $taxclass,
3451 my $error = $part_pkg->insert;
3453 $dbh->rollback if $oldAutoCommit;
3457 my $pkgpart = $part_pkg->pkgpart;
3458 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3459 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3460 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3461 $error = $type_pkgs->insert;
3463 $dbh->rollback if $oldAutoCommit;
3468 my $cust_pkg = new FS::cust_pkg ( {
3469 'custnum' => $self->custnum,
3470 'pkgpart' => $pkgpart,
3473 $error = $cust_pkg->insert;
3475 $dbh->rollback if $oldAutoCommit;
3479 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3486 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3492 sort { $a->_date <=> $b->_date }
3493 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3496 =item open_cust_bill
3498 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3503 sub open_cust_bill {
3505 grep { $_->owed > 0 } $self->cust_bill;
3510 Returns all the credits (see L<FS::cust_credit>) for this customer.
3516 sort { $a->_date <=> $b->_date }
3517 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3522 Returns all the payments (see L<FS::cust_pay>) for this customer.
3528 sort { $a->_date <=> $b->_date }
3529 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3534 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3540 sort { $a->_date <=> $b->_date }
3541 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3547 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3553 sort { $a->_date <=> $b->_date }
3554 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3557 =item select_for_update
3559 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3564 sub select_for_update {
3566 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3571 Returns a name string for this customer, either "Company (Last, First)" or
3578 my $name = $self->contact;
3579 $name = $self->company. " ($name)" if $self->company;
3585 Returns a name string for this (service/shipping) contact, either
3586 "Company (Last, First)" or "Last, First".
3592 if ( $self->get('ship_last') ) {
3593 my $name = $self->ship_contact;
3594 $name = $self->ship_company. " ($name)" if $self->ship_company;
3603 Returns this customer's full (billing) contact name only, "Last, First"
3609 $self->get('last'). ', '. $self->first;
3614 Returns this customer's full (shipping) contact name only, "Last, First"
3620 $self->get('ship_last')
3621 ? $self->get('ship_last'). ', '. $self->ship_first
3627 Returns this customer's full country name
3633 code2country($self->country);
3638 Returns a status string for this customer, currently:
3642 =item prospect - No packages have ever been ordered
3644 =item active - One or more recurring packages is active
3646 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3648 =item suspended - All non-cancelled recurring packages are suspended
3650 =item cancelled - All recurring packages are cancelled
3658 for my $status (qw( prospect active inactive suspended cancelled )) {
3659 my $method = $status.'_sql';
3660 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3661 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3662 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3663 return $status if $sth->fetchrow_arrayref->[0];
3669 Returns a hex triplet color string for this customer's status.
3678 'prospect' => '7e0079', #'000000', #black? naw, purple
3679 'active' => '00CC00', #green
3680 'inactive' => '0000CC', #blue
3681 'suspended' => 'FF9900', #yellow
3682 'cancelled' => 'FF0000', #red
3685 $statuscolor{$self->status};
3690 =head1 CLASS METHODS
3696 Returns an SQL expression identifying prospective cust_main records (customers
3697 with no packages ever ordered)
3701 use vars qw($select_count_pkgs);
3702 $select_count_pkgs =
3703 "SELECT COUNT(*) FROM cust_pkg
3704 WHERE cust_pkg.custnum = cust_main.custnum";
3706 sub prospect_sql { "
3707 0 = ( $select_count_pkgs )
3712 Returns an SQL expression identifying active cust_main records (customers with
3713 no active recurring packages, but otherwise unsuspended/uncancelled).
3718 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3724 Returns an SQL expression identifying inactive cust_main records (customers with
3725 active recurring packages).
3729 sub inactive_sql { "
3730 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3732 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3738 Returns an SQL expression identifying suspended cust_main records.
3743 sub suspended_sql { susp_sql(@_); }
3745 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3747 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3753 Returns an SQL expression identifying cancelled cust_main records.
3757 sub cancelled_sql { cancel_sql(@_); }
3760 my $recurring_sql = FS::cust_pkg->recurring_sql;
3761 #my $recurring_sql = "
3762 # '0' != ( select freq from part_pkg
3763 # where cust_pkg.pkgpart = part_pkg.pkgpart )
3767 0 < ( $select_count_pkgs )
3768 AND 0 = ( $select_count_pkgs AND $recurring_sql
3769 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3775 =item uncancelled_sql
3777 Returns an SQL expression identifying un-cancelled cust_main records.
3781 sub uncancelled_sql { uncancel_sql(@_); }
3782 sub uncancel_sql { "
3783 ( 0 < ( $select_count_pkgs
3784 AND ( cust_pkg.cancel IS NULL
3785 OR cust_pkg.cancel = 0
3788 OR 0 = ( $select_count_pkgs )
3792 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3794 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3795 records. Currently, only I<last> or I<company> may be specified (the
3796 appropriate ship_ field is also searched if applicable).
3798 Additional options are the same as FS::Record::qsearch
3803 my( $self, $fuzzy, $hash, @opt) = @_;
3808 check_and_rebuild_fuzzyfiles();
3809 foreach my $field ( keys %$fuzzy ) {
3810 my $sub = \&{"all_$field"};
3812 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3814 foreach ( keys %match ) {
3815 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3816 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3817 if defined dbdef->table('cust_main')->column('ship_last');
3822 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3834 =item smart_search OPTION => VALUE ...
3836 Accepts the following options: I<search>, the string to search for. The string
3837 will be searched for as a customer number, last name or company name, first
3838 searching for an exact match then fuzzy and substring matches.
3840 Any additional options treated as an additional qualifier on the search
3843 Returns a (possibly empty) array of FS::cust_main objects.
3849 my $search = delete $options{'search'};
3851 #here is the agent virtualization
3852 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
3855 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3857 push @cust_main, qsearch( {
3858 'table' => 'cust_main',
3859 'hashref' => { 'custnum' => $1, %options },
3860 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3863 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3866 my $q_value = dbh->quote($value);
3869 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3870 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3871 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3872 if defined dbdef->table('cust_main')->column('ship_last');
3875 push @cust_main, qsearch( {
3876 'table' => 'cust_main',
3877 'hashref' => \%options,
3878 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
3881 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3883 #still some false laziness w/ search/cust_main.cgi
3886 push @cust_main, qsearch( {
3887 'table' => 'cust_main',
3888 'hashref' => { 'last' => { 'op' => 'ILIKE',
3889 'value' => "%$value%" },
3892 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
3894 push @cust_main, qsearch( {
3895 'table' => 'cust_main',
3896 'hashref' => { 'ship_last' => { 'op' => 'ILIKE',
3897 'value' => "%$value%" },
3900 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3902 if defined dbdef->table('cust_main')->column('ship_last');
3904 push @cust_main, qsearch( {
3905 'table' => 'cust_main',
3906 'hashref' => { 'company' => { 'op' => 'ILIKE',
3907 'value' => "%$value%" },
3910 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3912 push @cust_main, qsearch( {
3913 'table' => 'cust_main',
3914 'hashref' => { 'ship_company' => { 'op' => 'ILIKE',
3915 'value' => "%$value%" },
3918 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3920 if defined dbdef->table('cust_main')->column('ship_last');
3923 push @cust_main, FS::cust_main->fuzzy_search(
3924 { 'last' => $value }, #fuzzy hashref
3927 " AND $agentnums_sql", #extra_sql #agent virtualization
3929 push @cust_main, FS::cust_main->fuzzy_search(
3930 { 'company' => $value }, #fuzzy hashref
3933 " AND $agentnums_sql", #extra_sql #agent virtualization
3944 =item check_and_rebuild_fuzzyfiles
3948 sub check_and_rebuild_fuzzyfiles {
3949 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3950 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3951 or &rebuild_fuzzyfiles;
3954 =item rebuild_fuzzyfiles
3958 sub rebuild_fuzzyfiles {
3960 use Fcntl qw(:flock);
3962 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3963 mkdir $dir, 0700 unless -d $dir;
3967 open(LASTLOCK,">>$dir/cust_main.last")
3968 or die "can't open $dir/cust_main.last: $!";
3969 flock(LASTLOCK,LOCK_EX)
3970 or die "can't lock $dir/cust_main.last: $!";
3972 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3974 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3975 if defined dbdef->table('cust_main')->column('ship_last');
3977 open (LASTCACHE,">$dir/cust_main.last.tmp")
3978 or die "can't open $dir/cust_main.last.tmp: $!";
3979 print LASTCACHE join("\n", @all_last), "\n";
3980 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3982 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3987 open(COMPANYLOCK,">>$dir/cust_main.company")
3988 or die "can't open $dir/cust_main.company: $!";
3989 flock(COMPANYLOCK,LOCK_EX)
3990 or die "can't lock $dir/cust_main.company: $!";
3992 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3994 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3995 if defined dbdef->table('cust_main')->column('ship_last');
3997 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3998 or die "can't open $dir/cust_main.company.tmp: $!";
3999 print COMPANYCACHE join("\n", @all_company), "\n";
4000 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
4002 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
4012 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4013 open(LASTCACHE,"<$dir/cust_main.last")
4014 or die "can't open $dir/cust_main.last: $!";
4015 my @array = map { chomp; $_; } <LASTCACHE>;
4025 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4026 open(COMPANYCACHE,"<$dir/cust_main.company")
4027 or die "can't open $dir/cust_main.last: $!";
4028 my @array = map { chomp; $_; } <COMPANYCACHE>;
4033 =item append_fuzzyfiles LASTNAME COMPANY
4037 sub append_fuzzyfiles {
4038 my( $last, $company ) = @_;
4040 &check_and_rebuild_fuzzyfiles;
4042 use Fcntl qw(:flock);
4044 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4048 open(LAST,">>$dir/cust_main.last")
4049 or die "can't open $dir/cust_main.last: $!";
4051 or die "can't lock $dir/cust_main.last: $!";
4053 print LAST "$last\n";
4056 or die "can't unlock $dir/cust_main.last: $!";
4062 open(COMPANY,">>$dir/cust_main.company")
4063 or die "can't open $dir/cust_main.company: $!";
4064 flock(COMPANY,LOCK_EX)
4065 or die "can't lock $dir/cust_main.company: $!";
4067 print COMPANY "$company\n";
4069 flock(COMPANY,LOCK_UN)
4070 or die "can't unlock $dir/cust_main.company: $!";
4084 #warn join('-',keys %$param);
4085 my $fh = $param->{filehandle};
4086 my $agentnum = $param->{agentnum};
4087 my $refnum = $param->{refnum};
4088 my $pkgpart = $param->{pkgpart};
4089 my @fields = @{$param->{fields}};
4091 eval "use Text::CSV_XS;";
4094 my $csv = new Text::CSV_XS;
4101 local $SIG{HUP} = 'IGNORE';
4102 local $SIG{INT} = 'IGNORE';
4103 local $SIG{QUIT} = 'IGNORE';
4104 local $SIG{TERM} = 'IGNORE';
4105 local $SIG{TSTP} = 'IGNORE';
4106 local $SIG{PIPE} = 'IGNORE';
4108 my $oldAutoCommit = $FS::UID::AutoCommit;
4109 local $FS::UID::AutoCommit = 0;
4112 #while ( $columns = $csv->getline($fh) ) {
4114 while ( defined($line=<$fh>) ) {
4116 $csv->parse($line) or do {
4117 $dbh->rollback if $oldAutoCommit;
4118 return "can't parse: ". $csv->error_input();
4121 my @columns = $csv->fields();
4122 #warn join('-',@columns);
4125 agentnum => $agentnum,
4127 country => $conf->config('countrydefault') || 'US',
4128 payby => 'BILL', #default
4129 paydate => '12/2037', #default
4131 my $billtime = time;
4132 my %cust_pkg = ( pkgpart => $pkgpart );
4133 foreach my $field ( @fields ) {
4134 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4135 #$cust_pkg{$1} = str2time( shift @$columns );
4136 if ( $1 eq 'setup' ) {
4137 $billtime = str2time(shift @columns);
4139 $cust_pkg{$1} = str2time( shift @columns );
4142 #$cust_main{$field} = shift @$columns;
4143 $cust_main{$field} = shift @columns;
4147 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4148 my $cust_main = new FS::cust_main ( \%cust_main );
4150 tie my %hash, 'Tie::RefHash'; #this part is important
4151 $hash{$cust_pkg} = [] if $pkgpart;
4152 my $error = $cust_main->insert( \%hash );
4155 $dbh->rollback if $oldAutoCommit;
4156 return "can't insert customer for $line: $error";
4159 #false laziness w/bill.cgi
4160 $error = $cust_main->bill( 'time' => $billtime );
4162 $dbh->rollback if $oldAutoCommit;
4163 return "can't bill customer for $line: $error";
4166 $cust_main->apply_payments;
4167 $cust_main->apply_credits;
4169 $error = $cust_main->collect();
4171 $dbh->rollback if $oldAutoCommit;
4172 return "can't collect customer for $line: $error";
4178 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4180 return "Empty file!" unless $imported;
4192 #warn join('-',keys %$param);
4193 my $fh = $param->{filehandle};
4194 my @fields = @{$param->{fields}};
4196 eval "use Text::CSV_XS;";
4199 my $csv = new Text::CSV_XS;
4206 local $SIG{HUP} = 'IGNORE';
4207 local $SIG{INT} = 'IGNORE';
4208 local $SIG{QUIT} = 'IGNORE';
4209 local $SIG{TERM} = 'IGNORE';
4210 local $SIG{TSTP} = 'IGNORE';
4211 local $SIG{PIPE} = 'IGNORE';
4213 my $oldAutoCommit = $FS::UID::AutoCommit;
4214 local $FS::UID::AutoCommit = 0;
4217 #while ( $columns = $csv->getline($fh) ) {
4219 while ( defined($line=<$fh>) ) {
4221 $csv->parse($line) or do {
4222 $dbh->rollback if $oldAutoCommit;
4223 return "can't parse: ". $csv->error_input();
4226 my @columns = $csv->fields();
4227 #warn join('-',@columns);
4230 foreach my $field ( @fields ) {
4231 $row{$field} = shift @columns;
4234 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4235 unless ( $cust_main ) {
4236 $dbh->rollback if $oldAutoCommit;
4237 return "unknown custnum $row{'custnum'}";
4240 if ( $row{'amount'} > 0 ) {
4241 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4243 $dbh->rollback if $oldAutoCommit;
4247 } elsif ( $row{'amount'} < 0 ) {
4248 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4251 $dbh->rollback if $oldAutoCommit;
4261 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4263 return "Empty file!" unless $imported;
4275 The delete method should possibly take an FS::cust_main object reference
4276 instead of a scalar customer number.
4278 Bill and collect options should probably be passed as references instead of a
4281 There should probably be a configuration file with a list of allowed credit
4284 No multiple currency support (probably a larger project than just this module).
4286 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4290 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4291 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4292 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.