4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
5 $import $skip_fuzzyfiles );
6 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 eval "use Time::Local;";
12 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
13 if $] < 5.006 && !defined($Time::Local::VERSION);
14 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 eval "use Time::Local qw(timelocal_nocheck);";
17 use Digest::MD5 qw(md5_base64);
20 use String::Approx qw(amatch);
21 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( send_email );
25 use FS::Msgcat qw(gettext);
29 use FS::cust_bill_pkg;
31 use FS::cust_pay_void;
34 use FS::part_referral;
35 use FS::cust_main_county;
37 use FS::cust_main_invoice;
38 use FS::cust_credit_bill;
39 use FS::cust_bill_pay;
40 use FS::prepay_credit;
43 use FS::part_bill_event;
44 use FS::cust_bill_event;
45 use FS::cust_tax_exempt;
47 use FS::payment_gateway;
48 use FS::agent_payment_gateway;
51 @ISA = qw( FS::Record );
53 @EXPORT_OK = qw( smart_search );
55 $realtime_bop_decline_quiet = 0;
58 $me = '[FS::cust_main]';
63 @encrypted_fields = ('payinfo', 'paycvv');
65 #ask FS::UID to run this stuff for us later
66 #$FS::UID::callback{'FS::cust_main'} = sub {
67 install_callback FS::UID sub {
69 #yes, need it for stuff below (prolly should be cached)
74 my ( $hashref, $cache ) = @_;
75 if ( exists $hashref->{'pkgnum'} ) {
76 # #@{ $self->{'_pkgnum'} } = ();
77 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
78 $self->{'_pkgnum'} = $subcache;
79 #push @{ $self->{'_pkgnum'} },
80 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
86 FS::cust_main - Object methods for cust_main records
92 $record = new FS::cust_main \%hash;
93 $record = new FS::cust_main { 'column' => 'value' };
95 $error = $record->insert;
97 $error = $new_record->replace($old_record);
99 $error = $record->delete;
101 $error = $record->check;
103 @cust_pkg = $record->all_pkgs;
105 @cust_pkg = $record->ncancelled_pkgs;
107 @cust_pkg = $record->suspended_pkgs;
109 $error = $record->bill;
110 $error = $record->bill %options;
111 $error = $record->bill 'time' => $time;
113 $error = $record->collect;
114 $error = $record->collect %options;
115 $error = $record->collect 'invoice_time' => $time,
116 'batch_card' => 'yes',
117 'report_badcard' => 'yes',
122 An FS::cust_main object represents a customer. FS::cust_main inherits from
123 FS::Record. The following fields are currently supported:
127 =item custnum - primary key (assigned automatically for new customers)
129 =item agentnum - agent (see L<FS::agent>)
131 =item refnum - Advertising source (see L<FS::part_referral>)
137 =item ss - social security number (optional)
139 =item company - (optional)
143 =item address2 - (optional)
147 =item county - (optional, see L<FS::cust_main_county>)
149 =item state - (see L<FS::cust_main_county>)
153 =item country - (see L<FS::cust_main_county>)
155 =item daytime - phone (optional)
157 =item night - phone (optional)
159 =item fax - phone (optional)
161 =item ship_first - name
163 =item ship_last - name
165 =item ship_company - (optional)
169 =item ship_address2 - (optional)
173 =item ship_county - (optional, see L<FS::cust_main_county>)
175 =item ship_state - (see L<FS::cust_main_county>)
179 =item ship_country - (see L<FS::cust_main_county>)
181 =item ship_daytime - phone (optional)
183 =item ship_night - phone (optional)
185 =item ship_fax - phone (optional)
189 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>)
193 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
198 my($self,$payinfo) = @_;
199 if ( defined($payinfo) ) {
200 $self->paymask($payinfo);
201 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
203 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
211 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
215 =item paymask - Masked payment type
221 Mask all but the last four characters.
225 Mask all but last 2 of account number and bank routing number.
229 Do nothing, return the unmasked string.
238 # If it doesn't exist then generate it
239 my $paymask=$self->getfield('paymask');
240 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
241 $value = $self->payinfo;
244 if ( defined($value) && !$self->is_encrypted($value)) {
245 my $payinfo = $value;
246 my $payby = $self->payby;
247 if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
248 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
249 } elsif ($payby eq 'CHEK' ||
250 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
251 my( $account, $aba ) = split('@', $payinfo );
252 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
253 } else { # Tie up loose ends
256 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
257 } elsif (defined($value) && $self->is_encrypted($value)) {
263 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
265 =item paystart_month - start date month (maestro/solo cards only)
267 =item paystart_year - start date year (maestro/solo cards only)
269 =item payissue - issue number (maestro/solo cards only)
271 =item payname - name on card or billing name
273 =item payip - IP address from which payment information was received
275 =item tax - tax exempt, empty or `Y'
277 =item otaker - order taker (assigned automatically, see L<FS::UID>)
279 =item comments - comments (optional)
281 =item referral_custnum - referring customer number
291 Creates a new customer. To add the customer to the database, see L<"insert">.
293 Note that this stores the hash reference, not a distinct copy of the hash it
294 points to. You can ask the object for a copy with the I<hash> method.
298 sub table { 'cust_main'; }
300 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
302 Adds this customer to the database. If there is an error, returns the error,
303 otherwise returns false.
305 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
306 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
307 are inserted atomicly, or the transaction is rolled back. Passing an empty
308 hash reference is equivalent to not supplying this parameter. There should be
309 a better explanation of this, but until then, here's an example:
312 tie %hash, 'Tie::RefHash'; #this part is important
314 $cust_pkg => [ $svc_acct ],
317 $cust_main->insert( \%hash );
319 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
320 be set as the invoicing list (see L<"invoicing_list">). Errors return as
321 expected and rollback the entire transaction; it is not necessary to call
322 check_invoicing_list first. The invoicing_list is set after the records in the
323 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
324 invoicing_list destination to the newly-created svc_acct. Here's an example:
326 $cust_main->insert( {}, [ $email, 'POST' ] );
328 Currently available options are: I<depend_jobnum> and I<noexport>.
330 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
331 on the supplied jobnum (they will not run until the specific job completes).
332 This can be used to defer provisioning until some action completes (such
333 as running the customer's credit card sucessfully).
335 The I<noexport> option is deprecated. If I<noexport> is set true, no
336 provisioning jobs (exports) are scheduled. (You can schedule them later with
337 the B<reexport> method.)
343 my $cust_pkgs = @_ ? shift : {};
344 my $invoicing_list = @_ ? shift : '';
346 warn "FS::cust_main::insert called with options ".
347 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
350 local $SIG{HUP} = 'IGNORE';
351 local $SIG{INT} = 'IGNORE';
352 local $SIG{QUIT} = 'IGNORE';
353 local $SIG{TERM} = 'IGNORE';
354 local $SIG{TSTP} = 'IGNORE';
355 local $SIG{PIPE} = 'IGNORE';
357 my $oldAutoCommit = $FS::UID::AutoCommit;
358 local $FS::UID::AutoCommit = 0;
361 my $prepay_identifier = '';
362 my( $amount, $seconds ) = ( 0, 0 );
364 if ( $self->payby eq 'PREPAY' ) {
366 $self->payby('BILL');
367 $prepay_identifier = $self->payinfo;
370 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
372 $dbh->rollback if $oldAutoCommit;
373 #return "error applying prepaid card (transaction rolled back): $error";
377 $payby = 'PREP' if $amount;
379 } elsif ( $self->payby =~ /^(CASH|WEST)$/ ) {
382 $self->payby('BILL');
383 $amount = $self->paid;
387 my $error = $self->SUPER::insert;
389 $dbh->rollback if $oldAutoCommit;
390 #return "inserting cust_main record (transaction rolled back): $error";
395 if ( $invoicing_list ) {
396 $error = $self->check_invoicing_list( $invoicing_list );
398 $dbh->rollback if $oldAutoCommit;
399 return "checking invoicing_list (transaction rolled back): $error";
401 $self->invoicing_list( $invoicing_list );
405 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
407 $dbh->rollback if $oldAutoCommit;
412 $dbh->rollback if $oldAutoCommit;
413 return "No svc_acct record to apply pre-paid time";
417 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
419 $dbh->rollback if $oldAutoCommit;
420 return "inserting payment (transaction rolled back): $error";
426 unless ( $import || $skip_fuzzyfiles ) {
427 $error = $self->queue_fuzzyfiles_update;
429 $dbh->rollback if $oldAutoCommit;
430 return "updating fuzzy search cache: $error";
434 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
439 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
441 Like the insert method on an existing record, this method orders a package
442 and included services atomicaly. Pass a Tie::RefHash data structure to this
443 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
444 be a better explanation of this, but until then, here's an example:
447 tie %hash, 'Tie::RefHash'; #this part is important
449 $cust_pkg => [ $svc_acct ],
452 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
454 Services can be new, in which case they are inserted, or existing unaudited
455 services, in which case they are linked to the newly-created package.
457 Currently available options are: I<depend_jobnum> and I<noexport>.
459 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
460 on the supplied jobnum (they will not run until the specific job completes).
461 This can be used to defer provisioning until some action completes (such
462 as running the customer's credit card sucessfully).
464 The I<noexport> option is deprecated. If I<noexport> is set true, no
465 provisioning jobs (exports) are scheduled. (You can schedule them later with
466 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
467 on the cust_main object is not recommended, as existing services will also be
474 my $cust_pkgs = shift;
477 my %svc_options = ();
478 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
479 if exists $options{'depend_jobnum'};
480 warn "FS::cust_main::order_pkgs called with options ".
481 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
484 local $SIG{HUP} = 'IGNORE';
485 local $SIG{INT} = 'IGNORE';
486 local $SIG{QUIT} = 'IGNORE';
487 local $SIG{TERM} = 'IGNORE';
488 local $SIG{TSTP} = 'IGNORE';
489 local $SIG{PIPE} = 'IGNORE';
491 my $oldAutoCommit = $FS::UID::AutoCommit;
492 local $FS::UID::AutoCommit = 0;
495 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
497 foreach my $cust_pkg ( keys %$cust_pkgs ) {
498 $cust_pkg->custnum( $self->custnum );
499 my $error = $cust_pkg->insert;
501 $dbh->rollback if $oldAutoCommit;
502 return "inserting cust_pkg (transaction rolled back): $error";
504 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
505 if ( $svc_something->svcnum ) {
506 my $old_cust_svc = $svc_something->cust_svc;
507 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
508 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
509 $error = $new_cust_svc->replace($old_cust_svc);
511 $svc_something->pkgnum( $cust_pkg->pkgnum );
512 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
513 $svc_something->seconds( $svc_something->seconds + $$seconds );
516 $error = $svc_something->insert(%svc_options);
519 $dbh->rollback if $oldAutoCommit;
520 #return "inserting svc_ (transaction rolled back): $error";
526 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
530 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
532 Recharges this (existing) customer with the specified prepaid card (see
533 L<FS::prepay_credit>), specified either by I<identifier> or as an
534 FS::prepay_credit object. If there is an error, returns the error, otherwise
537 Optionally, two scalar references can be passed as well. They will have their
538 values filled in with the amount and number of seconds applied by this prepaid
543 sub recharge_prepay {
544 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
546 local $SIG{HUP} = 'IGNORE';
547 local $SIG{INT} = 'IGNORE';
548 local $SIG{QUIT} = 'IGNORE';
549 local $SIG{TERM} = 'IGNORE';
550 local $SIG{TSTP} = 'IGNORE';
551 local $SIG{PIPE} = 'IGNORE';
553 my $oldAutoCommit = $FS::UID::AutoCommit;
554 local $FS::UID::AutoCommit = 0;
557 my( $amount, $seconds ) = ( 0, 0 );
559 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
560 || $self->increment_seconds($seconds)
561 || $self->insert_cust_pay_prepay( $amount,
563 ? $prepay_credit->identifier
568 $dbh->rollback if $oldAutoCommit;
572 if ( defined($amountref) ) { $$amountref = $amount; }
573 if ( defined($secondsref) ) { $$secondsref = $seconds; }
575 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
580 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
582 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
583 specified either by I<identifier> or as an FS::prepay_credit object.
585 References to I<amount> and I<seconds> scalars should be passed as arguments
586 and will be incremented by the values of the prepaid card.
588 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
589 check or set this customer's I<agentnum>.
591 If there is an error, returns the error, otherwise returns false.
597 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
599 local $SIG{HUP} = 'IGNORE';
600 local $SIG{INT} = 'IGNORE';
601 local $SIG{QUIT} = 'IGNORE';
602 local $SIG{TERM} = 'IGNORE';
603 local $SIG{TSTP} = 'IGNORE';
604 local $SIG{PIPE} = 'IGNORE';
606 my $oldAutoCommit = $FS::UID::AutoCommit;
607 local $FS::UID::AutoCommit = 0;
610 unless ( ref($prepay_credit) ) {
612 my $identifier = $prepay_credit;
614 $prepay_credit = qsearchs(
616 { 'identifier' => $prepay_credit },
621 unless ( $prepay_credit ) {
622 $dbh->rollback if $oldAutoCommit;
623 return "Invalid prepaid card: ". $identifier;
628 if ( $prepay_credit->agentnum ) {
629 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
630 $dbh->rollback if $oldAutoCommit;
631 return "prepaid card not valid for agent ". $self->agentnum;
633 $self->agentnum($prepay_credit->agentnum);
636 my $error = $prepay_credit->delete;
638 $dbh->rollback if $oldAutoCommit;
639 return "removing prepay_credit (transaction rolled back): $error";
642 $$amountref += $prepay_credit->amount;
643 $$secondsref += $prepay_credit->seconds;
645 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
650 =item increment_seconds SECONDS
652 Updates this customer's single or primary account (see L<FS::svc_acct>) by
653 the specified number of seconds. If there is an error, returns the error,
654 otherwise returns false.
658 sub increment_seconds {
659 my( $self, $seconds ) = @_;
660 warn "$me increment_seconds called: $seconds seconds\n"
663 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
664 $self->ncancelled_pkgs;
667 return 'No packages with primary or single services found'.
668 ' to apply pre-paid time';
669 } elsif ( scalar(@cust_pkg) > 1 ) {
670 #maybe have a way to specify the package/account?
671 return 'Multiple packages found to apply pre-paid time';
674 my $cust_pkg = $cust_pkg[0];
675 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
679 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
682 return 'No account found to apply pre-paid time';
683 } elsif ( scalar(@cust_svc) > 1 ) {
684 return 'Multiple accounts found to apply pre-paid time';
687 my $svc_acct = $cust_svc[0]->svc_x;
688 warn " found service svcnum ". $svc_acct->pkgnum.
689 ' ('. $svc_acct->email. ")\n"
692 $svc_acct->increment_seconds($seconds);
696 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
698 Inserts a prepayment in the specified amount for this customer. An optional
699 second argument can specify the prepayment identifier for tracking purposes.
700 If there is an error, returns the error, otherwise returns false.
704 sub insert_cust_pay_prepay {
705 shift->insert_cust_pay('PREP', @_);
708 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
710 Inserts a cash payment in the specified amount for this customer. An optional
711 second argument can specify the payment identifier for tracking purposes.
712 If there is an error, returns the error, otherwise returns false.
716 sub insert_cust_pay_cash {
717 shift->insert_cust_pay('CASH', @_);
720 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
722 Inserts a Western Union payment in the specified amount for this customer. An
723 optional second argument can specify the prepayment identifier for tracking
724 purposes. If there is an error, returns the error, otherwise returns false.
728 sub insert_cust_pay_west {
729 shift->insert_cust_pay('WEST', @_);
732 sub insert_cust_pay {
733 my( $self, $payby, $amount ) = splice(@_, 0, 3);
734 my $payinfo = scalar(@_) ? shift : '';
736 my $cust_pay = new FS::cust_pay {
737 'custnum' => $self->custnum,
738 'paid' => sprintf('%.2f', $amount),
739 #'_date' => #date the prepaid card was purchased???
741 'payinfo' => $payinfo,
749 This method is deprecated. See the I<depend_jobnum> option to the insert and
750 order_pkgs methods for a better way to defer provisioning.
752 Re-schedules all exports by calling the B<reexport> method of all associated
753 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
754 otherwise returns false.
761 carp "warning: FS::cust_main::reexport is deprectated; ".
762 "use the depend_jobnum option to insert or order_pkgs to delay export";
764 local $SIG{HUP} = 'IGNORE';
765 local $SIG{INT} = 'IGNORE';
766 local $SIG{QUIT} = 'IGNORE';
767 local $SIG{TERM} = 'IGNORE';
768 local $SIG{TSTP} = 'IGNORE';
769 local $SIG{PIPE} = 'IGNORE';
771 my $oldAutoCommit = $FS::UID::AutoCommit;
772 local $FS::UID::AutoCommit = 0;
775 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
776 my $error = $cust_pkg->reexport;
778 $dbh->rollback if $oldAutoCommit;
783 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
788 =item delete NEW_CUSTNUM
790 This deletes the customer. If there is an error, returns the error, otherwise
793 This will completely remove all traces of the customer record. This is not
794 what you want when a customer cancels service; for that, cancel all of the
795 customer's packages (see L</cancel>).
797 If the customer has any uncancelled packages, you need to pass a new (valid)
798 customer number for those packages to be transferred to. Cancelled packages
799 will be deleted. Did I mention that this is NOT what you want when a customer
800 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
802 You can't delete a customer with invoices (see L<FS::cust_bill>),
803 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
804 refunds (see L<FS::cust_refund>).
811 local $SIG{HUP} = 'IGNORE';
812 local $SIG{INT} = 'IGNORE';
813 local $SIG{QUIT} = 'IGNORE';
814 local $SIG{TERM} = 'IGNORE';
815 local $SIG{TSTP} = 'IGNORE';
816 local $SIG{PIPE} = 'IGNORE';
818 my $oldAutoCommit = $FS::UID::AutoCommit;
819 local $FS::UID::AutoCommit = 0;
822 if ( $self->cust_bill ) {
823 $dbh->rollback if $oldAutoCommit;
824 return "Can't delete a customer with invoices";
826 if ( $self->cust_credit ) {
827 $dbh->rollback if $oldAutoCommit;
828 return "Can't delete a customer with credits";
830 if ( $self->cust_pay ) {
831 $dbh->rollback if $oldAutoCommit;
832 return "Can't delete a customer with payments";
834 if ( $self->cust_refund ) {
835 $dbh->rollback if $oldAutoCommit;
836 return "Can't delete a customer with refunds";
839 my @cust_pkg = $self->ncancelled_pkgs;
841 my $new_custnum = shift;
842 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
843 $dbh->rollback if $oldAutoCommit;
844 return "Invalid new customer number: $new_custnum";
846 foreach my $cust_pkg ( @cust_pkg ) {
847 my %hash = $cust_pkg->hash;
848 $hash{'custnum'} = $new_custnum;
849 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
850 my $error = $new_cust_pkg->replace($cust_pkg);
852 $dbh->rollback if $oldAutoCommit;
857 my @cancelled_cust_pkg = $self->all_pkgs;
858 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
859 my $error = $cust_pkg->delete;
861 $dbh->rollback if $oldAutoCommit;
866 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
867 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
869 my $error = $cust_main_invoice->delete;
871 $dbh->rollback if $oldAutoCommit;
876 my $error = $self->SUPER::delete;
878 $dbh->rollback if $oldAutoCommit;
882 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
887 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
889 Replaces the OLD_RECORD with this one in the database. If there is an error,
890 returns the error, otherwise returns false.
892 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
893 be set as the invoicing list (see L<"invoicing_list">). Errors return as
894 expected and rollback the entire transaction; it is not necessary to call
895 check_invoicing_list first. Here's an example:
897 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
906 local $SIG{HUP} = 'IGNORE';
907 local $SIG{INT} = 'IGNORE';
908 local $SIG{QUIT} = 'IGNORE';
909 local $SIG{TERM} = 'IGNORE';
910 local $SIG{TSTP} = 'IGNORE';
911 local $SIG{PIPE} = 'IGNORE';
913 # If the mask is blank then try to set it - if we can...
914 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
915 $self->paymask($self->payinfo);
918 # We absolutely have to have an old vs. new record to make this work.
919 if (!defined($old)) {
920 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
923 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
924 && $conf->config('users-allow_comp') ) {
925 return "You are not permitted to create complimentary accounts."
926 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
929 my $oldAutoCommit = $FS::UID::AutoCommit;
930 local $FS::UID::AutoCommit = 0;
933 my $error = $self->SUPER::replace($old);
936 $dbh->rollback if $oldAutoCommit;
940 if ( @param ) { # INVOICING_LIST_ARYREF
941 my $invoicing_list = shift @param;
942 $error = $self->check_invoicing_list( $invoicing_list );
944 $dbh->rollback if $oldAutoCommit;
947 $self->invoicing_list( $invoicing_list );
950 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
951 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
952 # card/check/lec info has changed, want to retry realtime_ invoice events
953 my $error = $self->retry_realtime;
955 $dbh->rollback if $oldAutoCommit;
960 unless ( $import || $skip_fuzzyfiles ) {
961 $error = $self->queue_fuzzyfiles_update;
963 $dbh->rollback if $oldAutoCommit;
964 return "updating fuzzy search cache: $error";
968 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
973 =item queue_fuzzyfiles_update
975 Used by insert & replace to update the fuzzy search cache
979 sub queue_fuzzyfiles_update {
982 local $SIG{HUP} = 'IGNORE';
983 local $SIG{INT} = 'IGNORE';
984 local $SIG{QUIT} = 'IGNORE';
985 local $SIG{TERM} = 'IGNORE';
986 local $SIG{TSTP} = 'IGNORE';
987 local $SIG{PIPE} = 'IGNORE';
989 my $oldAutoCommit = $FS::UID::AutoCommit;
990 local $FS::UID::AutoCommit = 0;
993 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
994 my $error = $queue->insert($self->getfield('last'), $self->company);
996 $dbh->rollback if $oldAutoCommit;
997 return "queueing job (transaction rolled back): $error";
1000 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1001 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1002 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1004 $dbh->rollback if $oldAutoCommit;
1005 return "queueing job (transaction rolled back): $error";
1009 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1016 Checks all fields to make sure this is a valid customer record. If there is
1017 an error, returns the error, otherwise returns false. Called by the insert
1018 and replace methods.
1025 #warn "BEFORE: \n". $self->_dump;
1028 $self->ut_numbern('custnum')
1029 || $self->ut_number('agentnum')
1030 || $self->ut_number('refnum')
1031 || $self->ut_name('last')
1032 || $self->ut_name('first')
1033 || $self->ut_textn('company')
1034 || $self->ut_text('address1')
1035 || $self->ut_textn('address2')
1036 || $self->ut_text('city')
1037 || $self->ut_textn('county')
1038 || $self->ut_textn('state')
1039 || $self->ut_country('country')
1040 || $self->ut_anything('comments')
1041 || $self->ut_numbern('referral_custnum')
1043 #barf. need message catalogs. i18n. etc.
1044 $error .= "Please select an advertising source."
1045 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1046 return $error if $error;
1048 return "Unknown agent"
1049 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1051 return "Unknown refnum"
1052 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1054 return "Unknown referring custnum: ". $self->referral_custnum
1055 unless ! $self->referral_custnum
1056 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1058 if ( $self->ss eq '' ) {
1063 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1064 or return "Illegal social security number: ". $self->ss;
1065 $self->ss("$1-$2-$3");
1069 # bad idea to disable, causes billing to fail because of no tax rates later
1070 # unless ( $import ) {
1071 unless ( qsearch('cust_main_county', {
1072 'country' => $self->country,
1075 return "Unknown state/county/country: ".
1076 $self->state. "/". $self->county. "/". $self->country
1077 unless qsearch('cust_main_county',{
1078 'state' => $self->state,
1079 'county' => $self->county,
1080 'country' => $self->country,
1086 $self->ut_phonen('daytime', $self->country)
1087 || $self->ut_phonen('night', $self->country)
1088 || $self->ut_phonen('fax', $self->country)
1089 || $self->ut_zip('zip', $self->country)
1091 return $error if $error;
1094 last first company address1 address2 city county state zip
1095 country daytime night fax
1098 if ( defined $self->dbdef_table->column('ship_last') ) {
1099 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1101 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1105 $self->ut_name('ship_last')
1106 || $self->ut_name('ship_first')
1107 || $self->ut_textn('ship_company')
1108 || $self->ut_text('ship_address1')
1109 || $self->ut_textn('ship_address2')
1110 || $self->ut_text('ship_city')
1111 || $self->ut_textn('ship_county')
1112 || $self->ut_textn('ship_state')
1113 || $self->ut_country('ship_country')
1115 return $error if $error;
1117 #false laziness with above
1118 unless ( qsearchs('cust_main_county', {
1119 'country' => $self->ship_country,
1122 return "Unknown ship_state/ship_county/ship_country: ".
1123 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1124 unless qsearch('cust_main_county',{
1125 'state' => $self->ship_state,
1126 'county' => $self->ship_county,
1127 'country' => $self->ship_country,
1133 $self->ut_phonen('ship_daytime', $self->ship_country)
1134 || $self->ut_phonen('ship_night', $self->ship_country)
1135 || $self->ut_phonen('ship_fax', $self->ship_country)
1136 || $self->ut_zip('ship_zip', $self->ship_country)
1138 return $error if $error;
1140 } else { # ship_ info eq billing info, so don't store dup info in database
1141 $self->setfield("ship_$_", '')
1142 foreach qw( last first company address1 address2 city county state zip
1143 country daytime night fax );
1147 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST)$/
1148 or return "Illegal payby: ". $self->payby;
1150 $error = $self->ut_numbern('paystart_month')
1151 || $self->ut_numbern('paystart_year')
1152 || $self->ut_numbern('payissue')
1154 return $error if $error;
1156 if ( $self->payip eq '' ) {
1159 $error = $self->ut_ip('payip');
1160 return $error if $error;
1163 # If it is encrypted and the private key is not availaible then we can't
1164 # check the credit card.
1166 my $check_payinfo = 1;
1168 if ($self->is_encrypted($self->payinfo)) {
1174 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1176 my $payinfo = $self->payinfo;
1177 $payinfo =~ s/\D//g;
1178 $payinfo =~ /^(\d{13,16})$/
1179 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1181 $self->payinfo($payinfo);
1183 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1185 return gettext('unknown_card_type')
1186 if cardtype($self->payinfo) eq "Unknown";
1188 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1189 return "Banned credit card" if $ban;
1191 if ( defined $self->dbdef_table->column('paycvv') ) {
1192 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1193 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1194 $self->paycvv =~ /^(\d{4})$/
1195 or return "CVV2 (CID) for American Express cards is four digits.";
1198 $self->paycvv =~ /^(\d{3})$/
1199 or return "CVV2 (CVC2/CID) is three digits.";
1207 my $cardtype = cardtype($payinfo);
1208 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1210 return "Start date or issue number is required for $cardtype cards"
1211 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1213 return "Start month must be between 1 and 12"
1214 if $self->paystart_month
1215 and $self->paystart_month < 1 || $self->paystart_month > 12;
1217 return "Start year must be 1990 or later"
1218 if $self->paystart_year
1219 and $self->paystart_year < 1990;
1221 return "Issue number must be beween 1 and 99"
1223 and $self->payissue < 1 || $self->payissue > 99;
1226 $self->paystart_month('');
1227 $self->paystart_year('');
1228 $self->payissue('');
1231 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1233 my $payinfo = $self->payinfo;
1234 $payinfo =~ s/[^\d\@]//g;
1235 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1236 $payinfo = "$1\@$2";
1237 $self->payinfo($payinfo);
1238 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1240 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1241 return "Banned ACH account" if $ban;
1243 } elsif ( $self->payby eq 'LECB' ) {
1245 my $payinfo = $self->payinfo;
1246 $payinfo =~ s/\D//g;
1247 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1249 $self->payinfo($payinfo);
1250 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1252 } elsif ( $self->payby eq 'BILL' ) {
1254 $error = $self->ut_textn('payinfo');
1255 return "Illegal P.O. number: ". $self->payinfo if $error;
1256 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1258 } elsif ( $self->payby eq 'COMP' ) {
1260 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1261 return "You are not permitted to create complimentary accounts."
1262 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1265 $error = $self->ut_textn('payinfo');
1266 return "Illegal comp account issuer: ". $self->payinfo if $error;
1267 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1269 } elsif ( $self->payby eq 'PREPAY' ) {
1271 my $payinfo = $self->payinfo;
1272 $payinfo =~ s/\W//g; #anything else would just confuse things
1273 $self->payinfo($payinfo);
1274 $error = $self->ut_alpha('payinfo');
1275 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1276 return "Unknown prepayment identifier"
1277 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1278 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1282 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1283 return "Expriation date required"
1284 unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB|CASH|WEST)$/;
1288 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1289 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1290 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1291 ( $m, $y ) = ( $3, "20$2" );
1293 return "Illegal expiration date: ". $self->paydate;
1295 $self->paydate("$y-$m-01");
1296 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1297 return gettext('expired_card')
1298 if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1301 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1302 ( ! $conf->exists('require_cardname')
1303 || $self->payby !~ /^(CARD|DCRD)$/ )
1305 $self->payname( $self->first. " ". $self->getfield('last') );
1307 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1308 or return gettext('illegal_name'). " payname: ". $self->payname;
1312 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1315 $self->otaker(getotaker) unless $self->otaker;
1317 #warn "AFTER: \n". $self->_dump;
1319 $self->SUPER::check;
1324 Returns all packages (see L<FS::cust_pkg>) for this customer.
1330 if ( $self->{'_pkgnum'} ) {
1331 values %{ $self->{'_pkgnum'}->cache };
1333 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1337 =item ncancelled_pkgs
1339 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1343 sub ncancelled_pkgs {
1345 if ( $self->{'_pkgnum'} ) {
1346 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1348 @{ [ # force list context
1349 qsearch( 'cust_pkg', {
1350 'custnum' => $self->custnum,
1353 qsearch( 'cust_pkg', {
1354 'custnum' => $self->custnum,
1361 =item suspended_pkgs
1363 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1367 sub suspended_pkgs {
1369 grep { $_->susp } $self->ncancelled_pkgs;
1372 =item unflagged_suspended_pkgs
1374 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1375 customer (thouse packages without the `manual_flag' set).
1379 sub unflagged_suspended_pkgs {
1381 return $self->suspended_pkgs
1382 unless dbdef->table('cust_pkg')->column('manual_flag');
1383 grep { ! $_->manual_flag } $self->suspended_pkgs;
1386 =item unsuspended_pkgs
1388 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1393 sub unsuspended_pkgs {
1395 grep { ! $_->susp } $self->ncancelled_pkgs;
1398 =item num_cancelled_pkgs
1400 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1405 sub num_cancelled_pkgs {
1407 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1411 my( $self, $sql ) = @_;
1412 my $sth = dbh->prepare(
1413 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1414 ) or die dbh->errstr;
1415 $sth->execute($self->custnum) or die $sth->errstr;
1416 $sth->fetchrow_arrayref->[0];
1421 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1422 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1423 on success or a list of errors.
1429 grep { $_->unsuspend } $self->suspended_pkgs;
1434 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1435 Always returns a list: an empty list on success or a list of errors.
1441 grep { $_->suspend } $self->unsuspended_pkgs;
1444 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1446 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1447 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1448 success or a list of errors.
1452 sub suspend_if_pkgpart {
1455 grep { $_->suspend }
1456 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1457 $self->unsuspended_pkgs;
1460 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1462 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1463 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1464 on success or a list of errors.
1468 sub suspend_unless_pkgpart {
1471 grep { $_->suspend }
1472 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1473 $self->unsuspended_pkgs;
1476 =item cancel [ OPTION => VALUE ... ]
1478 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1480 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1482 I<quiet> can be set true to supress email cancellation notices.
1484 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1486 I<ban> can be set true to ban this customer's credit card or ACH information,
1489 Always returns a list: an empty list on success or a list of errors.
1497 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1499 #should try decryption (we might have the private key)
1500 # and if not maybe queue a job for the server that does?
1501 return ( "Can't (yet) ban encrypted credit cards" )
1502 if $self->is_encrypted($self->payinfo);
1504 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1505 my $error = $ban->insert;
1506 return ( $error ) if $error;
1510 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1513 sub _banned_pay_hashref {
1524 'payby' => $payby2ban{$self->payby},
1525 'payinfo' => md5_base64($self->payinfo),
1532 Returns the agent (see L<FS::agent>) for this customer.
1538 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1543 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1544 conjunction with the collect method.
1546 Options are passed as name-value pairs.
1548 Currently available options are:
1550 resetup - if set true, re-charges setup fees.
1552 time - bills the customer as if it were that time. Specified as a UNIX
1553 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1554 L<Date::Parse> for conversion functions. For example:
1558 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1561 If there is an error, returns the error, otherwise returns false.
1566 my( $self, %options ) = @_;
1567 return '' if $self->payby eq 'COMP';
1568 warn "bill customer ". $self->custnum. "\n" if $DEBUG;
1570 my $time = $options{'time'} || time;
1575 local $SIG{HUP} = 'IGNORE';
1576 local $SIG{INT} = 'IGNORE';
1577 local $SIG{QUIT} = 'IGNORE';
1578 local $SIG{TERM} = 'IGNORE';
1579 local $SIG{TSTP} = 'IGNORE';
1580 local $SIG{PIPE} = 'IGNORE';
1582 my $oldAutoCommit = $FS::UID::AutoCommit;
1583 local $FS::UID::AutoCommit = 0;
1586 $self->select_for_update; #mutex
1588 # find the packages which are due for billing, find out how much they are
1589 # & generate invoice database.
1591 my( $total_setup, $total_recur ) = ( 0, 0 );
1592 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1593 my @cust_bill_pkg = ();
1595 #my $taxable_charged = 0;##
1600 foreach my $cust_pkg (
1601 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1604 #NO!! next if $cust_pkg->cancel;
1605 next if $cust_pkg->getfield('cancel');
1607 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
1609 #? to avoid use of uninitialized value errors... ?
1610 $cust_pkg->setfield('bill', '')
1611 unless defined($cust_pkg->bill);
1613 my $part_pkg = $cust_pkg->part_pkg;
1615 my %hash = $cust_pkg->hash;
1616 my $old_cust_pkg = new FS::cust_pkg \%hash;
1622 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1624 warn " bill setup\n" if $DEBUG;
1626 $setup = eval { $cust_pkg->calc_setup( $time ) };
1628 $dbh->rollback if $oldAutoCommit;
1632 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1638 if ( $part_pkg->getfield('freq') ne '0' &&
1639 ! $cust_pkg->getfield('susp') &&
1640 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1643 warn " bill recur\n" if $DEBUG;
1645 # XXX shared with $recur_prog
1646 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1648 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1650 $dbh->rollback if $oldAutoCommit;
1654 #change this bit to use Date::Manip? CAREFUL with timezones (see
1655 # mailing list archive)
1656 my ($sec,$min,$hour,$mday,$mon,$year) =
1657 (localtime($sdate) )[0,1,2,3,4,5];
1659 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1660 # only for figuring next bill date, nothing else, so, reset $sdate again
1662 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1663 $cust_pkg->last_bill($sdate)
1664 if $cust_pkg->dbdef_table->column('last_bill');
1666 if ( $part_pkg->freq =~ /^\d+$/ ) {
1667 $mon += $part_pkg->freq;
1668 until ( $mon < 12 ) { $mon -= 12; $year++; }
1669 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1671 $mday += $weeks * 7;
1672 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1675 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1679 $dbh->rollback if $oldAutoCommit;
1680 return "unparsable frequency: ". $part_pkg->freq;
1682 $cust_pkg->setfield('bill',
1683 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1686 warn "\$setup is undefined" unless defined($setup);
1687 warn "\$recur is undefined" unless defined($recur);
1688 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1690 if ( $cust_pkg->modified ) {
1692 warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1694 $error=$cust_pkg->replace($old_cust_pkg);
1695 if ( $error ) { #just in case
1696 $dbh->rollback if $oldAutoCommit;
1697 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1700 $setup = sprintf( "%.2f", $setup );
1701 $recur = sprintf( "%.2f", $recur );
1702 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1703 $dbh->rollback if $oldAutoCommit;
1704 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1706 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1707 $dbh->rollback if $oldAutoCommit;
1708 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1710 if ( $setup != 0 || $recur != 0 ) {
1711 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1713 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1714 'pkgnum' => $cust_pkg->pkgnum,
1718 'edate' => $cust_pkg->bill,
1719 'details' => \@details,
1721 push @cust_bill_pkg, $cust_bill_pkg;
1722 $total_setup += $setup;
1723 $total_recur += $recur;
1725 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1727 my @taxes = qsearch( 'cust_main_county', {
1728 'state' => $self->state,
1729 'county' => $self->county,
1730 'country' => $self->country,
1731 'taxclass' => $part_pkg->taxclass,
1734 @taxes = qsearch( 'cust_main_county', {
1735 'state' => $self->state,
1736 'county' => $self->county,
1737 'country' => $self->country,
1742 #one more try at a whole-country tax rate
1744 @taxes = qsearch( 'cust_main_county', {
1747 'country' => $self->country,
1752 # maybe eliminate this entirely, along with all the 0% records
1754 $dbh->rollback if $oldAutoCommit;
1756 "fatal: can't find tax rate for state/county/country/taxclass ".
1757 join('/', ( map $self->$_(), qw(state county country) ),
1758 $part_pkg->taxclass ). "\n";
1761 foreach my $tax ( @taxes ) {
1763 my $taxable_charged = 0;
1764 $taxable_charged += $setup
1765 unless $part_pkg->setuptax =~ /^Y$/i
1766 || $tax->setuptax =~ /^Y$/i;
1767 $taxable_charged += $recur
1768 unless $part_pkg->recurtax =~ /^Y$/i
1769 || $tax->recurtax =~ /^Y$/i;
1770 next unless $taxable_charged;
1772 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1773 my ($mon,$year) = (localtime($sdate) )[4,5];
1775 my $freq = $part_pkg->freq || 1;
1776 if ( $freq !~ /(\d+)$/ ) {
1777 $dbh->rollback if $oldAutoCommit;
1778 return "daily/weekly package definitions not (yet?)".
1779 " compatible with monthly tax exemptions";
1781 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1782 foreach my $which_month ( 1 .. $freq ) {
1784 'custnum' => $self->custnum,
1785 'taxnum' => $tax->taxnum,
1786 'year' => 1900+$year,
1789 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1790 until ( $mon < 13 ) { $mon -= 12; $year++; }
1791 my $cust_tax_exempt =
1792 qsearchs('cust_tax_exempt', \%hash)
1793 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1794 my $remaining_exemption = sprintf("%.2f",
1795 $tax->exempt_amount - $cust_tax_exempt->amount );
1796 if ( $remaining_exemption > 0 ) {
1797 my $addl = $remaining_exemption > $taxable_per_month
1798 ? $taxable_per_month
1799 : $remaining_exemption;
1800 $taxable_charged -= $addl;
1801 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1802 $cust_tax_exempt->hash,
1804 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1806 $error = $new_cust_tax_exempt->exemptnum
1807 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1808 : $new_cust_tax_exempt->insert;
1810 $dbh->rollback if $oldAutoCommit;
1811 return "fatal: can't update cust_tax_exempt: $error";
1814 } # if $remaining_exemption > 0
1816 } #foreach $which_month
1818 } #if $tax->exempt_amount
1820 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1822 #$tax += $taxable_charged * $cust_main_county->tax / 100
1823 $tax{ $tax->taxname || 'Tax' } +=
1824 $taxable_charged * $tax->tax / 100
1826 } #foreach my $tax ( @taxes )
1828 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1830 } #if $setup != 0 || $recur != 0
1832 } #if $cust_pkg->modified
1834 } #foreach my $cust_pkg
1836 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1837 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1839 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1840 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1844 # unless ( $self->tax =~ /Y/i
1845 # || $self->payby eq 'COMP'
1846 # || $taxable_charged == 0 ) {
1847 # my $cust_main_county = qsearchs('cust_main_county',{
1848 # 'state' => $self->state,
1849 # 'county' => $self->county,
1850 # 'country' => $self->country,
1851 # } ) or die "fatal: can't find tax rate for state/county/country ".
1852 # $self->state. "/". $self->county. "/". $self->country. "\n";
1853 # my $tax = sprintf( "%.2f",
1854 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1857 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1859 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1860 my $tax = sprintf("%.2f", $tax{$taxname} );
1861 $charged = sprintf( "%.2f", $charged+$tax );
1863 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1869 'itemdesc' => $taxname,
1871 push @cust_bill_pkg, $cust_bill_pkg;
1874 } else { #1.4 schema
1877 foreach ( values %tax ) { $tax += $_ };
1878 $tax = sprintf("%.2f", $tax);
1880 $charged = sprintf( "%.2f", $charged+$tax );
1882 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1889 push @cust_bill_pkg, $cust_bill_pkg;
1894 my $cust_bill = new FS::cust_bill ( {
1895 'custnum' => $self->custnum,
1897 'charged' => $charged,
1899 $error = $cust_bill->insert;
1901 $dbh->rollback if $oldAutoCommit;
1902 return "can't create invoice for customer #". $self->custnum. ": $error";
1905 my $invnum = $cust_bill->invnum;
1907 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1909 $cust_bill_pkg->invnum($invnum);
1910 $error = $cust_bill_pkg->insert;
1912 $dbh->rollback if $oldAutoCommit;
1913 return "can't create invoice line item for customer #". $self->custnum.
1918 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1922 =item collect OPTIONS
1924 (Attempt to) collect money for this customer's outstanding invoices (see
1925 L<FS::cust_bill>). Usually used after the bill method.
1927 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1928 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1929 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1931 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1932 and the invoice events web interface.
1934 If there is an error, returns the error, otherwise returns false.
1936 Options are passed as name-value pairs.
1938 Currently available options are:
1940 invoice_time - Use this time when deciding when to print invoices and
1941 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>
1942 for conversion functions.
1944 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1947 retry_card - Deprecated alias for 'retry'
1949 batch_card - This option is deprecated. See the invoice events web interface
1950 to control whether cards are batched or run against a realtime gateway.
1952 report_badcard - This option is deprecated.
1954 force_print - This option is deprecated; see the invoice events web interface.
1956 quiet - set true to surpress email card/ACH decline notices.
1961 my( $self, %options ) = @_;
1962 my $invoice_time = $options{'invoice_time'} || time;
1965 local $SIG{HUP} = 'IGNORE';
1966 local $SIG{INT} = 'IGNORE';
1967 local $SIG{QUIT} = 'IGNORE';
1968 local $SIG{TERM} = 'IGNORE';
1969 local $SIG{TSTP} = 'IGNORE';
1970 local $SIG{PIPE} = 'IGNORE';
1972 my $oldAutoCommit = $FS::UID::AutoCommit;
1973 local $FS::UID::AutoCommit = 0;
1976 $self->select_for_update; #mutex
1978 my $balance = $self->balance;
1979 warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG;
1980 unless ( $balance > 0 ) { #redundant?????
1981 $dbh->rollback if $oldAutoCommit; #hmm
1985 if ( exists($options{'retry_card'}) ) {
1986 carp 'retry_card option passed to collect is deprecated; use retry';
1987 $options{'retry'} ||= $options{'retry_card'};
1989 if ( exists($options{'retry'}) && $options{'retry'} ) {
1990 my $error = $self->retry_realtime;
1992 $dbh->rollback if $oldAutoCommit;
1997 foreach my $cust_bill ( $self->open_cust_bill ) {
1999 # don't try to charge for the same invoice if it's already in a batch
2000 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2002 last if $self->balance <= 0;
2004 warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2007 foreach my $part_bill_event (
2008 sort { $a->seconds <=> $b->seconds
2009 || $a->weight <=> $b->weight
2010 || $a->eventpart <=> $b->eventpart }
2011 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2012 && ! qsearch( 'cust_bill_event', {
2013 'invnum' => $cust_bill->invnum,
2014 'eventpart' => $_->eventpart,
2018 qsearch('part_bill_event', { 'payby' => $self->payby,
2019 'disabled' => '', } )
2022 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2023 || $self->balance <= 0; # or if balance<=0
2025 warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
2027 my $cust_main = $self; #for callback
2031 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2032 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2033 $error = eval $part_bill_event->eventcode;
2037 my $statustext = '';
2041 } elsif ( $error ) {
2043 $statustext = $error;
2048 #add cust_bill_event
2049 my $cust_bill_event = new FS::cust_bill_event {
2050 'invnum' => $cust_bill->invnum,
2051 'eventpart' => $part_bill_event->eventpart,
2052 #'_date' => $invoice_time,
2054 'status' => $status,
2055 'statustext' => $statustext,
2057 $error = $cust_bill_event->insert;
2059 #$dbh->rollback if $oldAutoCommit;
2060 #return "error: $error";
2062 # gah, even with transactions.
2063 $dbh->commit if $oldAutoCommit; #well.
2064 my $e = 'WARNING: Event run but database not updated - '.
2065 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2066 ', eventpart '. $part_bill_event->eventpart.
2077 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2082 =item retry_realtime
2084 Schedules realtime credit card / electronic check / LEC billing events for
2085 for retry. Useful if card information has changed or manual retry is desired.
2086 The 'collect' method must be called to actually retry the transaction.
2088 Implementation details: For each of this customer's open invoices, changes
2089 the status of the first "done" (with statustext error) realtime processing
2094 sub retry_realtime {
2097 local $SIG{HUP} = 'IGNORE';
2098 local $SIG{INT} = 'IGNORE';
2099 local $SIG{QUIT} = 'IGNORE';
2100 local $SIG{TERM} = 'IGNORE';
2101 local $SIG{TSTP} = 'IGNORE';
2102 local $SIG{PIPE} = 'IGNORE';
2104 my $oldAutoCommit = $FS::UID::AutoCommit;
2105 local $FS::UID::AutoCommit = 0;
2108 foreach my $cust_bill (
2109 grep { $_->cust_bill_event }
2110 $self->open_cust_bill
2112 my @cust_bill_event =
2113 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2115 #$_->part_bill_event->plan eq 'realtime-card'
2116 $_->part_bill_event->eventcode =~
2117 /\$cust_bill\->realtime_(card|ach|lec)/
2118 && $_->status eq 'done'
2121 $cust_bill->cust_bill_event;
2122 next unless @cust_bill_event;
2123 my $error = $cust_bill_event[0]->retry;
2125 $dbh->rollback if $oldAutoCommit;
2126 return "error scheduling invoice event for retry: $error";
2131 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2136 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2138 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2139 via a Business::OnlinePayment realtime gateway. See
2140 L<http://420.am/business-onlinepayment> for supported gateways.
2142 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2144 Available options are: I<description>, I<invnum>, I<quiet>
2146 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2147 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2148 if set, will override the value from the customer record.
2150 I<description> is a free-text field passed to the gateway. It defaults to
2151 "Internet services".
2153 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2154 specified invoice. If you don't specify an I<invnum> you might want to
2155 call the B<apply_payments> method.
2157 I<quiet> can be set true to surpress email decline notices.
2159 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2164 my( $self, $method, $amount, %options ) = @_;
2166 warn "$self $method $amount\n";
2167 warn " $_ => $options{$_}\n" foreach keys %options;
2170 $options{'description'} ||= 'Internet services';
2172 eval "use Business::OnlinePayment";
2175 my $payinfo = exists($options{'payinfo'})
2176 ? $options{'payinfo'}
2184 if ( $options{'invnum'} ) {
2185 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2186 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2188 map { $_->part_pkg->taxclass }
2190 map { $_->cust_pkg }
2191 $cust_bill->cust_bill_pkg;
2192 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2193 #different taxclasses
2194 $taxclass = $taxclasses[0];
2198 #look for an agent gateway override first
2200 if ( $method eq 'CC' ) {
2201 $cardtype = cardtype($payinfo);
2202 } elsif ( $method eq 'ECHECK' ) {
2205 $cardtype = $method;
2209 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2210 cardtype => $cardtype,
2211 taxclass => $taxclass, } )
2212 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2214 taxclass => $taxclass, } )
2215 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2216 cardtype => $cardtype,
2218 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2220 taxclass => '', } );
2222 my $payment_gateway = '';
2223 my( $processor, $login, $password, $action, @bop_options );
2224 if ( $override ) { #use a payment gateway override
2226 $payment_gateway = $override->payment_gateway;
2228 $processor = $payment_gateway->gateway_module;
2229 $login = $payment_gateway->gateway_username;
2230 $password = $payment_gateway->gateway_password;
2231 $action = $payment_gateway->gateway_action;
2232 @bop_options = $payment_gateway->options;
2234 } else { #use the standard settings from the config
2236 ( $processor, $login, $password, $action, @bop_options ) =
2237 $self->default_payment_gateway($method);
2245 my $address = exists($options{'address1'})
2246 ? $options{'address1'}
2248 my $address2 = exists($options{'address2'})
2249 ? $options{'address2'}
2251 $address .= ", ". $address2 if length($address2);
2253 my $o_payname = exists($options{'payname'})
2254 ? $options{'payname'}
2256 my($payname, $payfirst, $paylast);
2257 if ( $o_payname && $method ne 'ECHECK' ) {
2258 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2259 or return "Illegal payname $payname";
2260 ($payfirst, $paylast) = ($1, $2);
2262 $payfirst = $self->getfield('first');
2263 $paylast = $self->getfield('last');
2264 $payname = "$payfirst $paylast";
2267 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2268 if ( $conf->exists('emailinvoiceauto')
2269 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2270 push @invoicing_list, $self->all_emails;
2273 my $email = ($conf->exists('business-onlinepayment-email-override'))
2274 ? $conf->config('business-onlinepayment-email-override')
2275 : $invoicing_list[0];
2278 if ( $method eq 'CC' ) {
2280 $content{card_number} = $payinfo;
2281 my $paydate = exists($options{'paydate'})
2282 ? $options{'paydate'}
2284 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2285 $content{expiration} = "$2/$1";
2287 my $paycvv = exists($options{'paycvv'})
2288 ? $options{'paycvv'}
2290 $content{cvv2} = $self->paycvv
2293 my $paystart_month = exists($options{'paystart_month'})
2294 ? $options{'paystart_month'}
2295 : $self->paystart_month;
2297 my $paystart_year = exists($options{'paystart_year'})
2298 ? $options{'paystart_year'}
2299 : $self->paystart_year;
2301 $content{card_start} = "$paystart_month/$paystart_year"
2302 if $paystart_month && $paystart_year;
2304 my $payissue = exists($options{'payissue'})
2305 ? $options{'payissue'}
2307 $content{issue_number} = $payissue if $payissue;
2309 my $payip = exists($options{'payip'})
2312 $content{customer_ip} = $payip
2315 $content{recurring_billing} = 'YES'
2316 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2318 'payinfo' => $payinfo,
2321 } elsif ( $method eq 'ECHECK' ) {
2322 ( $content{account_number}, $content{routing_code} ) =
2323 split('@', $payinfo);
2324 $content{bank_name} = $o_payname;
2325 $content{account_type} = 'CHECKING';
2326 $content{account_name} = $payname;
2327 $content{customer_org} = $self->company ? 'B' : 'I';
2328 $content{customer_ssn} = exists($options{'ss'})
2331 } elsif ( $method eq 'LEC' ) {
2332 $content{phone} = $payinfo;
2336 # run transaction(s)
2339 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2341 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2342 $transaction->content(
2345 'password' => $password,
2346 'action' => $action1,
2347 'description' => $options{'description'},
2348 'amount' => $amount,
2349 'invoice_number' => $options{'invnum'},
2350 'customer_id' => $self->custnum,
2351 'last_name' => $paylast,
2352 'first_name' => $payfirst,
2354 'address' => $address,
2355 'city' => ( exists($options{'city'})
2358 'state' => ( exists($options{'state'})
2361 'zip' => ( exists($options{'zip'})
2364 'country' => ( exists($options{'country'})
2365 ? $options{'country'}
2367 'referer' => 'http://cleanwhisker.420.am/',
2369 'phone' => $self->daytime || $self->night,
2372 $transaction->submit();
2374 if ( $transaction->is_success() && $action2 ) {
2375 my $auth = $transaction->authorization;
2376 my $ordernum = $transaction->can('order_number')
2377 ? $transaction->order_number
2381 new Business::OnlinePayment( $processor, @bop_options );
2388 password => $password,
2389 order_number => $ordernum,
2391 authorization => $auth,
2392 description => $options{'description'},
2395 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2396 transaction_sequence_num local_transaction_date
2397 local_transaction_time AVS_result_code )) {
2398 $capture{$field} = $transaction->$field() if $transaction->can($field);
2401 $capture->content( %capture );
2405 unless ( $capture->is_success ) {
2406 my $e = "Authorization sucessful but capture failed, custnum #".
2407 $self->custnum. ': '. $capture->result_code.
2408 ": ". $capture->error_message;
2416 # remove paycvv after initial transaction
2419 #false laziness w/misc/process/payment.cgi - check both to make sure working
2421 if ( defined $self->dbdef_table->column('paycvv')
2422 && length($self->paycvv)
2423 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2425 my $error = $self->remove_cvv;
2427 warn "error removing cvv: $error\n";
2435 if ( $transaction->is_success() ) {
2437 my %method2payby = (
2444 if ( $payment_gateway ) { # agent override
2445 $paybatch = $payment_gateway->gatewaynum. '-';
2448 $paybatch .= "$processor:". $transaction->authorization;
2450 $paybatch .= ':'. $transaction->order_number
2451 if $transaction->can('order_number')
2452 && length($transaction->order_number);
2454 my $cust_pay = new FS::cust_pay ( {
2455 'custnum' => $self->custnum,
2456 'invnum' => $options{'invnum'},
2459 'payby' => $method2payby{$method},
2460 'payinfo' => $payinfo,
2461 'paybatch' => $paybatch,
2463 my $error = $cust_pay->insert;
2465 $cust_pay->invnum(''); #try again with no specific invnum
2466 my $error2 = $cust_pay->insert;
2468 # gah, even with transactions.
2469 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2470 "error inserting payment ($processor): $error2".
2471 " (previously tried insert with invnum #$options{'invnum'}" .
2477 return ''; #no error
2481 my $perror = "$processor error: ". $transaction->error_message;
2483 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2484 && $conf->exists('emaildecline')
2485 && grep { $_ ne 'POST' } $self->invoicing_list
2486 && ! grep { $transaction->error_message =~ /$_/ }
2487 $conf->config('emaildecline-exclude')
2489 my @templ = $conf->config('declinetemplate');
2490 my $template = new Text::Template (
2492 SOURCE => [ map "$_\n", @templ ],
2493 ) or return "($perror) can't create template: $Text::Template::ERROR";
2494 $template->compile()
2495 or return "($perror) can't compile template: $Text::Template::ERROR";
2497 my $templ_hash = { error => $transaction->error_message };
2499 my $error = send_email(
2500 'from' => $conf->config('invoice_from'),
2501 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2502 'subject' => 'Your payment could not be processed',
2503 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2506 $perror .= " (also received error sending decline notification: $error)"
2516 =item default_payment_gateway
2520 sub default_payment_gateway {
2521 my( $self, $method ) = @_;
2523 die "Real-time processing not enabled\n"
2524 unless $conf->exists('business-onlinepayment');
2527 my $bop_config = 'business-onlinepayment';
2528 $bop_config .= '-ach'
2529 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2530 my ( $processor, $login, $password, $action, @bop_options ) =
2531 $conf->config($bop_config);
2532 $action ||= 'normal authorization';
2533 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2534 die "No real-time processor is enabled - ".
2535 "did you set the business-onlinepayment configuration value?\n"
2538 ( $processor, $login, $password, $action, @bop_options )
2543 Removes the I<paycvv> field from the database directly.
2545 If there is an error, returns the error, otherwise returns false.
2551 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2552 or return dbh->errstr;
2553 $sth->execute($self->custnum)
2554 or return $sth->errstr;
2559 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2561 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2562 via a Business::OnlinePayment realtime gateway. See
2563 L<http://420.am/business-onlinepayment> for supported gateways.
2565 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2567 Available options are: I<amount>, I<reason>, I<paynum>
2569 Most gateways require a reference to an original payment transaction to refund,
2570 so you probably need to specify a I<paynum>.
2572 I<amount> defaults to the original amount of the payment if not specified.
2574 I<reason> specifies a reason for the refund.
2576 Implementation note: If I<amount> is unspecified or equal to the amount of the
2577 orignal payment, first an attempt is made to "void" the transaction via
2578 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2579 the normal attempt is made to "refund" ("credit") the transaction via the
2580 gateway is attempted.
2582 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2583 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2584 #if set, will override the value from the customer record.
2586 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2587 #specified invoice. If you don't specify an I<invnum> you might want to
2588 #call the B<apply_payments> method.
2592 #some false laziness w/realtime_bop, not enough to make it worth merging
2593 #but some useful small subs should be pulled out
2594 sub realtime_refund_bop {
2595 my( $self, $method, %options ) = @_;
2597 warn "$self $method refund\n";
2598 warn " $_ => $options{$_}\n" foreach keys %options;
2601 eval "use Business::OnlinePayment";
2605 # look up the original payment and optionally a gateway for that payment
2609 my $amount = $options{'amount'};
2611 my( $processor, $login, $password, @bop_options ) ;
2612 my( $auth, $order_number ) = ( '', '', '' );
2614 if ( $options{'paynum'} ) {
2616 warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2617 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2618 or return "Unknown paynum $options{'paynum'}";
2619 $amount ||= $cust_pay->paid;
2621 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2622 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2623 $cust_pay->paybatch;
2624 my $gatewaynum = '';
2625 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2627 if ( $gatewaynum ) { #gateway for the payment to be refunded
2629 my $payment_gateway =
2630 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2631 die "payment gateway $gatewaynum not found"
2632 unless $payment_gateway;
2634 $processor = $payment_gateway->gateway_module;
2635 $login = $payment_gateway->gateway_username;
2636 $password = $payment_gateway->gateway_password;
2637 @bop_options = $payment_gateway->options;
2639 } else { #try the default gateway
2641 my( $conf_processor, $unused_action );
2642 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2643 $self->default_payment_gateway($method);
2645 return "processor of payment $options{'paynum'} $processor does not".
2646 " match default processor $conf_processor"
2647 unless $processor eq $conf_processor;
2652 } else { # didn't specify a paynum, so look for agent gateway overrides
2653 # like a normal transaction
2656 if ( $method eq 'CC' ) {
2657 $cardtype = cardtype($self->payinfo);
2658 } elsif ( $method eq 'ECHECK' ) {
2661 $cardtype = $method;
2664 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2665 cardtype => $cardtype,
2667 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2669 taxclass => '', } );
2671 if ( $override ) { #use a payment gateway override
2673 my $payment_gateway = $override->payment_gateway;
2675 $processor = $payment_gateway->gateway_module;
2676 $login = $payment_gateway->gateway_username;
2677 $password = $payment_gateway->gateway_password;
2678 #$action = $payment_gateway->gateway_action;
2679 @bop_options = $payment_gateway->options;
2681 } else { #use the standard settings from the config
2684 ( $processor, $login, $password, $unused_action, @bop_options ) =
2685 $self->default_payment_gateway($method);
2690 return "neither amount nor paynum specified" unless $amount;
2695 'password' => $password,
2696 'order_number' => $order_number,
2697 'amount' => $amount,
2698 'referer' => 'http://cleanwhisker.420.am/',
2700 $content{authorization} = $auth
2701 if length($auth); #echeck/ACH transactions have an order # but no auth
2702 #(at least with authorize.net)
2704 #first try void if applicable
2705 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2706 warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2707 my $void = new Business::OnlinePayment( $processor, @bop_options );
2708 $void->content( 'action' => 'void', %content );
2710 if ( $void->is_success ) {
2711 my $error = $cust_pay->void($options{'reason'});
2713 # gah, even with transactions.
2714 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2715 "error voiding payment: $error";
2719 warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2724 warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2728 my $address = $self->address1;
2729 $address .= ", ". $self->address2 if $self->address2;
2731 my($payname, $payfirst, $paylast);
2732 if ( $self->payname && $method ne 'ECHECK' ) {
2733 $payname = $self->payname;
2734 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2735 or return "Illegal payname $payname";
2736 ($payfirst, $paylast) = ($1, $2);
2738 $payfirst = $self->getfield('first');
2739 $paylast = $self->getfield('last');
2740 $payname = "$payfirst $paylast";
2744 if ( $method eq 'CC' ) {
2747 $content{card_number} = $payinfo = $cust_pay->payinfo;
2748 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2749 #$content{expiration} = "$2/$1";
2751 $content{card_number} = $payinfo = $self->payinfo;
2752 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2753 $content{expiration} = "$2/$1";
2756 } elsif ( $method eq 'ECHECK' ) {
2757 ( $content{account_number}, $content{routing_code} ) =
2758 split('@', $payinfo = $self->payinfo);
2759 $content{bank_name} = $self->payname;
2760 $content{account_type} = 'CHECKING';
2761 $content{account_name} = $payname;
2762 $content{customer_org} = $self->company ? 'B' : 'I';
2763 $content{customer_ssn} = $self->ss;
2764 } elsif ( $method eq 'LEC' ) {
2765 $content{phone} = $payinfo = $self->payinfo;
2769 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2770 my %sub_content = $refund->content(
2771 'action' => 'credit',
2772 'customer_id' => $self->custnum,
2773 'last_name' => $paylast,
2774 'first_name' => $payfirst,
2776 'address' => $address,
2777 'city' => $self->city,
2778 'state' => $self->state,
2779 'zip' => $self->zip,
2780 'country' => $self->country,
2783 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2787 return "$processor error: ". $refund->error_message
2788 unless $refund->is_success();
2790 my %method2payby = (
2796 my $paybatch = "$processor:". $refund->authorization;
2797 $paybatch .= ':'. $refund->order_number
2798 if $refund->can('order_number') && $refund->order_number;
2800 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2801 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2802 last unless @cust_bill_pay;
2803 my $cust_bill_pay = pop @cust_bill_pay;
2804 my $error = $cust_bill_pay->delete;
2808 my $cust_refund = new FS::cust_refund ( {
2809 'custnum' => $self->custnum,
2810 'paynum' => $options{'paynum'},
2811 'refund' => $amount,
2813 'payby' => $method2payby{$method},
2814 'payinfo' => $payinfo,
2815 'paybatch' => $paybatch,
2816 'reason' => $options{'reason'} || 'card or ACH refund',
2818 my $error = $cust_refund->insert;
2820 $cust_refund->paynum(''); #try again with no specific paynum
2821 my $error2 = $cust_refund->insert;
2823 # gah, even with transactions.
2824 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2825 "error inserting refund ($processor): $error2".
2826 " (previously tried insert with paynum #$options{'paynum'}" .
2839 Returns the total owed for this customer on all invoices
2840 (see L<FS::cust_bill/owed>).
2846 $self->total_owed_date(2145859200); #12/31/2037
2849 =item total_owed_date TIME
2851 Returns the total owed for this customer on all invoices with date earlier than
2852 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2853 see L<Time::Local> and L<Date::Parse> for conversion functions.
2857 sub total_owed_date {
2861 foreach my $cust_bill (
2862 grep { $_->_date <= $time }
2863 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2865 $total_bill += $cust_bill->owed;
2867 sprintf( "%.2f", $total_bill );
2870 =item apply_credits OPTION => VALUE ...
2872 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2873 to outstanding invoice balances in chronological order (or reverse
2874 chronological order if the I<order> option is set to B<newest>) and returns the
2875 value of any remaining unapplied credits available for refund (see
2876 L<FS::cust_refund>).
2884 return 0 unless $self->total_credited;
2886 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2887 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2889 my @invoices = $self->open_cust_bill;
2890 @invoices = sort { $b->_date <=> $a->_date } @invoices
2891 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2894 foreach my $cust_bill ( @invoices ) {
2897 if ( !defined($credit) || $credit->credited == 0) {
2898 $credit = pop @credits or last;
2901 if ($cust_bill->owed >= $credit->credited) {
2902 $amount=$credit->credited;
2904 $amount=$cust_bill->owed;
2907 my $cust_credit_bill = new FS::cust_credit_bill ( {
2908 'crednum' => $credit->crednum,
2909 'invnum' => $cust_bill->invnum,
2910 'amount' => $amount,
2912 my $error = $cust_credit_bill->insert;
2913 die $error if $error;
2915 redo if ($cust_bill->owed > 0);
2919 return $self->total_credited;
2922 =item apply_payments
2924 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2925 to outstanding invoice balances in chronological order.
2927 #and returns the value of any remaining unapplied payments.
2931 sub apply_payments {
2936 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2937 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2939 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2940 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2944 foreach my $cust_bill ( @invoices ) {
2947 if ( !defined($payment) || $payment->unapplied == 0 ) {
2948 $payment = pop @payments or last;
2951 if ( $cust_bill->owed >= $payment->unapplied ) {
2952 $amount = $payment->unapplied;
2954 $amount = $cust_bill->owed;
2957 my $cust_bill_pay = new FS::cust_bill_pay ( {
2958 'paynum' => $payment->paynum,
2959 'invnum' => $cust_bill->invnum,
2960 'amount' => $amount,
2962 my $error = $cust_bill_pay->insert;
2963 die $error if $error;
2965 redo if ( $cust_bill->owed > 0);
2969 return $self->total_unapplied_payments;
2972 =item total_credited
2974 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2975 customer. See L<FS::cust_credit/credited>.
2979 sub total_credited {
2981 my $total_credit = 0;
2982 foreach my $cust_credit ( qsearch('cust_credit', {
2983 'custnum' => $self->custnum,
2985 $total_credit += $cust_credit->credited;
2987 sprintf( "%.2f", $total_credit );
2990 =item total_unapplied_payments
2992 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2993 See L<FS::cust_pay/unapplied>.
2997 sub total_unapplied_payments {
2999 my $total_unapplied = 0;
3000 foreach my $cust_pay ( qsearch('cust_pay', {
3001 'custnum' => $self->custnum,
3003 $total_unapplied += $cust_pay->unapplied;
3005 sprintf( "%.2f", $total_unapplied );
3010 Returns the balance for this customer (total_owed minus total_credited
3011 minus total_unapplied_payments).
3018 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3022 =item balance_date TIME
3024 Returns the balance for this customer, only considering invoices with date
3025 earlier than TIME (total_owed_date minus total_credited minus
3026 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3027 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3036 $self->total_owed_date($time)
3037 - $self->total_credited
3038 - $self->total_unapplied_payments
3042 =item paydate_monthyear
3044 Returns a two-element list consisting of the month and year of this customer's
3045 paydate (credit card expiration date for CARD customers)
3049 sub paydate_monthyear {
3051 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3053 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3060 =item payinfo_masked
3062 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.
3064 Credit Cards - Mask all but the last four characters.
3065 Checks - Mask all but last 2 of account number and bank routing number.
3066 Others - Do nothing, return the unmasked string.
3070 sub payinfo_masked {
3072 return $self->paymask;
3075 =item invoicing_list [ ARRAYREF ]
3077 If an arguement is given, sets these email addresses as invoice recipients
3078 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3079 (except as warnings), so use check_invoicing_list first.
3081 Returns a list of email addresses (with svcnum entries expanded).
3083 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3084 check it without disturbing anything by passing nothing.
3086 This interface may change in the future.
3090 sub invoicing_list {
3091 my( $self, $arrayref ) = @_;
3093 my @cust_main_invoice;
3094 if ( $self->custnum ) {
3095 @cust_main_invoice =
3096 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3098 @cust_main_invoice = ();
3100 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3101 #warn $cust_main_invoice->destnum;
3102 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3103 #warn $cust_main_invoice->destnum;
3104 my $error = $cust_main_invoice->delete;
3105 warn $error if $error;
3108 if ( $self->custnum ) {
3109 @cust_main_invoice =
3110 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3112 @cust_main_invoice = ();
3114 my %seen = map { $_->address => 1 } @cust_main_invoice;
3115 foreach my $address ( @{$arrayref} ) {
3116 next if exists $seen{$address} && $seen{$address};
3117 $seen{$address} = 1;
3118 my $cust_main_invoice = new FS::cust_main_invoice ( {
3119 'custnum' => $self->custnum,
3122 my $error = $cust_main_invoice->insert;
3123 warn $error if $error;
3126 if ( $self->custnum ) {
3128 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3134 =item check_invoicing_list ARRAYREF
3136 Checks these arguements as valid input for the invoicing_list method. If there
3137 is an error, returns the error, otherwise returns false.
3141 sub check_invoicing_list {
3142 my( $self, $arrayref ) = @_;
3143 foreach my $address ( @{$arrayref} ) {
3145 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3146 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3149 my $cust_main_invoice = new FS::cust_main_invoice ( {
3150 'custnum' => $self->custnum,
3153 my $error = $self->custnum
3154 ? $cust_main_invoice->check
3155 : $cust_main_invoice->checkdest
3157 return $error if $error;
3162 =item set_default_invoicing_list
3164 Sets the invoicing list to all accounts associated with this customer,
3165 overwriting any previous invoicing list.
3169 sub set_default_invoicing_list {
3171 $self->invoicing_list($self->all_emails);
3176 Returns the email addresses of all accounts provisioned for this customer.
3183 foreach my $cust_pkg ( $self->all_pkgs ) {
3184 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3186 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3187 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3189 $list{$_}=1 foreach map { $_->email } @svc_acct;
3194 =item invoicing_list_addpost
3196 Adds postal invoicing to this customer. If this customer is already configured
3197 to receive postal invoices, does nothing.
3201 sub invoicing_list_addpost {
3203 return if grep { $_ eq 'POST' } $self->invoicing_list;
3204 my @invoicing_list = $self->invoicing_list;
3205 push @invoicing_list, 'POST';
3206 $self->invoicing_list(\@invoicing_list);
3209 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3211 Returns an array of customers referred by this customer (referral_custnum set
3212 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3213 customers referred by customers referred by this customer and so on, inclusive.
3214 The default behavior is DEPTH 1 (no recursion).
3218 sub referral_cust_main {
3220 my $depth = @_ ? shift : 1;
3221 my $exclude = @_ ? shift : {};
3224 map { $exclude->{$_->custnum}++; $_; }
3225 grep { ! $exclude->{ $_->custnum } }
3226 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3230 map { $_->referral_cust_main($depth-1, $exclude) }
3237 =item referral_cust_main_ncancelled
3239 Same as referral_cust_main, except only returns customers with uncancelled
3244 sub referral_cust_main_ncancelled {
3246 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3249 =item referral_cust_pkg [ DEPTH ]
3251 Like referral_cust_main, except returns a flat list of all unsuspended (and
3252 uncancelled) packages for each customer. The number of items in this list may
3253 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3257 sub referral_cust_pkg {
3259 my $depth = @_ ? shift : 1;
3261 map { $_->unsuspended_pkgs }
3262 grep { $_->unsuspended_pkgs }
3263 $self->referral_cust_main($depth);
3266 =item referring_cust_main
3268 Returns the single cust_main record for the customer who referred this customer
3269 (referral_custnum), or false.
3273 sub referring_cust_main {
3275 return '' unless $self->referral_custnum;
3276 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3279 =item credit AMOUNT, REASON
3281 Applies a credit to this customer. If there is an error, returns the error,
3282 otherwise returns false.
3287 my( $self, $amount, $reason ) = @_;
3288 my $cust_credit = new FS::cust_credit {
3289 'custnum' => $self->custnum,
3290 'amount' => $amount,
3291 'reason' => $reason,
3293 $cust_credit->insert;
3296 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3298 Creates a one-time charge for this customer. If there is an error, returns
3299 the error, otherwise returns false.
3304 my ( $self, $amount ) = ( shift, shift );
3305 my $pkg = @_ ? shift : 'One-time charge';
3306 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3307 my $taxclass = @_ ? shift : '';
3309 local $SIG{HUP} = 'IGNORE';
3310 local $SIG{INT} = 'IGNORE';
3311 local $SIG{QUIT} = 'IGNORE';
3312 local $SIG{TERM} = 'IGNORE';
3313 local $SIG{TSTP} = 'IGNORE';
3314 local $SIG{PIPE} = 'IGNORE';
3316 my $oldAutoCommit = $FS::UID::AutoCommit;
3317 local $FS::UID::AutoCommit = 0;
3320 my $part_pkg = new FS::part_pkg ( {
3322 'comment' => $comment,
3323 #'setup' => $amount,
3326 'plandata' => "setup_fee=$amount",
3329 'taxclass' => $taxclass,
3332 my $error = $part_pkg->insert;
3334 $dbh->rollback if $oldAutoCommit;
3338 my $pkgpart = $part_pkg->pkgpart;
3339 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3340 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3341 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3342 $error = $type_pkgs->insert;
3344 $dbh->rollback if $oldAutoCommit;
3349 my $cust_pkg = new FS::cust_pkg ( {
3350 'custnum' => $self->custnum,
3351 'pkgpart' => $pkgpart,
3354 $error = $cust_pkg->insert;
3356 $dbh->rollback if $oldAutoCommit;
3360 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3367 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3373 sort { $a->_date <=> $b->_date }
3374 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3377 =item open_cust_bill
3379 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3384 sub open_cust_bill {
3386 grep { $_->owed > 0 } $self->cust_bill;
3391 Returns all the credits (see L<FS::cust_credit>) for this customer.
3397 sort { $a->_date <=> $b->_date }
3398 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3403 Returns all the payments (see L<FS::cust_pay>) for this customer.
3409 sort { $a->_date <=> $b->_date }
3410 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3415 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3421 sort { $a->_date <=> $b->_date }
3422 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3428 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3434 sort { $a->_date <=> $b->_date }
3435 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3438 =item select_for_update
3440 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3445 sub select_for_update {
3447 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3452 Returns a name string for this customer, either "Company (Last, First)" or
3459 my $name = $self->contact;
3460 $name = $self->company. " ($name)" if $self->company;
3466 Returns a name string for this (service/shipping) contact, either
3467 "Company (Last, First)" or "Last, First".
3473 if ( $self->get('ship_last') ) {
3474 my $name = $self->ship_contact;
3475 $name = $self->ship_company. " ($name)" if $self->ship_company;
3484 Returns this customer's full (billing) contact name only, "Last, First"
3490 $self->get('last'). ', '. $self->first;
3495 Returns this customer's full (shipping) contact name only, "Last, First"
3501 $self->get('ship_last')
3502 ? $self->get('ship_last'). ', '. $self->ship_first
3508 Returns a status string for this customer, currently:
3512 =item prospect - No packages have ever been ordered
3514 =item active - One or more recurring packages is active
3516 =item suspended - All non-cancelled recurring packages are suspended
3518 =item cancelled - All recurring packages are cancelled
3526 for my $status (qw( prospect active suspended cancelled )) {
3527 my $method = $status.'_sql';
3528 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3529 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3530 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3531 return $status if $sth->fetchrow_arrayref->[0];
3537 Returns a hex triplet color string for this customer's status.
3542 'prospect' => '000000',
3543 'active' => '00CC00',
3544 'suspended' => 'FF9900',
3545 'cancelled' => 'FF0000',
3549 $statuscolor{$self->status};
3554 =head1 CLASS METHODS
3560 Returns an SQL expression identifying prospective cust_main records (customers
3561 with no packages ever ordered)
3565 sub prospect_sql { "
3566 0 = ( SELECT COUNT(*) FROM cust_pkg
3567 WHERE cust_pkg.custnum = cust_main.custnum
3573 Returns an SQL expression identifying active cust_main records.
3578 0 < ( SELECT COUNT(*) FROM cust_pkg
3579 WHERE cust_pkg.custnum = cust_main.custnum
3580 AND ". FS::cust_pkg->active_sql. "
3587 Returns an SQL expression identifying suspended cust_main records.
3591 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3592 my $recurring_sql = "
3593 '0' != ( select freq from part_pkg
3594 where cust_pkg.pkgpart = part_pkg.pkgpart )
3597 sub suspended_sql { susp_sql(@_); }
3599 0 < ( SELECT COUNT(*) FROM cust_pkg
3600 WHERE cust_pkg.custnum = cust_main.custnum
3602 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3604 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3605 WHERE cust_pkg.custnum = cust_main.custnum
3606 AND ". FS::cust_pkg->active_sql. "
3613 Returns an SQL expression identifying cancelled cust_main records.
3617 sub cancelled_sql { cancel_sql(@_); }
3619 0 < ( SELECT COUNT(*) FROM cust_pkg
3620 WHERE cust_pkg.custnum = cust_main.custnum
3622 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3623 WHERE cust_pkg.custnum = cust_main.custnum
3625 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3629 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3631 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3632 records. Currently, only I<last> or I<company> may be specified (the
3633 appropriate ship_ field is also searched if applicable).
3635 Additional options are the same as FS::Record::qsearch
3640 my( $self, $fuzzy, $hash, @opt) = @_;
3645 check_and_rebuild_fuzzyfiles();
3646 foreach my $field ( keys %$fuzzy ) {
3647 my $sub = \&{"all_$field"};
3649 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3651 foreach ( keys %match ) {
3652 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3653 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3654 if defined dbdef->table('cust_main')->column('ship_last');
3659 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3671 =item smart_search OPTION => VALUE ...
3673 Accepts the following options: I<search>, the string to search for. The string
3674 will be searched for as a customer number, last name or company name, first
3675 searching for an exact match then fuzzy and substring matches.
3677 Any additional options treated as an additional qualifier on the search
3680 Returns a (possibly empty) array of FS::cust_main objects.
3686 my $search = delete $options{'search'};
3689 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3691 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3693 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3696 my $q_value = dbh->quote($value);
3699 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3700 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3701 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3702 if defined dbdef->table('cust_main')->column('ship_last');
3705 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3707 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3709 #still some false laziness w/ search/cust_main.cgi
3712 push @cust_main, qsearch( 'cust_main',
3713 { 'last' => { 'op' => 'ILIKE',
3714 'value' => "%$q_value%" },
3718 push @cust_main, qsearch( 'cust_main',
3719 { 'ship_last' => { 'op' => 'ILIKE',
3720 'value' => "%$q_value%" },
3725 if defined dbdef->table('cust_main')->column('ship_last');
3727 push @cust_main, qsearch( 'cust_main',
3728 { 'company' => { 'op' => 'ILIKE',
3729 'value' => "%$q_value%" },
3733 push @cust_main, qsearch( 'cust_main',
3734 { 'ship_company' => { 'op' => 'ILIKE',
3735 'value' => "%$q_value%" },
3739 if defined dbdef->table('cust_main')->column('ship_last');
3742 push @cust_main, FS::cust_main->fuzzy_search(
3743 { 'last' => $value },
3746 push @cust_main, FS::cust_main->fuzzy_search(
3747 { 'company' => $value },
3759 =item check_and_rebuild_fuzzyfiles
3763 sub check_and_rebuild_fuzzyfiles {
3764 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3765 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3766 or &rebuild_fuzzyfiles;
3769 =item rebuild_fuzzyfiles
3773 sub rebuild_fuzzyfiles {
3775 use Fcntl qw(:flock);
3777 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3781 open(LASTLOCK,">>$dir/cust_main.last")
3782 or die "can't open $dir/cust_main.last: $!";
3783 flock(LASTLOCK,LOCK_EX)
3784 or die "can't lock $dir/cust_main.last: $!";
3786 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3788 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3789 if defined dbdef->table('cust_main')->column('ship_last');
3791 open (LASTCACHE,">$dir/cust_main.last.tmp")
3792 or die "can't open $dir/cust_main.last.tmp: $!";
3793 print LASTCACHE join("\n", @all_last), "\n";
3794 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3796 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3801 open(COMPANYLOCK,">>$dir/cust_main.company")
3802 or die "can't open $dir/cust_main.company: $!";
3803 flock(COMPANYLOCK,LOCK_EX)
3804 or die "can't lock $dir/cust_main.company: $!";
3806 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3808 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3809 if defined dbdef->table('cust_main')->column('ship_last');
3811 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3812 or die "can't open $dir/cust_main.company.tmp: $!";
3813 print COMPANYCACHE join("\n", @all_company), "\n";
3814 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3816 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3826 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3827 open(LASTCACHE,"<$dir/cust_main.last")
3828 or die "can't open $dir/cust_main.last: $!";
3829 my @array = map { chomp; $_; } <LASTCACHE>;
3839 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3840 open(COMPANYCACHE,"<$dir/cust_main.company")
3841 or die "can't open $dir/cust_main.last: $!";
3842 my @array = map { chomp; $_; } <COMPANYCACHE>;
3847 =item append_fuzzyfiles LASTNAME COMPANY
3851 sub append_fuzzyfiles {
3852 my( $last, $company ) = @_;
3854 &check_and_rebuild_fuzzyfiles;
3856 use Fcntl qw(:flock);
3858 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3862 open(LAST,">>$dir/cust_main.last")
3863 or die "can't open $dir/cust_main.last: $!";
3865 or die "can't lock $dir/cust_main.last: $!";
3867 print LAST "$last\n";
3870 or die "can't unlock $dir/cust_main.last: $!";
3876 open(COMPANY,">>$dir/cust_main.company")
3877 or die "can't open $dir/cust_main.company: $!";
3878 flock(COMPANY,LOCK_EX)
3879 or die "can't lock $dir/cust_main.company: $!";
3881 print COMPANY "$company\n";
3883 flock(COMPANY,LOCK_UN)
3884 or die "can't unlock $dir/cust_main.company: $!";
3898 #warn join('-',keys %$param);
3899 my $fh = $param->{filehandle};
3900 my $agentnum = $param->{agentnum};
3901 my $refnum = $param->{refnum};
3902 my $pkgpart = $param->{pkgpart};
3903 my @fields = @{$param->{fields}};
3905 eval "use Date::Parse;";
3907 eval "use Text::CSV_XS;";
3910 my $csv = new Text::CSV_XS;
3917 local $SIG{HUP} = 'IGNORE';
3918 local $SIG{INT} = 'IGNORE';
3919 local $SIG{QUIT} = 'IGNORE';
3920 local $SIG{TERM} = 'IGNORE';
3921 local $SIG{TSTP} = 'IGNORE';
3922 local $SIG{PIPE} = 'IGNORE';
3924 my $oldAutoCommit = $FS::UID::AutoCommit;
3925 local $FS::UID::AutoCommit = 0;
3928 #while ( $columns = $csv->getline($fh) ) {
3930 while ( defined($line=<$fh>) ) {
3932 $csv->parse($line) or do {
3933 $dbh->rollback if $oldAutoCommit;
3934 return "can't parse: ". $csv->error_input();
3937 my @columns = $csv->fields();
3938 #warn join('-',@columns);
3941 agentnum => $agentnum,
3943 country => $conf->config('countrydefault') || 'US',
3944 payby => 'BILL', #default
3945 paydate => '12/2037', #default
3947 my $billtime = time;
3948 my %cust_pkg = ( pkgpart => $pkgpart );
3949 foreach my $field ( @fields ) {
3950 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3951 #$cust_pkg{$1} = str2time( shift @$columns );
3952 if ( $1 eq 'setup' ) {
3953 $billtime = str2time(shift @columns);
3955 $cust_pkg{$1} = str2time( shift @columns );
3958 #$cust_main{$field} = shift @$columns;
3959 $cust_main{$field} = shift @columns;
3963 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3964 my $cust_main = new FS::cust_main ( \%cust_main );
3966 tie my %hash, 'Tie::RefHash'; #this part is important
3967 $hash{$cust_pkg} = [] if $pkgpart;
3968 my $error = $cust_main->insert( \%hash );
3971 $dbh->rollback if $oldAutoCommit;
3972 return "can't insert customer for $line: $error";
3975 #false laziness w/bill.cgi
3976 $error = $cust_main->bill( 'time' => $billtime );
3978 $dbh->rollback if $oldAutoCommit;
3979 return "can't bill customer for $line: $error";
3982 $cust_main->apply_payments;
3983 $cust_main->apply_credits;
3985 $error = $cust_main->collect();
3987 $dbh->rollback if $oldAutoCommit;
3988 return "can't collect customer for $line: $error";
3994 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3996 return "Empty file!" unless $imported;
4008 #warn join('-',keys %$param);
4009 my $fh = $param->{filehandle};
4010 my @fields = @{$param->{fields}};
4012 eval "use Date::Parse;";
4014 eval "use Text::CSV_XS;";
4017 my $csv = new Text::CSV_XS;
4024 local $SIG{HUP} = 'IGNORE';
4025 local $SIG{INT} = 'IGNORE';
4026 local $SIG{QUIT} = 'IGNORE';
4027 local $SIG{TERM} = 'IGNORE';
4028 local $SIG{TSTP} = 'IGNORE';
4029 local $SIG{PIPE} = 'IGNORE';
4031 my $oldAutoCommit = $FS::UID::AutoCommit;
4032 local $FS::UID::AutoCommit = 0;
4035 #while ( $columns = $csv->getline($fh) ) {
4037 while ( defined($line=<$fh>) ) {
4039 $csv->parse($line) or do {
4040 $dbh->rollback if $oldAutoCommit;
4041 return "can't parse: ". $csv->error_input();
4044 my @columns = $csv->fields();
4045 #warn join('-',@columns);
4048 foreach my $field ( @fields ) {
4049 $row{$field} = shift @columns;
4052 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4053 unless ( $cust_main ) {
4054 $dbh->rollback if $oldAutoCommit;
4055 return "unknown custnum $row{'custnum'}";
4058 if ( $row{'amount'} > 0 ) {
4059 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4061 $dbh->rollback if $oldAutoCommit;
4065 } elsif ( $row{'amount'} < 0 ) {
4066 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4069 $dbh->rollback if $oldAutoCommit;
4079 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4081 return "Empty file!" unless $imported;
4093 The delete method should possibly take an FS::cust_main object reference
4094 instead of a scalar customer number.
4096 Bill and collect options should probably be passed as references instead of a
4099 There should probably be a configuration file with a list of allowed credit
4102 No multiple currency support (probably a larger project than just this module).
4104 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4108 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4109 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4110 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.