4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
5 $import $skip_fuzzyfiles $ignore_expired_card );
6 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 eval "use Time::Local;";
12 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
13 if $] < 5.006 && !defined($Time::Local::VERSION);
14 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 eval "use Time::Local qw(timelocal_nocheck);";
17 use Digest::MD5 qw(md5_base64);
21 use String::Approx qw(amatch);
22 use Business::CreditCard 0.28;
23 use FS::UID qw( getotaker dbh );
24 use FS::Record qw( qsearchs qsearch dbdef );
25 use FS::Misc qw( send_email );
26 use FS::Msgcat qw(gettext);
30 use FS::cust_bill_pkg;
32 use FS::cust_pay_void;
35 use FS::part_referral;
36 use FS::cust_main_county;
38 use FS::cust_main_invoice;
39 use FS::cust_credit_bill;
40 use FS::cust_bill_pay;
41 use FS::prepay_credit;
44 use FS::part_bill_event;
45 use FS::cust_bill_event;
46 use FS::cust_tax_exempt;
47 use FS::cust_tax_exempt_pkg;
49 use FS::payment_gateway;
50 use FS::agent_payment_gateway;
53 @ISA = qw( FS::Record );
55 @EXPORT_OK = qw( smart_search );
57 $realtime_bop_decline_quiet = 0;
59 # 1 is mostly method/subroutine entry and options
60 # 2 traces progress of some operations
61 # 3 is even more information including possibly sensitive data
63 $me = '[FS::cust_main]';
67 $ignore_expired_card = 0;
69 @encrypted_fields = ('payinfo', 'paycvv');
71 #ask FS::UID to run this stuff for us later
72 #$FS::UID::callback{'FS::cust_main'} = sub {
73 install_callback FS::UID sub {
75 #yes, need it for stuff below (prolly should be cached)
80 my ( $hashref, $cache ) = @_;
81 if ( exists $hashref->{'pkgnum'} ) {
82 # #@{ $self->{'_pkgnum'} } = ();
83 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
84 $self->{'_pkgnum'} = $subcache;
85 #push @{ $self->{'_pkgnum'} },
86 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
92 FS::cust_main - Object methods for cust_main records
98 $record = new FS::cust_main \%hash;
99 $record = new FS::cust_main { 'column' => 'value' };
101 $error = $record->insert;
103 $error = $new_record->replace($old_record);
105 $error = $record->delete;
107 $error = $record->check;
109 @cust_pkg = $record->all_pkgs;
111 @cust_pkg = $record->ncancelled_pkgs;
113 @cust_pkg = $record->suspended_pkgs;
115 $error = $record->bill;
116 $error = $record->bill %options;
117 $error = $record->bill 'time' => $time;
119 $error = $record->collect;
120 $error = $record->collect %options;
121 $error = $record->collect 'invoice_time' => $time,
126 An FS::cust_main object represents a customer. FS::cust_main inherits from
127 FS::Record. The following fields are currently supported:
131 =item custnum - primary key (assigned automatically for new customers)
133 =item agentnum - agent (see L<FS::agent>)
135 =item refnum - Advertising source (see L<FS::part_referral>)
141 =item ss - social security number (optional)
143 =item company - (optional)
147 =item address2 - (optional)
151 =item county - (optional, see L<FS::cust_main_county>)
153 =item state - (see L<FS::cust_main_county>)
157 =item country - (see L<FS::cust_main_county>)
159 =item daytime - phone (optional)
161 =item night - phone (optional)
163 =item fax - phone (optional)
165 =item ship_first - name
167 =item ship_last - name
169 =item ship_company - (optional)
173 =item ship_address2 - (optional)
177 =item ship_county - (optional, see L<FS::cust_main_county>)
179 =item ship_state - (see L<FS::cust_main_county>)
183 =item ship_country - (see L<FS::cust_main_county>)
185 =item ship_daytime - phone (optional)
187 =item ship_night - phone (optional)
189 =item ship_fax - phone (optional)
193 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>)
197 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
202 my($self,$payinfo) = @_;
203 if ( defined($payinfo) ) {
204 $self->paymask($payinfo);
205 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
207 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
215 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
219 =item paymask - Masked payment type
225 Mask all but the last four characters.
229 Mask all but last 2 of account number and bank routing number.
233 Do nothing, return the unmasked string.
242 # If it doesn't exist then generate it
243 my $paymask=$self->getfield('paymask');
244 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
245 $value = $self->payinfo;
248 if ( defined($value) && !$self->is_encrypted($value)) {
249 my $payinfo = $value;
250 my $payby = $self->payby;
251 if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
252 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
253 } elsif ($payby eq 'CHEK' ||
254 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
255 my( $account, $aba ) = split('@', $payinfo );
256 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
257 } else { # Tie up loose ends
260 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
261 } elsif (defined($value) && $self->is_encrypted($value)) {
267 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
269 =item paystart_month - start date month (maestro/solo cards only)
271 =item paystart_year - start date year (maestro/solo cards only)
273 =item payissue - issue number (maestro/solo cards only)
275 =item payname - name on card or billing name
277 =item payip - IP address from which payment information was received
279 =item tax - tax exempt, empty or `Y'
281 =item otaker - order taker (assigned automatically, see L<FS::UID>)
283 =item comments - comments (optional)
285 =item referral_custnum - referring customer number
287 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
297 Creates a new customer. To add the customer to the database, see L<"insert">.
299 Note that this stores the hash reference, not a distinct copy of the hash it
300 points to. You can ask the object for a copy with the I<hash> method.
304 sub table { 'cust_main'; }
306 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
308 Adds this customer to the database. If there is an error, returns the error,
309 otherwise returns false.
311 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
312 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
313 are inserted atomicly, or the transaction is rolled back. Passing an empty
314 hash reference is equivalent to not supplying this parameter. There should be
315 a better explanation of this, but until then, here's an example:
318 tie %hash, 'Tie::RefHash'; #this part is important
320 $cust_pkg => [ $svc_acct ],
323 $cust_main->insert( \%hash );
325 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
326 be set as the invoicing list (see L<"invoicing_list">). Errors return as
327 expected and rollback the entire transaction; it is not necessary to call
328 check_invoicing_list first. The invoicing_list is set after the records in the
329 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
330 invoicing_list destination to the newly-created svc_acct. Here's an example:
332 $cust_main->insert( {}, [ $email, 'POST' ] );
334 Currently available options are: I<depend_jobnum> and I<noexport>.
336 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
337 on the supplied jobnum (they will not run until the specific job completes).
338 This can be used to defer provisioning until some action completes (such
339 as running the customer's credit card successfully).
341 The I<noexport> option is deprecated. If I<noexport> is set true, no
342 provisioning jobs (exports) are scheduled. (You can schedule them later with
343 the B<reexport> method.)
349 my $cust_pkgs = @_ ? shift : {};
350 my $invoicing_list = @_ ? shift : '';
352 warn "$me insert called with options ".
353 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
356 local $SIG{HUP} = 'IGNORE';
357 local $SIG{INT} = 'IGNORE';
358 local $SIG{QUIT} = 'IGNORE';
359 local $SIG{TERM} = 'IGNORE';
360 local $SIG{TSTP} = 'IGNORE';
361 local $SIG{PIPE} = 'IGNORE';
363 my $oldAutoCommit = $FS::UID::AutoCommit;
364 local $FS::UID::AutoCommit = 0;
367 my $prepay_identifier = '';
368 my( $amount, $seconds ) = ( 0, 0 );
370 if ( $self->payby eq 'PREPAY' ) {
372 $self->payby('BILL');
373 $prepay_identifier = $self->payinfo;
376 warn " looking up prepaid card $prepay_identifier\n"
379 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
381 $dbh->rollback if $oldAutoCommit;
382 #return "error applying prepaid card (transaction rolled back): $error";
386 $payby = 'PREP' if $amount;
388 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
391 $self->payby('BILL');
392 $amount = $self->paid;
396 warn " inserting $self\n"
399 my $error = $self->SUPER::insert;
401 $dbh->rollback if $oldAutoCommit;
402 #return "inserting cust_main record (transaction rolled back): $error";
406 warn " setting invoicing list\n"
409 if ( $invoicing_list ) {
410 $error = $self->check_invoicing_list( $invoicing_list );
412 $dbh->rollback if $oldAutoCommit;
413 return "checking invoicing_list (transaction rolled back): $error";
415 $self->invoicing_list( $invoicing_list );
418 warn " ordering packages\n"
421 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
423 $dbh->rollback if $oldAutoCommit;
428 $dbh->rollback if $oldAutoCommit;
429 return "No svc_acct record to apply pre-paid time";
433 warn " inserting initial $payby payment of $amount\n"
435 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
437 $dbh->rollback if $oldAutoCommit;
438 return "inserting payment (transaction rolled back): $error";
442 unless ( $import || $skip_fuzzyfiles ) {
443 warn " queueing fuzzyfiles update\n"
445 $error = $self->queue_fuzzyfiles_update;
447 $dbh->rollback if $oldAutoCommit;
448 return "updating fuzzy search cache: $error";
452 warn " insert complete; committing transaction\n"
455 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
460 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
462 Like the insert method on an existing record, this method orders a package
463 and included services atomicaly. Pass a Tie::RefHash data structure to this
464 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
465 be a better explanation of this, but until then, here's an example:
468 tie %hash, 'Tie::RefHash'; #this part is important
470 $cust_pkg => [ $svc_acct ],
473 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
475 Services can be new, in which case they are inserted, or existing unaudited
476 services, in which case they are linked to the newly-created package.
478 Currently available options are: I<depend_jobnum> and I<noexport>.
480 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
481 on the supplied jobnum (they will not run until the specific job completes).
482 This can be used to defer provisioning until some action completes (such
483 as running the customer's credit card successfully).
485 The I<noexport> option is deprecated. If I<noexport> is set true, no
486 provisioning jobs (exports) are scheduled. (You can schedule them later with
487 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
488 on the cust_main object is not recommended, as existing services will also be
495 my $cust_pkgs = shift;
498 my %svc_options = ();
499 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
500 if exists $options{'depend_jobnum'};
501 warn "$me order_pkgs called with options ".
502 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
505 local $SIG{HUP} = 'IGNORE';
506 local $SIG{INT} = 'IGNORE';
507 local $SIG{QUIT} = 'IGNORE';
508 local $SIG{TERM} = 'IGNORE';
509 local $SIG{TSTP} = 'IGNORE';
510 local $SIG{PIPE} = 'IGNORE';
512 my $oldAutoCommit = $FS::UID::AutoCommit;
513 local $FS::UID::AutoCommit = 0;
516 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
518 foreach my $cust_pkg ( keys %$cust_pkgs ) {
519 $cust_pkg->custnum( $self->custnum );
520 my $error = $cust_pkg->insert;
522 $dbh->rollback if $oldAutoCommit;
523 return "inserting cust_pkg (transaction rolled back): $error";
525 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
526 if ( $svc_something->svcnum ) {
527 my $old_cust_svc = $svc_something->cust_svc;
528 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
529 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
530 $error = $new_cust_svc->replace($old_cust_svc);
532 $svc_something->pkgnum( $cust_pkg->pkgnum );
533 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
534 $svc_something->seconds( $svc_something->seconds + $$seconds );
537 $error = $svc_something->insert(%svc_options);
540 $dbh->rollback if $oldAutoCommit;
541 #return "inserting svc_ (transaction rolled back): $error";
547 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
551 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
553 Recharges this (existing) customer with the specified prepaid card (see
554 L<FS::prepay_credit>), specified either by I<identifier> or as an
555 FS::prepay_credit object. If there is an error, returns the error, otherwise
558 Optionally, two scalar references can be passed as well. They will have their
559 values filled in with the amount and number of seconds applied by this prepaid
564 sub recharge_prepay {
565 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
567 local $SIG{HUP} = 'IGNORE';
568 local $SIG{INT} = 'IGNORE';
569 local $SIG{QUIT} = 'IGNORE';
570 local $SIG{TERM} = 'IGNORE';
571 local $SIG{TSTP} = 'IGNORE';
572 local $SIG{PIPE} = 'IGNORE';
574 my $oldAutoCommit = $FS::UID::AutoCommit;
575 local $FS::UID::AutoCommit = 0;
578 my( $amount, $seconds ) = ( 0, 0 );
580 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
581 || $self->increment_seconds($seconds)
582 || $self->insert_cust_pay_prepay( $amount,
584 ? $prepay_credit->identifier
589 $dbh->rollback if $oldAutoCommit;
593 if ( defined($amountref) ) { $$amountref = $amount; }
594 if ( defined($secondsref) ) { $$secondsref = $seconds; }
596 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
601 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
603 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
604 specified either by I<identifier> or as an FS::prepay_credit object.
606 References to I<amount> and I<seconds> scalars should be passed as arguments
607 and will be incremented by the values of the prepaid card.
609 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
610 check or set this customer's I<agentnum>.
612 If there is an error, returns the error, otherwise returns false.
618 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
620 local $SIG{HUP} = 'IGNORE';
621 local $SIG{INT} = 'IGNORE';
622 local $SIG{QUIT} = 'IGNORE';
623 local $SIG{TERM} = 'IGNORE';
624 local $SIG{TSTP} = 'IGNORE';
625 local $SIG{PIPE} = 'IGNORE';
627 my $oldAutoCommit = $FS::UID::AutoCommit;
628 local $FS::UID::AutoCommit = 0;
631 unless ( ref($prepay_credit) ) {
633 my $identifier = $prepay_credit;
635 $prepay_credit = qsearchs(
637 { 'identifier' => $prepay_credit },
642 unless ( $prepay_credit ) {
643 $dbh->rollback if $oldAutoCommit;
644 return "Invalid prepaid card: ". $identifier;
649 if ( $prepay_credit->agentnum ) {
650 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
651 $dbh->rollback if $oldAutoCommit;
652 return "prepaid card not valid for agent ". $self->agentnum;
654 $self->agentnum($prepay_credit->agentnum);
657 my $error = $prepay_credit->delete;
659 $dbh->rollback if $oldAutoCommit;
660 return "removing prepay_credit (transaction rolled back): $error";
663 $$amountref += $prepay_credit->amount;
664 $$secondsref += $prepay_credit->seconds;
666 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
671 =item increment_seconds SECONDS
673 Updates this customer's single or primary account (see L<FS::svc_acct>) by
674 the specified number of seconds. If there is an error, returns the error,
675 otherwise returns false.
679 sub increment_seconds {
680 my( $self, $seconds ) = @_;
681 warn "$me increment_seconds called: $seconds seconds\n"
684 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
685 $self->ncancelled_pkgs;
688 return 'No packages with primary or single services found'.
689 ' to apply pre-paid time';
690 } elsif ( scalar(@cust_pkg) > 1 ) {
691 #maybe have a way to specify the package/account?
692 return 'Multiple packages found to apply pre-paid time';
695 my $cust_pkg = $cust_pkg[0];
696 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
700 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
703 return 'No account found to apply pre-paid time';
704 } elsif ( scalar(@cust_svc) > 1 ) {
705 return 'Multiple accounts found to apply pre-paid time';
708 my $svc_acct = $cust_svc[0]->svc_x;
709 warn " found service svcnum ". $svc_acct->pkgnum.
710 ' ('. $svc_acct->email. ")\n"
713 $svc_acct->increment_seconds($seconds);
717 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
719 Inserts a prepayment in the specified amount for this customer. An optional
720 second argument can specify the prepayment identifier for tracking purposes.
721 If there is an error, returns the error, otherwise returns false.
725 sub insert_cust_pay_prepay {
726 shift->insert_cust_pay('PREP', @_);
729 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
731 Inserts a cash payment in the specified amount for this customer. An optional
732 second argument can specify the payment identifier for tracking purposes.
733 If there is an error, returns the error, otherwise returns false.
737 sub insert_cust_pay_cash {
738 shift->insert_cust_pay('CASH', @_);
741 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
743 Inserts a Western Union payment in the specified amount for this customer. An
744 optional second argument can specify the prepayment identifier for tracking
745 purposes. If there is an error, returns the error, otherwise returns false.
749 sub insert_cust_pay_west {
750 shift->insert_cust_pay('WEST', @_);
753 sub insert_cust_pay {
754 my( $self, $payby, $amount ) = splice(@_, 0, 3);
755 my $payinfo = scalar(@_) ? shift : '';
757 my $cust_pay = new FS::cust_pay {
758 'custnum' => $self->custnum,
759 'paid' => sprintf('%.2f', $amount),
760 #'_date' => #date the prepaid card was purchased???
762 'payinfo' => $payinfo,
770 This method is deprecated. See the I<depend_jobnum> option to the insert and
771 order_pkgs methods for a better way to defer provisioning.
773 Re-schedules all exports by calling the B<reexport> method of all associated
774 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
775 otherwise returns false.
782 carp "WARNING: FS::cust_main::reexport is deprectated; ".
783 "use the depend_jobnum option to insert or order_pkgs to delay export";
785 local $SIG{HUP} = 'IGNORE';
786 local $SIG{INT} = 'IGNORE';
787 local $SIG{QUIT} = 'IGNORE';
788 local $SIG{TERM} = 'IGNORE';
789 local $SIG{TSTP} = 'IGNORE';
790 local $SIG{PIPE} = 'IGNORE';
792 my $oldAutoCommit = $FS::UID::AutoCommit;
793 local $FS::UID::AutoCommit = 0;
796 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
797 my $error = $cust_pkg->reexport;
799 $dbh->rollback if $oldAutoCommit;
804 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
809 =item delete NEW_CUSTNUM
811 This deletes the customer. If there is an error, returns the error, otherwise
814 This will completely remove all traces of the customer record. This is not
815 what you want when a customer cancels service; for that, cancel all of the
816 customer's packages (see L</cancel>).
818 If the customer has any uncancelled packages, you need to pass a new (valid)
819 customer number for those packages to be transferred to. Cancelled packages
820 will be deleted. Did I mention that this is NOT what you want when a customer
821 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
823 You can't delete a customer with invoices (see L<FS::cust_bill>),
824 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
825 refunds (see L<FS::cust_refund>).
832 local $SIG{HUP} = 'IGNORE';
833 local $SIG{INT} = 'IGNORE';
834 local $SIG{QUIT} = 'IGNORE';
835 local $SIG{TERM} = 'IGNORE';
836 local $SIG{TSTP} = 'IGNORE';
837 local $SIG{PIPE} = 'IGNORE';
839 my $oldAutoCommit = $FS::UID::AutoCommit;
840 local $FS::UID::AutoCommit = 0;
843 if ( $self->cust_bill ) {
844 $dbh->rollback if $oldAutoCommit;
845 return "Can't delete a customer with invoices";
847 if ( $self->cust_credit ) {
848 $dbh->rollback if $oldAutoCommit;
849 return "Can't delete a customer with credits";
851 if ( $self->cust_pay ) {
852 $dbh->rollback if $oldAutoCommit;
853 return "Can't delete a customer with payments";
855 if ( $self->cust_refund ) {
856 $dbh->rollback if $oldAutoCommit;
857 return "Can't delete a customer with refunds";
860 my @cust_pkg = $self->ncancelled_pkgs;
862 my $new_custnum = shift;
863 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
864 $dbh->rollback if $oldAutoCommit;
865 return "Invalid new customer number: $new_custnum";
867 foreach my $cust_pkg ( @cust_pkg ) {
868 my %hash = $cust_pkg->hash;
869 $hash{'custnum'} = $new_custnum;
870 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
871 my $error = $new_cust_pkg->replace($cust_pkg);
873 $dbh->rollback if $oldAutoCommit;
878 my @cancelled_cust_pkg = $self->all_pkgs;
879 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
880 my $error = $cust_pkg->delete;
882 $dbh->rollback if $oldAutoCommit;
887 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
888 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
890 my $error = $cust_main_invoice->delete;
892 $dbh->rollback if $oldAutoCommit;
897 my $error = $self->SUPER::delete;
899 $dbh->rollback if $oldAutoCommit;
903 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
908 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
910 Replaces the OLD_RECORD with this one in the database. If there is an error,
911 returns the error, otherwise returns false.
913 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
914 be set as the invoicing list (see L<"invoicing_list">). Errors return as
915 expected and rollback the entire transaction; it is not necessary to call
916 check_invoicing_list first. Here's an example:
918 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
927 local $SIG{HUP} = 'IGNORE';
928 local $SIG{INT} = 'IGNORE';
929 local $SIG{QUIT} = 'IGNORE';
930 local $SIG{TERM} = 'IGNORE';
931 local $SIG{TSTP} = 'IGNORE';
932 local $SIG{PIPE} = 'IGNORE';
934 # If the mask is blank then try to set it - if we can...
935 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
936 $self->paymask($self->payinfo);
939 # We absolutely have to have an old vs. new record to make this work.
940 if (!defined($old)) {
941 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
944 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
945 && $conf->config('users-allow_comp') ) {
946 return "You are not permitted to create complimentary accounts."
947 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
950 local($ignore_expired_card) = 1
951 if $old->payby =~ /^(CARD|DCRD)$/
952 && $self->payby =~ /^(CARD|DCRD)$/
953 && $old->payinfo eq $self->payinfo;
955 my $oldAutoCommit = $FS::UID::AutoCommit;
956 local $FS::UID::AutoCommit = 0;
959 my $error = $self->SUPER::replace($old);
962 $dbh->rollback if $oldAutoCommit;
966 if ( @param ) { # INVOICING_LIST_ARYREF
967 my $invoicing_list = shift @param;
968 $error = $self->check_invoicing_list( $invoicing_list );
970 $dbh->rollback if $oldAutoCommit;
973 $self->invoicing_list( $invoicing_list );
976 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
977 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
978 # card/check/lec info has changed, want to retry realtime_ invoice events
979 my $error = $self->retry_realtime;
981 $dbh->rollback if $oldAutoCommit;
986 unless ( $import || $skip_fuzzyfiles ) {
987 $error = $self->queue_fuzzyfiles_update;
989 $dbh->rollback if $oldAutoCommit;
990 return "updating fuzzy search cache: $error";
994 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
999 =item queue_fuzzyfiles_update
1001 Used by insert & replace to update the fuzzy search cache
1005 sub queue_fuzzyfiles_update {
1008 local $SIG{HUP} = 'IGNORE';
1009 local $SIG{INT} = 'IGNORE';
1010 local $SIG{QUIT} = 'IGNORE';
1011 local $SIG{TERM} = 'IGNORE';
1012 local $SIG{TSTP} = 'IGNORE';
1013 local $SIG{PIPE} = 'IGNORE';
1015 my $oldAutoCommit = $FS::UID::AutoCommit;
1016 local $FS::UID::AutoCommit = 0;
1019 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1020 my $error = $queue->insert($self->getfield('last'), $self->company);
1022 $dbh->rollback if $oldAutoCommit;
1023 return "queueing job (transaction rolled back): $error";
1026 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1027 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1028 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1030 $dbh->rollback if $oldAutoCommit;
1031 return "queueing job (transaction rolled back): $error";
1035 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1042 Checks all fields to make sure this is a valid customer record. If there is
1043 an error, returns the error, otherwise returns false. Called by the insert
1044 and replace methods.
1051 warn "$me check BEFORE: \n". $self->_dump
1055 $self->ut_numbern('custnum')
1056 || $self->ut_number('agentnum')
1057 || $self->ut_number('refnum')
1058 || $self->ut_name('last')
1059 || $self->ut_name('first')
1060 || $self->ut_textn('company')
1061 || $self->ut_text('address1')
1062 || $self->ut_textn('address2')
1063 || $self->ut_text('city')
1064 || $self->ut_textn('county')
1065 || $self->ut_textn('state')
1066 || $self->ut_country('country')
1067 || $self->ut_anything('comments')
1068 || $self->ut_numbern('referral_custnum')
1070 #barf. need message catalogs. i18n. etc.
1071 $error .= "Please select an advertising source."
1072 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1073 return $error if $error;
1075 return "Unknown agent"
1076 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1078 return "Unknown refnum"
1079 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1081 return "Unknown referring custnum: ". $self->referral_custnum
1082 unless ! $self->referral_custnum
1083 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1085 if ( $self->ss eq '' ) {
1090 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1091 or return "Illegal social security number: ". $self->ss;
1092 $self->ss("$1-$2-$3");
1096 # bad idea to disable, causes billing to fail because of no tax rates later
1097 # unless ( $import ) {
1098 unless ( qsearch('cust_main_county', {
1099 'country' => $self->country,
1102 return "Unknown state/county/country: ".
1103 $self->state. "/". $self->county. "/". $self->country
1104 unless qsearch('cust_main_county',{
1105 'state' => $self->state,
1106 'county' => $self->county,
1107 'country' => $self->country,
1113 $self->ut_phonen('daytime', $self->country)
1114 || $self->ut_phonen('night', $self->country)
1115 || $self->ut_phonen('fax', $self->country)
1116 || $self->ut_zip('zip', $self->country)
1118 return $error if $error;
1121 last first company address1 address2 city county state zip
1122 country daytime night fax
1125 if ( defined $self->dbdef_table->column('ship_last') ) {
1126 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1128 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1132 $self->ut_name('ship_last')
1133 || $self->ut_name('ship_first')
1134 || $self->ut_textn('ship_company')
1135 || $self->ut_text('ship_address1')
1136 || $self->ut_textn('ship_address2')
1137 || $self->ut_text('ship_city')
1138 || $self->ut_textn('ship_county')
1139 || $self->ut_textn('ship_state')
1140 || $self->ut_country('ship_country')
1142 return $error if $error;
1144 #false laziness with above
1145 unless ( qsearchs('cust_main_county', {
1146 'country' => $self->ship_country,
1149 return "Unknown ship_state/ship_county/ship_country: ".
1150 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1151 unless qsearch('cust_main_county',{
1152 'state' => $self->ship_state,
1153 'county' => $self->ship_county,
1154 'country' => $self->ship_country,
1160 $self->ut_phonen('ship_daytime', $self->ship_country)
1161 || $self->ut_phonen('ship_night', $self->ship_country)
1162 || $self->ut_phonen('ship_fax', $self->ship_country)
1163 || $self->ut_zip('ship_zip', $self->ship_country)
1165 return $error if $error;
1167 } else { # ship_ info eq billing info, so don't store dup info in database
1168 $self->setfield("ship_$_", '')
1169 foreach qw( last first company address1 address2 city county state zip
1170 country daytime night fax );
1174 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1175 or return "Illegal payby: ". $self->payby;
1177 $error = $self->ut_numbern('paystart_month')
1178 || $self->ut_numbern('paystart_year')
1179 || $self->ut_numbern('payissue')
1181 return $error if $error;
1183 if ( $self->payip eq '' ) {
1186 $error = $self->ut_ip('payip');
1187 return $error if $error;
1190 # If it is encrypted and the private key is not availaible then we can't
1191 # check the credit card.
1193 my $check_payinfo = 1;
1195 if ($self->is_encrypted($self->payinfo)) {
1201 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1203 my $payinfo = $self->payinfo;
1204 $payinfo =~ s/\D//g;
1205 $payinfo =~ /^(\d{13,16})$/
1206 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1208 $self->payinfo($payinfo);
1210 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1212 return gettext('unknown_card_type')
1213 if cardtype($self->payinfo) eq "Unknown";
1215 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1216 return "Banned credit card" if $ban;
1218 if ( defined $self->dbdef_table->column('paycvv') ) {
1219 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1220 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1221 $self->paycvv =~ /^(\d{4})$/
1222 or return "CVV2 (CID) for American Express cards is four digits.";
1225 $self->paycvv =~ /^(\d{3})$/
1226 or return "CVV2 (CVC2/CID) is three digits.";
1234 my $cardtype = cardtype($payinfo);
1235 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1237 return "Start date or issue number is required for $cardtype cards"
1238 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1240 return "Start month must be between 1 and 12"
1241 if $self->paystart_month
1242 and $self->paystart_month < 1 || $self->paystart_month > 12;
1244 return "Start year must be 1990 or later"
1245 if $self->paystart_year
1246 and $self->paystart_year < 1990;
1248 return "Issue number must be beween 1 and 99"
1250 and $self->payissue < 1 || $self->payissue > 99;
1253 $self->paystart_month('');
1254 $self->paystart_year('');
1255 $self->payissue('');
1258 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1260 my $payinfo = $self->payinfo;
1261 $payinfo =~ s/[^\d\@]//g;
1262 if ( $conf->exists('echeck-nonus') ) {
1263 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1265 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1267 $payinfo = "$1\@$2";
1268 $self->payinfo($payinfo);
1269 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1271 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1272 return "Banned ACH account" if $ban;
1274 } elsif ( $self->payby eq 'LECB' ) {
1276 my $payinfo = $self->payinfo;
1277 $payinfo =~ s/\D//g;
1278 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1280 $self->payinfo($payinfo);
1281 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1283 } elsif ( $self->payby eq 'BILL' ) {
1285 $error = $self->ut_textn('payinfo');
1286 return "Illegal P.O. number: ". $self->payinfo if $error;
1287 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1289 } elsif ( $self->payby eq 'COMP' ) {
1291 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1292 return "You are not permitted to create complimentary accounts."
1293 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1296 $error = $self->ut_textn('payinfo');
1297 return "Illegal comp account issuer: ". $self->payinfo if $error;
1298 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1300 } elsif ( $self->payby eq 'PREPAY' ) {
1302 my $payinfo = $self->payinfo;
1303 $payinfo =~ s/\W//g; #anything else would just confuse things
1304 $self->payinfo($payinfo);
1305 $error = $self->ut_alpha('payinfo');
1306 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1307 return "Unknown prepayment identifier"
1308 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1309 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1313 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1314 return "Expiration date required"
1315 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1319 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1320 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1321 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1322 ( $m, $y ) = ( $3, "20$2" );
1324 return "Illegal expiration date: ". $self->paydate;
1326 $self->paydate("$y-$m-01");
1327 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1328 return gettext('expired_card')
1330 && !$ignore_expired_card
1331 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1334 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1335 ( ! $conf->exists('require_cardname')
1336 || $self->payby !~ /^(CARD|DCRD)$/ )
1338 $self->payname( $self->first. " ". $self->getfield('last') );
1340 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1341 or return gettext('illegal_name'). " payname: ". $self->payname;
1345 foreach my $flag (qw( tax spool_cdr )) {
1346 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1350 $self->otaker(getotaker) unless $self->otaker;
1352 warn "$me check AFTER: \n". $self->_dump
1355 $self->SUPER::check;
1360 Returns all packages (see L<FS::cust_pkg>) for this customer.
1366 if ( $self->{'_pkgnum'} ) {
1367 values %{ $self->{'_pkgnum'}->cache };
1369 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1373 =item ncancelled_pkgs
1375 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1379 sub ncancelled_pkgs {
1381 if ( $self->{'_pkgnum'} ) {
1382 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1384 @{ [ # force list context
1385 qsearch( 'cust_pkg', {
1386 'custnum' => $self->custnum,
1389 qsearch( 'cust_pkg', {
1390 'custnum' => $self->custnum,
1397 =item suspended_pkgs
1399 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1403 sub suspended_pkgs {
1405 grep { $_->susp } $self->ncancelled_pkgs;
1408 =item unflagged_suspended_pkgs
1410 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1411 customer (thouse packages without the `manual_flag' set).
1415 sub unflagged_suspended_pkgs {
1417 return $self->suspended_pkgs
1418 unless dbdef->table('cust_pkg')->column('manual_flag');
1419 grep { ! $_->manual_flag } $self->suspended_pkgs;
1422 =item unsuspended_pkgs
1424 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1429 sub unsuspended_pkgs {
1431 grep { ! $_->susp } $self->ncancelled_pkgs;
1434 =item num_cancelled_pkgs
1436 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1441 sub num_cancelled_pkgs {
1443 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1447 my( $self, $sql ) = @_;
1448 my $sth = dbh->prepare(
1449 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1450 ) or die dbh->errstr;
1451 $sth->execute($self->custnum) or die $sth->errstr;
1452 $sth->fetchrow_arrayref->[0];
1457 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1458 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1459 on success or a list of errors.
1465 grep { $_->unsuspend } $self->suspended_pkgs;
1470 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1472 Returns a list: an empty list on success or a list of errors.
1478 grep { $_->suspend } $self->unsuspended_pkgs;
1481 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1483 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1484 PKGPARTs (see L<FS::part_pkg>).
1486 Returns a list: an empty list on success or a list of errors.
1490 sub suspend_if_pkgpart {
1493 grep { $_->suspend }
1494 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1495 $self->unsuspended_pkgs;
1498 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1500 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1501 listed PKGPARTs (see L<FS::part_pkg>).
1503 Returns a list: an empty list on success or a list of errors.
1507 sub suspend_unless_pkgpart {
1510 grep { $_->suspend }
1511 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1512 $self->unsuspended_pkgs;
1515 =item cancel [ OPTION => VALUE ... ]
1517 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1519 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1521 I<quiet> can be set true to supress email cancellation notices.
1523 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1525 I<ban> can be set true to ban this customer's credit card or ACH information,
1528 Always returns a list: an empty list on success or a list of errors.
1536 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1538 #should try decryption (we might have the private key)
1539 # and if not maybe queue a job for the server that does?
1540 return ( "Can't (yet) ban encrypted credit cards" )
1541 if $self->is_encrypted($self->payinfo);
1543 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1544 my $error = $ban->insert;
1545 return ( $error ) if $error;
1549 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1552 sub _banned_pay_hashref {
1563 'payby' => $payby2ban{$self->payby},
1564 'payinfo' => md5_base64($self->payinfo),
1571 Returns the agent (see L<FS::agent>) for this customer.
1577 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1582 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1583 conjunction with the collect method.
1585 Options are passed as name-value pairs.
1587 Currently available options are:
1589 resetup - if set true, re-charges setup fees.
1591 time - bills the customer as if it were that time. Specified as a UNIX
1592 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1593 L<Date::Parse> for conversion functions. For example:
1597 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1600 If there is an error, returns the error, otherwise returns false.
1605 my( $self, %options ) = @_;
1606 return '' if $self->payby eq 'COMP';
1607 warn "$me bill customer ". $self->custnum. "\n"
1610 my $time = $options{'time'} || time;
1615 local $SIG{HUP} = 'IGNORE';
1616 local $SIG{INT} = 'IGNORE';
1617 local $SIG{QUIT} = 'IGNORE';
1618 local $SIG{TERM} = 'IGNORE';
1619 local $SIG{TSTP} = 'IGNORE';
1620 local $SIG{PIPE} = 'IGNORE';
1622 my $oldAutoCommit = $FS::UID::AutoCommit;
1623 local $FS::UID::AutoCommit = 0;
1626 $self->select_for_update; #mutex
1628 #create a new invoice
1629 #(we'll remove it later if it doesn't actually need to be generated [contains
1630 # no line items] and we're inside a transaciton so nothing else will see it)
1631 my $cust_bill = new FS::cust_bill ( {
1632 'custnum' => $self->custnum,
1634 #'charged' => $charged,
1637 $error = $cust_bill->insert;
1639 $dbh->rollback if $oldAutoCommit;
1640 return "can't create invoice for customer #". $self->custnum. ": $error";
1642 my $invnum = $cust_bill->invnum;
1645 # find the packages which are due for billing, find out how much they are
1646 # & generate invoice database.
1649 my( $total_setup, $total_recur ) = ( 0, 0 );
1651 my @precommit_hooks = ();
1653 foreach my $cust_pkg (
1654 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1657 #NO!! next if $cust_pkg->cancel;
1658 next if $cust_pkg->getfield('cancel');
1660 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1662 #? to avoid use of uninitialized value errors... ?
1663 $cust_pkg->setfield('bill', '')
1664 unless defined($cust_pkg->bill);
1666 my $part_pkg = $cust_pkg->part_pkg;
1668 my %hash = $cust_pkg->hash;
1669 my $old_cust_pkg = new FS::cust_pkg \%hash;
1678 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1680 warn " bill setup\n" if $DEBUG > 1;
1682 $setup = eval { $cust_pkg->calc_setup( $time ) };
1684 $dbh->rollback if $oldAutoCommit;
1685 return "$@ running calc_setup for $cust_pkg\n";
1688 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1692 # bill recurring fee
1697 if ( $part_pkg->getfield('freq') ne '0' &&
1698 ! $cust_pkg->getfield('susp') &&
1699 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1702 warn " bill recur\n" if $DEBUG > 1;
1704 # XXX shared with $recur_prog
1705 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1707 #over two params! lets at least switch to a hashref for the rest...
1708 my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1710 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1712 $dbh->rollback if $oldAutoCommit;
1713 return "$@ running calc_recur for $cust_pkg\n";
1716 #change this bit to use Date::Manip? CAREFUL with timezones (see
1717 # mailing list archive)
1718 my ($sec,$min,$hour,$mday,$mon,$year) =
1719 (localtime($sdate) )[0,1,2,3,4,5];
1721 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1722 # only for figuring next bill date, nothing else, so, reset $sdate again
1724 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1725 $cust_pkg->last_bill($sdate)
1726 if $cust_pkg->dbdef_table->column('last_bill');
1728 if ( $part_pkg->freq =~ /^\d+$/ ) {
1729 $mon += $part_pkg->freq;
1730 until ( $mon < 12 ) { $mon -= 12; $year++; }
1731 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1733 $mday += $weeks * 7;
1734 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1737 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1741 $dbh->rollback if $oldAutoCommit;
1742 return "unparsable frequency: ". $part_pkg->freq;
1744 $cust_pkg->setfield('bill',
1745 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1748 warn "\$setup is undefined" unless defined($setup);
1749 warn "\$recur is undefined" unless defined($recur);
1750 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1753 # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1756 if ( $cust_pkg->modified ) {
1758 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1761 $error=$cust_pkg->replace($old_cust_pkg);
1762 if ( $error ) { #just in case
1763 $dbh->rollback if $oldAutoCommit;
1764 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1767 $setup = sprintf( "%.2f", $setup );
1768 $recur = sprintf( "%.2f", $recur );
1769 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1770 $dbh->rollback if $oldAutoCommit;
1771 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1773 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1774 $dbh->rollback if $oldAutoCommit;
1775 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1778 if ( $setup != 0 || $recur != 0 ) {
1780 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1782 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1783 'invnum' => $invnum,
1784 'pkgnum' => $cust_pkg->pkgnum,
1788 'edate' => $cust_pkg->bill,
1789 'details' => \@details,
1791 $error = $cust_bill_pkg->insert;
1793 $dbh->rollback if $oldAutoCommit;
1794 return "can't create invoice line item for invoice #$invnum: $error";
1796 $total_setup += $setup;
1797 $total_recur += $recur;
1803 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1805 my @taxes = qsearch( 'cust_main_county', {
1806 'state' => $self->state,
1807 'county' => $self->county,
1808 'country' => $self->country,
1809 'taxclass' => $part_pkg->taxclass,
1812 @taxes = qsearch( 'cust_main_county', {
1813 'state' => $self->state,
1814 'county' => $self->county,
1815 'country' => $self->country,
1820 #one more try at a whole-country tax rate
1822 @taxes = qsearch( 'cust_main_county', {
1825 'country' => $self->country,
1830 # maybe eliminate this entirely, along with all the 0% records
1832 $dbh->rollback if $oldAutoCommit;
1834 "fatal: can't find tax rate for state/county/country/taxclass ".
1835 join('/', ( map $self->$_(), qw(state county country) ),
1836 $part_pkg->taxclass ). "\n";
1839 foreach my $tax ( @taxes ) {
1841 my $taxable_charged = 0;
1842 $taxable_charged += $setup
1843 unless $part_pkg->setuptax =~ /^Y$/i
1844 || $tax->setuptax =~ /^Y$/i;
1845 $taxable_charged += $recur
1846 unless $part_pkg->recurtax =~ /^Y$/i
1847 || $tax->recurtax =~ /^Y$/i;
1848 next unless $taxable_charged;
1850 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1851 #my ($mon,$year) = (localtime($sdate) )[4,5];
1852 my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1854 my $freq = $part_pkg->freq || 1;
1855 if ( $freq !~ /(\d+)$/ ) {
1856 $dbh->rollback if $oldAutoCommit;
1857 return "daily/weekly package definitions not (yet?)".
1858 " compatible with monthly tax exemptions";
1860 my $taxable_per_month =
1861 sprintf("%.2f", $taxable_charged / $freq );
1863 #call the whole thing off if this customer has any old
1864 #exemption records...
1865 my @cust_tax_exempt =
1866 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1867 if ( @cust_tax_exempt ) {
1868 $dbh->rollback if $oldAutoCommit;
1870 'this customer still has old-style tax exemption records; '.
1871 'run bin/fs-migrate-cust_tax_exempt?';
1874 foreach my $which_month ( 1 .. $freq ) {
1876 #maintain the new exemption table now
1879 FROM cust_tax_exempt_pkg
1880 LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1881 LEFT JOIN cust_bill USING ( invnum )
1887 my $sth = dbh->prepare($sql) or do {
1888 $dbh->rollback if $oldAutoCommit;
1889 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1897 $dbh->rollback if $oldAutoCommit;
1898 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1900 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1902 my $remaining_exemption =
1903 $tax->exempt_amount - $existing_exemption;
1904 if ( $remaining_exemption > 0 ) {
1905 my $addl = $remaining_exemption > $taxable_per_month
1906 ? $taxable_per_month
1907 : $remaining_exemption;
1908 $taxable_charged -= $addl;
1910 my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1911 'billpkgnum' => $cust_bill_pkg->billpkgnum,
1912 'taxnum' => $tax->taxnum,
1913 'year' => 1900+$year,
1915 'amount' => sprintf("%.2f", $addl ),
1917 $error = $cust_tax_exempt_pkg->insert;
1919 $dbh->rollback if $oldAutoCommit;
1920 return "fatal: can't insert cust_tax_exempt_pkg: $error";
1922 } # if $remaining_exemption > 0
1926 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1927 until ( $mon < 13 ) { $mon -= 12; $year++; }
1929 } #foreach $which_month
1931 } #if $tax->exempt_amount
1933 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1935 #$tax += $taxable_charged * $cust_main_county->tax / 100
1936 $tax{ $tax->taxname || 'Tax' } +=
1937 $taxable_charged * $tax->tax / 100
1939 } #foreach my $tax ( @taxes )
1941 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1943 } #if $setup != 0 || $recur != 0
1945 } #if $cust_pkg->modified
1947 } #foreach my $cust_pkg
1949 unless ( $cust_bill->cust_bill_pkg ) {
1950 $cust_bill->delete; #don't create an invoice w/o line items
1951 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1955 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1957 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1958 my $tax = sprintf("%.2f", $tax{$taxname} );
1959 $charged = sprintf( "%.2f", $charged+$tax );
1961 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1962 'invnum' => $invnum,
1968 'itemdesc' => $taxname,
1970 $error = $cust_bill_pkg->insert;
1972 $dbh->rollback if $oldAutoCommit;
1973 return "can't create invoice line item for invoice #$invnum: $error";
1975 $total_setup += $tax;
1979 $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1980 $error = $cust_bill->replace;
1982 $dbh->rollback if $oldAutoCommit;
1983 return "can't update charged for invoice #$invnum: $error";
1986 foreach my $hook ( @precommit_hooks ) {
1988 &{$hook}; #($self) ?
1991 $dbh->rollback if $oldAutoCommit;
1992 return "$@ running precommit hook $hook\n";
1996 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2000 =item collect OPTIONS
2002 (Attempt to) collect money for this customer's outstanding invoices (see
2003 L<FS::cust_bill>). Usually used after the bill method.
2005 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2006 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2007 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2009 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2010 and the invoice events web interface.
2012 If there is an error, returns the error, otherwise returns false.
2014 Options are passed as name-value pairs.
2016 Currently available options are:
2018 invoice_time - Use this time when deciding when to print invoices and
2019 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>
2020 for conversion functions.
2022 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2025 quiet - set true to surpress email card/ACH decline notices.
2027 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2033 my( $self, %options ) = @_;
2034 my $invoice_time = $options{'invoice_time'} || time;
2037 local $SIG{HUP} = 'IGNORE';
2038 local $SIG{INT} = 'IGNORE';
2039 local $SIG{QUIT} = 'IGNORE';
2040 local $SIG{TERM} = 'IGNORE';
2041 local $SIG{TSTP} = 'IGNORE';
2042 local $SIG{PIPE} = 'IGNORE';
2044 my $oldAutoCommit = $FS::UID::AutoCommit;
2045 local $FS::UID::AutoCommit = 0;
2048 $self->select_for_update; #mutex
2050 my $balance = $self->balance;
2051 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2053 unless ( $balance > 0 ) { #redundant?????
2054 $dbh->rollback if $oldAutoCommit; #hmm
2058 if ( exists($options{'retry_card'}) ) {
2059 carp 'retry_card option passed to collect is deprecated; use retry';
2060 $options{'retry'} ||= $options{'retry_card'};
2062 if ( exists($options{'retry'}) && $options{'retry'} ) {
2063 my $error = $self->retry_realtime;
2065 $dbh->rollback if $oldAutoCommit;
2071 if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2072 $extra_sql = " AND freq = '1m' ";
2074 $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2077 foreach my $cust_bill ( $self->open_cust_bill ) {
2079 # don't try to charge for the same invoice if it's already in a batch
2080 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2082 last if $self->balance <= 0;
2084 warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2087 foreach my $part_bill_event (
2088 sort { $a->seconds <=> $b->seconds
2089 || $a->weight <=> $b->weight
2090 || $a->eventpart <=> $b->eventpart }
2091 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2092 && ! qsearch( 'cust_bill_event', {
2093 'invnum' => $cust_bill->invnum,
2094 'eventpart' => $_->eventpart,
2099 'table' => 'part_bill_event',
2100 'hashref' => { 'payby' => $self->payby,
2101 'disabled' => '', },
2102 'extra_sql' => $extra_sql,
2106 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2107 || $self->balance <= 0; # or if balance<=0
2109 warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
2111 my $cust_main = $self; #for callback
2115 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2116 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2117 $error = eval $part_bill_event->eventcode;
2121 my $statustext = '';
2125 } elsif ( $error ) {
2127 $statustext = $error;
2132 #add cust_bill_event
2133 my $cust_bill_event = new FS::cust_bill_event {
2134 'invnum' => $cust_bill->invnum,
2135 'eventpart' => $part_bill_event->eventpart,
2136 #'_date' => $invoice_time,
2138 'status' => $status,
2139 'statustext' => $statustext,
2141 $error = $cust_bill_event->insert;
2143 #$dbh->rollback if $oldAutoCommit;
2144 #return "error: $error";
2146 # gah, even with transactions.
2147 $dbh->commit if $oldAutoCommit; #well.
2148 my $e = 'WARNING: Event run but database not updated - '.
2149 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2150 ', eventpart '. $part_bill_event->eventpart.
2161 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2166 =item retry_realtime
2168 Schedules realtime credit card / electronic check / LEC billing events for
2169 for retry. Useful if card information has changed or manual retry is desired.
2170 The 'collect' method must be called to actually retry the transaction.
2172 Implementation details: For each of this customer's open invoices, changes
2173 the status of the first "done" (with statustext error) realtime processing
2178 sub retry_realtime {
2181 local $SIG{HUP} = 'IGNORE';
2182 local $SIG{INT} = 'IGNORE';
2183 local $SIG{QUIT} = 'IGNORE';
2184 local $SIG{TERM} = 'IGNORE';
2185 local $SIG{TSTP} = 'IGNORE';
2186 local $SIG{PIPE} = 'IGNORE';
2188 my $oldAutoCommit = $FS::UID::AutoCommit;
2189 local $FS::UID::AutoCommit = 0;
2192 foreach my $cust_bill (
2193 grep { $_->cust_bill_event }
2194 $self->open_cust_bill
2196 my @cust_bill_event =
2197 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2199 #$_->part_bill_event->plan eq 'realtime-card'
2200 $_->part_bill_event->eventcode =~
2201 /\$cust_bill\->realtime_(card|ach|lec)/
2202 && $_->status eq 'done'
2205 $cust_bill->cust_bill_event;
2206 next unless @cust_bill_event;
2207 my $error = $cust_bill_event[0]->retry;
2209 $dbh->rollback if $oldAutoCommit;
2210 return "error scheduling invoice event for retry: $error";
2215 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2220 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2222 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2223 via a Business::OnlinePayment realtime gateway. See
2224 L<http://420.am/business-onlinepayment> for supported gateways.
2226 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2228 Available options are: I<description>, I<invnum>, I<quiet>
2230 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2231 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2232 if set, will override the value from the customer record.
2234 I<description> is a free-text field passed to the gateway. It defaults to
2235 "Internet services".
2237 If an I<invnum> is specified, this payment (if successful) is applied to the
2238 specified invoice. If you don't specify an I<invnum> you might want to
2239 call the B<apply_payments> method.
2241 I<quiet> can be set true to surpress email decline notices.
2243 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2248 my( $self, $method, $amount, %options ) = @_;
2250 warn "$me realtime_bop: $method $amount\n";
2251 warn " $_ => $options{$_}\n" foreach keys %options;
2254 $options{'description'} ||= 'Internet services';
2256 eval "use Business::OnlinePayment";
2259 my $payinfo = exists($options{'payinfo'})
2260 ? $options{'payinfo'}
2268 if ( $options{'invnum'} ) {
2269 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2270 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2272 map { $_->part_pkg->taxclass }
2274 map { $_->cust_pkg }
2275 $cust_bill->cust_bill_pkg;
2276 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2277 #different taxclasses
2278 $taxclass = $taxclasses[0];
2282 #look for an agent gateway override first
2284 if ( $method eq 'CC' ) {
2285 $cardtype = cardtype($payinfo);
2286 } elsif ( $method eq 'ECHECK' ) {
2289 $cardtype = $method;
2293 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2294 cardtype => $cardtype,
2295 taxclass => $taxclass, } )
2296 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2298 taxclass => $taxclass, } )
2299 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2300 cardtype => $cardtype,
2302 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2304 taxclass => '', } );
2306 my $payment_gateway = '';
2307 my( $processor, $login, $password, $action, @bop_options );
2308 if ( $override ) { #use a payment gateway override
2310 $payment_gateway = $override->payment_gateway;
2312 $processor = $payment_gateway->gateway_module;
2313 $login = $payment_gateway->gateway_username;
2314 $password = $payment_gateway->gateway_password;
2315 $action = $payment_gateway->gateway_action;
2316 @bop_options = $payment_gateway->options;
2318 } else { #use the standard settings from the config
2320 ( $processor, $login, $password, $action, @bop_options ) =
2321 $self->default_payment_gateway($method);
2329 my $address = exists($options{'address1'})
2330 ? $options{'address1'}
2332 my $address2 = exists($options{'address2'})
2333 ? $options{'address2'}
2335 $address .= ", ". $address2 if length($address2);
2337 my $o_payname = exists($options{'payname'})
2338 ? $options{'payname'}
2340 my($payname, $payfirst, $paylast);
2341 if ( $o_payname && $method ne 'ECHECK' ) {
2342 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2343 or return "Illegal payname $payname";
2344 ($payfirst, $paylast) = ($1, $2);
2346 $payfirst = $self->getfield('first');
2347 $paylast = $self->getfield('last');
2348 $payname = "$payfirst $paylast";
2351 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2352 if ( $conf->exists('emailinvoiceauto')
2353 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2354 push @invoicing_list, $self->all_emails;
2357 my $email = ($conf->exists('business-onlinepayment-email-override'))
2358 ? $conf->config('business-onlinepayment-email-override')
2359 : $invoicing_list[0];
2363 my $payip = exists($options{'payip'})
2366 $content{customer_ip} = $payip
2369 if ( $method eq 'CC' ) {
2371 $content{card_number} = $payinfo;
2372 my $paydate = exists($options{'paydate'})
2373 ? $options{'paydate'}
2375 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2376 $content{expiration} = "$2/$1";
2378 my $paycvv = exists($options{'paycvv'})
2379 ? $options{'paycvv'}
2381 $content{cvv2} = $self->paycvv
2384 my $paystart_month = exists($options{'paystart_month'})
2385 ? $options{'paystart_month'}
2386 : $self->paystart_month;
2388 my $paystart_year = exists($options{'paystart_year'})
2389 ? $options{'paystart_year'}
2390 : $self->paystart_year;
2392 $content{card_start} = "$paystart_month/$paystart_year"
2393 if $paystart_month && $paystart_year;
2395 my $payissue = exists($options{'payissue'})
2396 ? $options{'payissue'}
2398 $content{issue_number} = $payissue if $payissue;
2400 $content{recurring_billing} = 'YES'
2401 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2403 'payinfo' => $payinfo,
2406 } elsif ( $method eq 'ECHECK' ) {
2407 ( $content{account_number}, $content{routing_code} ) =
2408 split('@', $payinfo);
2409 $content{bank_name} = $o_payname;
2410 $content{account_type} = 'CHECKING';
2411 $content{account_name} = $payname;
2412 $content{customer_org} = $self->company ? 'B' : 'I';
2413 $content{customer_ssn} = exists($options{'ss'})
2416 } elsif ( $method eq 'LEC' ) {
2417 $content{phone} = $payinfo;
2421 # run transaction(s)
2424 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2426 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2427 $transaction->content(
2430 'password' => $password,
2431 'action' => $action1,
2432 'description' => $options{'description'},
2433 'amount' => $amount,
2434 'invoice_number' => $options{'invnum'},
2435 'customer_id' => $self->custnum,
2436 'last_name' => $paylast,
2437 'first_name' => $payfirst,
2439 'address' => $address,
2440 'city' => ( exists($options{'city'})
2443 'state' => ( exists($options{'state'})
2446 'zip' => ( exists($options{'zip'})
2449 'country' => ( exists($options{'country'})
2450 ? $options{'country'}
2452 'referer' => 'http://cleanwhisker.420.am/',
2454 'phone' => $self->daytime || $self->night,
2457 $transaction->submit();
2459 if ( $transaction->is_success() && $action2 ) {
2460 my $auth = $transaction->authorization;
2461 my $ordernum = $transaction->can('order_number')
2462 ? $transaction->order_number
2466 new Business::OnlinePayment( $processor, @bop_options );
2473 password => $password,
2474 order_number => $ordernum,
2476 authorization => $auth,
2477 description => $options{'description'},
2480 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2481 transaction_sequence_num local_transaction_date
2482 local_transaction_time AVS_result_code )) {
2483 $capture{$field} = $transaction->$field() if $transaction->can($field);
2486 $capture->content( %capture );
2490 unless ( $capture->is_success ) {
2491 my $e = "Authorization successful but capture failed, custnum #".
2492 $self->custnum. ': '. $capture->result_code.
2493 ": ". $capture->error_message;
2501 # remove paycvv after initial transaction
2504 #false laziness w/misc/process/payment.cgi - check both to make sure working
2506 if ( defined $self->dbdef_table->column('paycvv')
2507 && length($self->paycvv)
2508 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2510 my $error = $self->remove_cvv;
2512 warn "WARNING: error removing cvv: $error\n";
2520 if ( $transaction->is_success() ) {
2522 my %method2payby = (
2529 if ( $payment_gateway ) { # agent override
2530 $paybatch = $payment_gateway->gatewaynum. '-';
2533 $paybatch .= "$processor:". $transaction->authorization;
2535 $paybatch .= ':'. $transaction->order_number
2536 if $transaction->can('order_number')
2537 && length($transaction->order_number);
2539 my $cust_pay = new FS::cust_pay ( {
2540 'custnum' => $self->custnum,
2541 'invnum' => $options{'invnum'},
2544 'payby' => $method2payby{$method},
2545 'payinfo' => $payinfo,
2546 'paybatch' => $paybatch,
2548 my $error = $cust_pay->insert;
2550 $cust_pay->invnum(''); #try again with no specific invnum
2551 my $error2 = $cust_pay->insert;
2553 # gah, even with transactions.
2554 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2555 "error inserting payment ($processor): $error2".
2556 " (previously tried insert with invnum #$options{'invnum'}" .
2562 return ''; #no error
2566 my $perror = "$processor error: ". $transaction->error_message;
2568 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2569 && $conf->exists('emaildecline')
2570 && grep { $_ ne 'POST' } $self->invoicing_list
2571 && ! grep { $transaction->error_message =~ /$_/ }
2572 $conf->config('emaildecline-exclude')
2574 my @templ = $conf->config('declinetemplate');
2575 my $template = new Text::Template (
2577 SOURCE => [ map "$_\n", @templ ],
2578 ) or return "($perror) can't create template: $Text::Template::ERROR";
2579 $template->compile()
2580 or return "($perror) can't compile template: $Text::Template::ERROR";
2582 my $templ_hash = { error => $transaction->error_message };
2584 my $error = send_email(
2585 'from' => $conf->config('invoice_from'),
2586 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2587 'subject' => 'Your payment could not be processed',
2588 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2591 $perror .= " (also received error sending decline notification: $error)"
2601 =item default_payment_gateway
2605 sub default_payment_gateway {
2606 my( $self, $method ) = @_;
2608 die "Real-time processing not enabled\n"
2609 unless $conf->exists('business-onlinepayment');
2612 my $bop_config = 'business-onlinepayment';
2613 $bop_config .= '-ach'
2614 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2615 my ( $processor, $login, $password, $action, @bop_options ) =
2616 $conf->config($bop_config);
2617 $action ||= 'normal authorization';
2618 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2619 die "No real-time processor is enabled - ".
2620 "did you set the business-onlinepayment configuration value?\n"
2623 ( $processor, $login, $password, $action, @bop_options )
2628 Removes the I<paycvv> field from the database directly.
2630 If there is an error, returns the error, otherwise returns false.
2636 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2637 or return dbh->errstr;
2638 $sth->execute($self->custnum)
2639 or return $sth->errstr;
2644 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2646 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2647 via a Business::OnlinePayment realtime gateway. See
2648 L<http://420.am/business-onlinepayment> for supported gateways.
2650 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2652 Available options are: I<amount>, I<reason>, I<paynum>
2654 Most gateways require a reference to an original payment transaction to refund,
2655 so you probably need to specify a I<paynum>.
2657 I<amount> defaults to the original amount of the payment if not specified.
2659 I<reason> specifies a reason for the refund.
2661 Implementation note: If I<amount> is unspecified or equal to the amount of the
2662 orignal payment, first an attempt is made to "void" the transaction via
2663 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2664 the normal attempt is made to "refund" ("credit") the transaction via the
2665 gateway is attempted.
2667 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2668 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2669 #if set, will override the value from the customer record.
2671 #If an I<invnum> is specified, this payment (if successful) is applied to the
2672 #specified invoice. If you don't specify an I<invnum> you might want to
2673 #call the B<apply_payments> method.
2677 #some false laziness w/realtime_bop, not enough to make it worth merging
2678 #but some useful small subs should be pulled out
2679 sub realtime_refund_bop {
2680 my( $self, $method, %options ) = @_;
2682 warn "$me realtime_refund_bop: $method refund\n";
2683 warn " $_ => $options{$_}\n" foreach keys %options;
2686 eval "use Business::OnlinePayment";
2690 # look up the original payment and optionally a gateway for that payment
2694 my $amount = $options{'amount'};
2696 my( $processor, $login, $password, @bop_options ) ;
2697 my( $auth, $order_number ) = ( '', '', '' );
2699 if ( $options{'paynum'} ) {
2701 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
2702 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2703 or return "Unknown paynum $options{'paynum'}";
2704 $amount ||= $cust_pay->paid;
2706 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2707 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2708 $cust_pay->paybatch;
2709 my $gatewaynum = '';
2710 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2712 if ( $gatewaynum ) { #gateway for the payment to be refunded
2714 my $payment_gateway =
2715 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2716 die "payment gateway $gatewaynum not found"
2717 unless $payment_gateway;
2719 $processor = $payment_gateway->gateway_module;
2720 $login = $payment_gateway->gateway_username;
2721 $password = $payment_gateway->gateway_password;
2722 @bop_options = $payment_gateway->options;
2724 } else { #try the default gateway
2726 my( $conf_processor, $unused_action );
2727 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2728 $self->default_payment_gateway($method);
2730 return "processor of payment $options{'paynum'} $processor does not".
2731 " match default processor $conf_processor"
2732 unless $processor eq $conf_processor;
2737 } else { # didn't specify a paynum, so look for agent gateway overrides
2738 # like a normal transaction
2741 if ( $method eq 'CC' ) {
2742 $cardtype = cardtype($self->payinfo);
2743 } elsif ( $method eq 'ECHECK' ) {
2746 $cardtype = $method;
2749 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2750 cardtype => $cardtype,
2752 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2754 taxclass => '', } );
2756 if ( $override ) { #use a payment gateway override
2758 my $payment_gateway = $override->payment_gateway;
2760 $processor = $payment_gateway->gateway_module;
2761 $login = $payment_gateway->gateway_username;
2762 $password = $payment_gateway->gateway_password;
2763 #$action = $payment_gateway->gateway_action;
2764 @bop_options = $payment_gateway->options;
2766 } else { #use the standard settings from the config
2769 ( $processor, $login, $password, $unused_action, @bop_options ) =
2770 $self->default_payment_gateway($method);
2775 return "neither amount nor paynum specified" unless $amount;
2780 'password' => $password,
2781 'order_number' => $order_number,
2782 'amount' => $amount,
2783 'referer' => 'http://cleanwhisker.420.am/',
2785 $content{authorization} = $auth
2786 if length($auth); #echeck/ACH transactions have an order # but no auth
2787 #(at least with authorize.net)
2789 #first try void if applicable
2790 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2791 warn " attempting void\n" if $DEBUG > 1;
2792 my $void = new Business::OnlinePayment( $processor, @bop_options );
2793 $void->content( 'action' => 'void', %content );
2795 if ( $void->is_success ) {
2796 my $error = $cust_pay->void($options{'reason'});
2798 # gah, even with transactions.
2799 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2800 "error voiding payment: $error";
2804 warn " void successful\n" if $DEBUG > 1;
2809 warn " void unsuccessful, trying refund\n"
2813 my $address = $self->address1;
2814 $address .= ", ". $self->address2 if $self->address2;
2816 my($payname, $payfirst, $paylast);
2817 if ( $self->payname && $method ne 'ECHECK' ) {
2818 $payname = $self->payname;
2819 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2820 or return "Illegal payname $payname";
2821 ($payfirst, $paylast) = ($1, $2);
2823 $payfirst = $self->getfield('first');
2824 $paylast = $self->getfield('last');
2825 $payname = "$payfirst $paylast";
2829 if ( $method eq 'CC' ) {
2832 $content{card_number} = $payinfo = $cust_pay->payinfo;
2833 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2834 #$content{expiration} = "$2/$1";
2836 $content{card_number} = $payinfo = $self->payinfo;
2837 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2838 $content{expiration} = "$2/$1";
2841 } elsif ( $method eq 'ECHECK' ) {
2842 ( $content{account_number}, $content{routing_code} ) =
2843 split('@', $payinfo = $self->payinfo);
2844 $content{bank_name} = $self->payname;
2845 $content{account_type} = 'CHECKING';
2846 $content{account_name} = $payname;
2847 $content{customer_org} = $self->company ? 'B' : 'I';
2848 $content{customer_ssn} = $self->ss;
2849 } elsif ( $method eq 'LEC' ) {
2850 $content{phone} = $payinfo = $self->payinfo;
2854 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2855 my %sub_content = $refund->content(
2856 'action' => 'credit',
2857 'customer_id' => $self->custnum,
2858 'last_name' => $paylast,
2859 'first_name' => $payfirst,
2861 'address' => $address,
2862 'city' => $self->city,
2863 'state' => $self->state,
2864 'zip' => $self->zip,
2865 'country' => $self->country,
2868 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2872 return "$processor error: ". $refund->error_message
2873 unless $refund->is_success();
2875 my %method2payby = (
2881 my $paybatch = "$processor:". $refund->authorization;
2882 $paybatch .= ':'. $refund->order_number
2883 if $refund->can('order_number') && $refund->order_number;
2885 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2886 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2887 last unless @cust_bill_pay;
2888 my $cust_bill_pay = pop @cust_bill_pay;
2889 my $error = $cust_bill_pay->delete;
2893 my $cust_refund = new FS::cust_refund ( {
2894 'custnum' => $self->custnum,
2895 'paynum' => $options{'paynum'},
2896 'refund' => $amount,
2898 'payby' => $method2payby{$method},
2899 'payinfo' => $payinfo,
2900 'paybatch' => $paybatch,
2901 'reason' => $options{'reason'} || 'card or ACH refund',
2903 my $error = $cust_refund->insert;
2905 $cust_refund->paynum(''); #try again with no specific paynum
2906 my $error2 = $cust_refund->insert;
2908 # gah, even with transactions.
2909 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2910 "error inserting refund ($processor): $error2".
2911 " (previously tried insert with paynum #$options{'paynum'}" .
2924 Returns the total owed for this customer on all invoices
2925 (see L<FS::cust_bill/owed>).
2931 $self->total_owed_date(2145859200); #12/31/2037
2934 =item total_owed_date TIME
2936 Returns the total owed for this customer on all invoices with date earlier than
2937 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2938 see L<Time::Local> and L<Date::Parse> for conversion functions.
2942 sub total_owed_date {
2946 foreach my $cust_bill (
2947 grep { $_->_date <= $time }
2948 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2950 $total_bill += $cust_bill->owed;
2952 sprintf( "%.2f", $total_bill );
2955 =item apply_credits OPTION => VALUE ...
2957 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2958 to outstanding invoice balances in chronological order (or reverse
2959 chronological order if the I<order> option is set to B<newest>) and returns the
2960 value of any remaining unapplied credits available for refund (see
2961 L<FS::cust_refund>).
2969 return 0 unless $self->total_credited;
2971 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2972 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2974 my @invoices = $self->open_cust_bill;
2975 @invoices = sort { $b->_date <=> $a->_date } @invoices
2976 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2979 foreach my $cust_bill ( @invoices ) {
2982 if ( !defined($credit) || $credit->credited == 0) {
2983 $credit = pop @credits or last;
2986 if ($cust_bill->owed >= $credit->credited) {
2987 $amount=$credit->credited;
2989 $amount=$cust_bill->owed;
2992 my $cust_credit_bill = new FS::cust_credit_bill ( {
2993 'crednum' => $credit->crednum,
2994 'invnum' => $cust_bill->invnum,
2995 'amount' => $amount,
2997 my $error = $cust_credit_bill->insert;
2998 die $error if $error;
3000 redo if ($cust_bill->owed > 0);
3004 return $self->total_credited;
3007 =item apply_payments
3009 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3010 to outstanding invoice balances in chronological order.
3012 #and returns the value of any remaining unapplied payments.
3016 sub apply_payments {
3021 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3022 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3024 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3025 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3029 foreach my $cust_bill ( @invoices ) {
3032 if ( !defined($payment) || $payment->unapplied == 0 ) {
3033 $payment = pop @payments or last;
3036 if ( $cust_bill->owed >= $payment->unapplied ) {
3037 $amount = $payment->unapplied;
3039 $amount = $cust_bill->owed;
3042 my $cust_bill_pay = new FS::cust_bill_pay ( {
3043 'paynum' => $payment->paynum,
3044 'invnum' => $cust_bill->invnum,
3045 'amount' => $amount,
3047 my $error = $cust_bill_pay->insert;
3048 die $error if $error;
3050 redo if ( $cust_bill->owed > 0);
3054 return $self->total_unapplied_payments;
3057 =item total_credited
3059 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3060 customer. See L<FS::cust_credit/credited>.
3064 sub total_credited {
3066 my $total_credit = 0;
3067 foreach my $cust_credit ( qsearch('cust_credit', {
3068 'custnum' => $self->custnum,
3070 $total_credit += $cust_credit->credited;
3072 sprintf( "%.2f", $total_credit );
3075 =item total_unapplied_payments
3077 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3078 See L<FS::cust_pay/unapplied>.
3082 sub total_unapplied_payments {
3084 my $total_unapplied = 0;
3085 foreach my $cust_pay ( qsearch('cust_pay', {
3086 'custnum' => $self->custnum,
3088 $total_unapplied += $cust_pay->unapplied;
3090 sprintf( "%.2f", $total_unapplied );
3095 Returns the balance for this customer (total_owed minus total_credited
3096 minus total_unapplied_payments).
3103 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3107 =item balance_date TIME
3109 Returns the balance for this customer, only considering invoices with date
3110 earlier than TIME (total_owed_date minus total_credited minus
3111 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3112 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3121 $self->total_owed_date($time)
3122 - $self->total_credited
3123 - $self->total_unapplied_payments
3127 =item paydate_monthyear
3129 Returns a two-element list consisting of the month and year of this customer's
3130 paydate (credit card expiration date for CARD customers)
3134 sub paydate_monthyear {
3136 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3138 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3145 =item payinfo_masked
3147 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.
3149 Credit Cards - Mask all but the last four characters.
3150 Checks - Mask all but last 2 of account number and bank routing number.
3151 Others - Do nothing, return the unmasked string.
3155 sub payinfo_masked {
3157 return $self->paymask;
3160 =item invoicing_list [ ARRAYREF ]
3162 If an arguement is given, sets these email addresses as invoice recipients
3163 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3164 (except as warnings), so use check_invoicing_list first.
3166 Returns a list of email addresses (with svcnum entries expanded).
3168 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3169 check it without disturbing anything by passing nothing.
3171 This interface may change in the future.
3175 sub invoicing_list {
3176 my( $self, $arrayref ) = @_;
3178 my @cust_main_invoice;
3179 if ( $self->custnum ) {
3180 @cust_main_invoice =
3181 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3183 @cust_main_invoice = ();
3185 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3186 #warn $cust_main_invoice->destnum;
3187 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3188 #warn $cust_main_invoice->destnum;
3189 my $error = $cust_main_invoice->delete;
3190 warn $error if $error;
3193 if ( $self->custnum ) {
3194 @cust_main_invoice =
3195 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3197 @cust_main_invoice = ();
3199 my %seen = map { $_->address => 1 } @cust_main_invoice;
3200 foreach my $address ( @{$arrayref} ) {
3201 next if exists $seen{$address} && $seen{$address};
3202 $seen{$address} = 1;
3203 my $cust_main_invoice = new FS::cust_main_invoice ( {
3204 'custnum' => $self->custnum,
3207 my $error = $cust_main_invoice->insert;
3208 warn $error if $error;
3211 if ( $self->custnum ) {
3213 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3219 =item check_invoicing_list ARRAYREF
3221 Checks these arguements as valid input for the invoicing_list method. If there
3222 is an error, returns the error, otherwise returns false.
3226 sub check_invoicing_list {
3227 my( $self, $arrayref ) = @_;
3228 foreach my $address ( @{$arrayref} ) {
3230 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3231 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3234 my $cust_main_invoice = new FS::cust_main_invoice ( {
3235 'custnum' => $self->custnum,
3238 my $error = $self->custnum
3239 ? $cust_main_invoice->check
3240 : $cust_main_invoice->checkdest
3242 return $error if $error;
3247 =item set_default_invoicing_list
3249 Sets the invoicing list to all accounts associated with this customer,
3250 overwriting any previous invoicing list.
3254 sub set_default_invoicing_list {
3256 $self->invoicing_list($self->all_emails);
3261 Returns the email addresses of all accounts provisioned for this customer.
3268 foreach my $cust_pkg ( $self->all_pkgs ) {
3269 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3271 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3272 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3274 $list{$_}=1 foreach map { $_->email } @svc_acct;
3279 =item invoicing_list_addpost
3281 Adds postal invoicing to this customer. If this customer is already configured
3282 to receive postal invoices, does nothing.
3286 sub invoicing_list_addpost {
3288 return if grep { $_ eq 'POST' } $self->invoicing_list;
3289 my @invoicing_list = $self->invoicing_list;
3290 push @invoicing_list, 'POST';
3291 $self->invoicing_list(\@invoicing_list);
3294 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3296 Returns an array of customers referred by this customer (referral_custnum set
3297 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3298 customers referred by customers referred by this customer and so on, inclusive.
3299 The default behavior is DEPTH 1 (no recursion).
3303 sub referral_cust_main {
3305 my $depth = @_ ? shift : 1;
3306 my $exclude = @_ ? shift : {};
3309 map { $exclude->{$_->custnum}++; $_; }
3310 grep { ! $exclude->{ $_->custnum } }
3311 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3315 map { $_->referral_cust_main($depth-1, $exclude) }
3322 =item referral_cust_main_ncancelled
3324 Same as referral_cust_main, except only returns customers with uncancelled
3329 sub referral_cust_main_ncancelled {
3331 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3334 =item referral_cust_pkg [ DEPTH ]
3336 Like referral_cust_main, except returns a flat list of all unsuspended (and
3337 uncancelled) packages for each customer. The number of items in this list may
3338 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3342 sub referral_cust_pkg {
3344 my $depth = @_ ? shift : 1;
3346 map { $_->unsuspended_pkgs }
3347 grep { $_->unsuspended_pkgs }
3348 $self->referral_cust_main($depth);
3351 =item referring_cust_main
3353 Returns the single cust_main record for the customer who referred this customer
3354 (referral_custnum), or false.
3358 sub referring_cust_main {
3360 return '' unless $self->referral_custnum;
3361 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3364 =item credit AMOUNT, REASON
3366 Applies a credit to this customer. If there is an error, returns the error,
3367 otherwise returns false.
3372 my( $self, $amount, $reason ) = @_;
3373 my $cust_credit = new FS::cust_credit {
3374 'custnum' => $self->custnum,
3375 'amount' => $amount,
3376 'reason' => $reason,
3378 $cust_credit->insert;
3381 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3383 Creates a one-time charge for this customer. If there is an error, returns
3384 the error, otherwise returns false.
3389 my ( $self, $amount ) = ( shift, shift );
3390 my $pkg = @_ ? shift : 'One-time charge';
3391 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3392 my $taxclass = @_ ? shift : '';
3394 local $SIG{HUP} = 'IGNORE';
3395 local $SIG{INT} = 'IGNORE';
3396 local $SIG{QUIT} = 'IGNORE';
3397 local $SIG{TERM} = 'IGNORE';
3398 local $SIG{TSTP} = 'IGNORE';
3399 local $SIG{PIPE} = 'IGNORE';
3401 my $oldAutoCommit = $FS::UID::AutoCommit;
3402 local $FS::UID::AutoCommit = 0;
3405 my $part_pkg = new FS::part_pkg ( {
3407 'comment' => $comment,
3408 #'setup' => $amount,
3411 'plandata' => "setup_fee=$amount",
3414 'taxclass' => $taxclass,
3417 my $error = $part_pkg->insert;
3419 $dbh->rollback if $oldAutoCommit;
3423 my $pkgpart = $part_pkg->pkgpart;
3424 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3425 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3426 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3427 $error = $type_pkgs->insert;
3429 $dbh->rollback if $oldAutoCommit;
3434 my $cust_pkg = new FS::cust_pkg ( {
3435 'custnum' => $self->custnum,
3436 'pkgpart' => $pkgpart,
3439 $error = $cust_pkg->insert;
3441 $dbh->rollback if $oldAutoCommit;
3445 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3452 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3458 sort { $a->_date <=> $b->_date }
3459 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3462 =item open_cust_bill
3464 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3469 sub open_cust_bill {
3471 grep { $_->owed > 0 } $self->cust_bill;
3476 Returns all the credits (see L<FS::cust_credit>) for this customer.
3482 sort { $a->_date <=> $b->_date }
3483 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3488 Returns all the payments (see L<FS::cust_pay>) for this customer.
3494 sort { $a->_date <=> $b->_date }
3495 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3500 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3506 sort { $a->_date <=> $b->_date }
3507 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3513 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3519 sort { $a->_date <=> $b->_date }
3520 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3523 =item select_for_update
3525 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3530 sub select_for_update {
3532 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3537 Returns a name string for this customer, either "Company (Last, First)" or
3544 my $name = $self->contact;
3545 $name = $self->company. " ($name)" if $self->company;
3551 Returns a name string for this (service/shipping) contact, either
3552 "Company (Last, First)" or "Last, First".
3558 if ( $self->get('ship_last') ) {
3559 my $name = $self->ship_contact;
3560 $name = $self->ship_company. " ($name)" if $self->ship_company;
3569 Returns this customer's full (billing) contact name only, "Last, First"
3575 $self->get('last'). ', '. $self->first;
3580 Returns this customer's full (shipping) contact name only, "Last, First"
3586 $self->get('ship_last')
3587 ? $self->get('ship_last'). ', '. $self->ship_first
3593 Returns a status string for this customer, currently:
3597 =item prospect - No packages have ever been ordered
3599 =item active - One or more recurring packages is active
3601 =item suspended - All non-cancelled recurring packages are suspended
3603 =item cancelled - All recurring packages are cancelled
3611 for my $status (qw( prospect active suspended cancelled )) {
3612 my $method = $status.'_sql';
3613 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3614 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3615 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3616 return $status if $sth->fetchrow_arrayref->[0];
3622 Returns a hex triplet color string for this customer's status.
3627 'prospect' => '000000',
3628 'active' => '00CC00',
3629 'suspended' => 'FF9900',
3630 'cancelled' => 'FF0000',
3634 $statuscolor{$self->status};
3639 =head1 CLASS METHODS
3645 Returns an SQL expression identifying prospective cust_main records (customers
3646 with no packages ever ordered)
3650 sub prospect_sql { "
3651 0 = ( SELECT COUNT(*) FROM cust_pkg
3652 WHERE cust_pkg.custnum = cust_main.custnum
3658 Returns an SQL expression identifying active cust_main records.
3663 0 < ( SELECT COUNT(*) FROM cust_pkg
3664 WHERE cust_pkg.custnum = cust_main.custnum
3665 AND ". FS::cust_pkg->active_sql. "
3672 Returns an SQL expression identifying suspended cust_main records.
3676 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3677 my $recurring_sql = "
3678 '0' != ( select freq from part_pkg
3679 where cust_pkg.pkgpart = part_pkg.pkgpart )
3682 sub suspended_sql { susp_sql(@_); }
3684 0 < ( SELECT COUNT(*) FROM cust_pkg
3685 WHERE cust_pkg.custnum = cust_main.custnum
3687 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3689 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3690 WHERE cust_pkg.custnum = cust_main.custnum
3691 AND ". FS::cust_pkg->active_sql. "
3698 Returns an SQL expression identifying cancelled cust_main records.
3702 sub cancelled_sql { cancel_sql(@_); }
3704 0 < ( SELECT COUNT(*) FROM cust_pkg
3705 WHERE cust_pkg.custnum = cust_main.custnum
3707 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3708 WHERE cust_pkg.custnum = cust_main.custnum
3710 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3714 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3716 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3717 records. Currently, only I<last> or I<company> may be specified (the
3718 appropriate ship_ field is also searched if applicable).
3720 Additional options are the same as FS::Record::qsearch
3725 my( $self, $fuzzy, $hash, @opt) = @_;
3730 check_and_rebuild_fuzzyfiles();
3731 foreach my $field ( keys %$fuzzy ) {
3732 my $sub = \&{"all_$field"};
3734 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3736 foreach ( keys %match ) {
3737 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3738 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3739 if defined dbdef->table('cust_main')->column('ship_last');
3744 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3756 =item smart_search OPTION => VALUE ...
3758 Accepts the following options: I<search>, the string to search for. The string
3759 will be searched for as a customer number, last name or company name, first
3760 searching for an exact match then fuzzy and substring matches.
3762 Any additional options treated as an additional qualifier on the search
3765 Returns a (possibly empty) array of FS::cust_main objects.
3771 my $search = delete $options{'search'};
3774 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3776 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3778 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3781 my $q_value = dbh->quote($value);
3784 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3785 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3786 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3787 if defined dbdef->table('cust_main')->column('ship_last');
3790 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3792 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3794 #still some false laziness w/ search/cust_main.cgi
3797 push @cust_main, qsearch( 'cust_main',
3798 { 'last' => { 'op' => 'ILIKE',
3799 'value' => "%$q_value%" },
3803 push @cust_main, qsearch( 'cust_main',
3804 { 'ship_last' => { 'op' => 'ILIKE',
3805 'value' => "%$q_value%" },
3810 if defined dbdef->table('cust_main')->column('ship_last');
3812 push @cust_main, qsearch( 'cust_main',
3813 { 'company' => { 'op' => 'ILIKE',
3814 'value' => "%$q_value%" },
3818 push @cust_main, qsearch( 'cust_main',
3819 { 'ship_company' => { 'op' => 'ILIKE',
3820 'value' => "%$q_value%" },
3824 if defined dbdef->table('cust_main')->column('ship_last');
3827 push @cust_main, FS::cust_main->fuzzy_search(
3828 { 'last' => $value },
3831 push @cust_main, FS::cust_main->fuzzy_search(
3832 { 'company' => $value },
3844 =item check_and_rebuild_fuzzyfiles
3848 sub check_and_rebuild_fuzzyfiles {
3849 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3850 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3851 or &rebuild_fuzzyfiles;
3854 =item rebuild_fuzzyfiles
3858 sub rebuild_fuzzyfiles {
3860 use Fcntl qw(:flock);
3862 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3866 open(LASTLOCK,">>$dir/cust_main.last")
3867 or die "can't open $dir/cust_main.last: $!";
3868 flock(LASTLOCK,LOCK_EX)
3869 or die "can't lock $dir/cust_main.last: $!";
3871 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3873 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3874 if defined dbdef->table('cust_main')->column('ship_last');
3876 open (LASTCACHE,">$dir/cust_main.last.tmp")
3877 or die "can't open $dir/cust_main.last.tmp: $!";
3878 print LASTCACHE join("\n", @all_last), "\n";
3879 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3881 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3886 open(COMPANYLOCK,">>$dir/cust_main.company")
3887 or die "can't open $dir/cust_main.company: $!";
3888 flock(COMPANYLOCK,LOCK_EX)
3889 or die "can't lock $dir/cust_main.company: $!";
3891 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3893 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3894 if defined dbdef->table('cust_main')->column('ship_last');
3896 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3897 or die "can't open $dir/cust_main.company.tmp: $!";
3898 print COMPANYCACHE join("\n", @all_company), "\n";
3899 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3901 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3911 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3912 open(LASTCACHE,"<$dir/cust_main.last")
3913 or die "can't open $dir/cust_main.last: $!";
3914 my @array = map { chomp; $_; } <LASTCACHE>;
3924 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3925 open(COMPANYCACHE,"<$dir/cust_main.company")
3926 or die "can't open $dir/cust_main.last: $!";
3927 my @array = map { chomp; $_; } <COMPANYCACHE>;
3932 =item append_fuzzyfiles LASTNAME COMPANY
3936 sub append_fuzzyfiles {
3937 my( $last, $company ) = @_;
3939 &check_and_rebuild_fuzzyfiles;
3941 use Fcntl qw(:flock);
3943 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3947 open(LAST,">>$dir/cust_main.last")
3948 or die "can't open $dir/cust_main.last: $!";
3950 or die "can't lock $dir/cust_main.last: $!";
3952 print LAST "$last\n";
3955 or die "can't unlock $dir/cust_main.last: $!";
3961 open(COMPANY,">>$dir/cust_main.company")
3962 or die "can't open $dir/cust_main.company: $!";
3963 flock(COMPANY,LOCK_EX)
3964 or die "can't lock $dir/cust_main.company: $!";
3966 print COMPANY "$company\n";
3968 flock(COMPANY,LOCK_UN)
3969 or die "can't unlock $dir/cust_main.company: $!";
3983 #warn join('-',keys %$param);
3984 my $fh = $param->{filehandle};
3985 my $agentnum = $param->{agentnum};
3986 my $refnum = $param->{refnum};
3987 my $pkgpart = $param->{pkgpart};
3988 my @fields = @{$param->{fields}};
3990 eval "use Text::CSV_XS;";
3993 my $csv = new Text::CSV_XS;
4000 local $SIG{HUP} = 'IGNORE';
4001 local $SIG{INT} = 'IGNORE';
4002 local $SIG{QUIT} = 'IGNORE';
4003 local $SIG{TERM} = 'IGNORE';
4004 local $SIG{TSTP} = 'IGNORE';
4005 local $SIG{PIPE} = 'IGNORE';
4007 my $oldAutoCommit = $FS::UID::AutoCommit;
4008 local $FS::UID::AutoCommit = 0;
4011 #while ( $columns = $csv->getline($fh) ) {
4013 while ( defined($line=<$fh>) ) {
4015 $csv->parse($line) or do {
4016 $dbh->rollback if $oldAutoCommit;
4017 return "can't parse: ". $csv->error_input();
4020 my @columns = $csv->fields();
4021 #warn join('-',@columns);
4024 agentnum => $agentnum,
4026 country => $conf->config('countrydefault') || 'US',
4027 payby => 'BILL', #default
4028 paydate => '12/2037', #default
4030 my $billtime = time;
4031 my %cust_pkg = ( pkgpart => $pkgpart );
4032 foreach my $field ( @fields ) {
4033 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4034 #$cust_pkg{$1} = str2time( shift @$columns );
4035 if ( $1 eq 'setup' ) {
4036 $billtime = str2time(shift @columns);
4038 $cust_pkg{$1} = str2time( shift @columns );
4041 #$cust_main{$field} = shift @$columns;
4042 $cust_main{$field} = shift @columns;
4046 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4047 my $cust_main = new FS::cust_main ( \%cust_main );
4049 tie my %hash, 'Tie::RefHash'; #this part is important
4050 $hash{$cust_pkg} = [] if $pkgpart;
4051 my $error = $cust_main->insert( \%hash );
4054 $dbh->rollback if $oldAutoCommit;
4055 return "can't insert customer for $line: $error";
4058 #false laziness w/bill.cgi
4059 $error = $cust_main->bill( 'time' => $billtime );
4061 $dbh->rollback if $oldAutoCommit;
4062 return "can't bill customer for $line: $error";
4065 $cust_main->apply_payments;
4066 $cust_main->apply_credits;
4068 $error = $cust_main->collect();
4070 $dbh->rollback if $oldAutoCommit;
4071 return "can't collect customer for $line: $error";
4077 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4079 return "Empty file!" unless $imported;
4091 #warn join('-',keys %$param);
4092 my $fh = $param->{filehandle};
4093 my @fields = @{$param->{fields}};
4095 eval "use Text::CSV_XS;";
4098 my $csv = new Text::CSV_XS;
4105 local $SIG{HUP} = 'IGNORE';
4106 local $SIG{INT} = 'IGNORE';
4107 local $SIG{QUIT} = 'IGNORE';
4108 local $SIG{TERM} = 'IGNORE';
4109 local $SIG{TSTP} = 'IGNORE';
4110 local $SIG{PIPE} = 'IGNORE';
4112 my $oldAutoCommit = $FS::UID::AutoCommit;
4113 local $FS::UID::AutoCommit = 0;
4116 #while ( $columns = $csv->getline($fh) ) {
4118 while ( defined($line=<$fh>) ) {
4120 $csv->parse($line) or do {
4121 $dbh->rollback if $oldAutoCommit;
4122 return "can't parse: ". $csv->error_input();
4125 my @columns = $csv->fields();
4126 #warn join('-',@columns);
4129 foreach my $field ( @fields ) {
4130 $row{$field} = shift @columns;
4133 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4134 unless ( $cust_main ) {
4135 $dbh->rollback if $oldAutoCommit;
4136 return "unknown custnum $row{'custnum'}";
4139 if ( $row{'amount'} > 0 ) {
4140 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4142 $dbh->rollback if $oldAutoCommit;
4146 } elsif ( $row{'amount'} < 0 ) {
4147 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4150 $dbh->rollback if $oldAutoCommit;
4160 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4162 return "Empty file!" unless $imported;
4174 The delete method should possibly take an FS::cust_main object reference
4175 instead of a scalar customer number.
4177 Bill and collect options should probably be passed as references instead of a
4180 There should probably be a configuration file with a list of allowed credit
4183 No multiple currency support (probably a larger project than just this module).
4185 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4189 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4190 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4191 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.