4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
5 $import $skip_fuzzyfiles $ignore_expired_card );
6 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 eval "use Time::Local;";
12 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
13 if $] < 5.006 && !defined($Time::Local::VERSION);
14 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 eval "use Time::Local qw(timelocal_nocheck);";
17 use Digest::MD5 qw(md5_base64);
20 use String::Approx qw(amatch);
21 use Business::CreditCard 0.28;
22 use FS::UID qw( getotaker dbh );
23 use FS::Record qw( qsearchs qsearch dbdef );
24 use FS::Misc qw( send_email );
25 use FS::Msgcat qw(gettext);
29 use FS::cust_bill_pkg;
31 use FS::cust_pay_void;
34 use FS::part_referral;
35 use FS::cust_main_county;
37 use FS::cust_main_invoice;
38 use FS::cust_credit_bill;
39 use FS::cust_bill_pay;
40 use FS::prepay_credit;
43 use FS::part_bill_event;
44 use FS::cust_bill_event;
45 use FS::cust_tax_exempt;
47 use FS::payment_gateway;
48 use FS::agent_payment_gateway;
51 @ISA = qw( FS::Record );
53 @EXPORT_OK = qw( smart_search );
55 $realtime_bop_decline_quiet = 0;
57 # 1 is mostly method/subroutine entry and options
58 # 2 traces progress of some operations
59 # 3 is even more information including possibly sensitive data
61 $me = '[FS::cust_main]';
65 $ignore_expired_card = 0;
67 @encrypted_fields = ('payinfo', 'paycvv');
69 #ask FS::UID to run this stuff for us later
70 #$FS::UID::callback{'FS::cust_main'} = sub {
71 install_callback FS::UID sub {
73 #yes, need it for stuff below (prolly should be cached)
78 my ( $hashref, $cache ) = @_;
79 if ( exists $hashref->{'pkgnum'} ) {
80 # #@{ $self->{'_pkgnum'} } = ();
81 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
82 $self->{'_pkgnum'} = $subcache;
83 #push @{ $self->{'_pkgnum'} },
84 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
90 FS::cust_main - Object methods for cust_main records
96 $record = new FS::cust_main \%hash;
97 $record = new FS::cust_main { 'column' => 'value' };
99 $error = $record->insert;
101 $error = $new_record->replace($old_record);
103 $error = $record->delete;
105 $error = $record->check;
107 @cust_pkg = $record->all_pkgs;
109 @cust_pkg = $record->ncancelled_pkgs;
111 @cust_pkg = $record->suspended_pkgs;
113 $error = $record->bill;
114 $error = $record->bill %options;
115 $error = $record->bill 'time' => $time;
117 $error = $record->collect;
118 $error = $record->collect %options;
119 $error = $record->collect 'invoice_time' => $time,
120 'batch_card' => 'yes',
121 'report_badcard' => 'yes',
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
295 Creates a new customer. To add the customer to the database, see L<"insert">.
297 Note that this stores the hash reference, not a distinct copy of the hash it
298 points to. You can ask the object for a copy with the I<hash> method.
302 sub table { 'cust_main'; }
304 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
306 Adds this customer to the database. If there is an error, returns the error,
307 otherwise returns false.
309 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
310 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
311 are inserted atomicly, or the transaction is rolled back. Passing an empty
312 hash reference is equivalent to not supplying this parameter. There should be
313 a better explanation of this, but until then, here's an example:
316 tie %hash, 'Tie::RefHash'; #this part is important
318 $cust_pkg => [ $svc_acct ],
321 $cust_main->insert( \%hash );
323 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
324 be set as the invoicing list (see L<"invoicing_list">). Errors return as
325 expected and rollback the entire transaction; it is not necessary to call
326 check_invoicing_list first. The invoicing_list is set after the records in the
327 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
328 invoicing_list destination to the newly-created svc_acct. Here's an example:
330 $cust_main->insert( {}, [ $email, 'POST' ] );
332 Currently available options are: I<depend_jobnum> and I<noexport>.
334 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
335 on the supplied jobnum (they will not run until the specific job completes).
336 This can be used to defer provisioning until some action completes (such
337 as running the customer's credit card sucessfully).
339 The I<noexport> option is deprecated. If I<noexport> is set true, no
340 provisioning jobs (exports) are scheduled. (You can schedule them later with
341 the B<reexport> method.)
347 my $cust_pkgs = @_ ? shift : {};
348 my $invoicing_list = @_ ? shift : '';
350 warn "$me insert called with options ".
351 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
354 local $SIG{HUP} = 'IGNORE';
355 local $SIG{INT} = 'IGNORE';
356 local $SIG{QUIT} = 'IGNORE';
357 local $SIG{TERM} = 'IGNORE';
358 local $SIG{TSTP} = 'IGNORE';
359 local $SIG{PIPE} = 'IGNORE';
361 my $oldAutoCommit = $FS::UID::AutoCommit;
362 local $FS::UID::AutoCommit = 0;
365 my $prepay_identifier = '';
366 my( $amount, $seconds ) = ( 0, 0 );
368 if ( $self->payby eq 'PREPAY' ) {
370 $self->payby('BILL');
371 $prepay_identifier = $self->payinfo;
374 warn " looking up prepaid card $prepay_identifier\n"
377 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
379 $dbh->rollback if $oldAutoCommit;
380 #return "error applying prepaid card (transaction rolled back): $error";
384 $payby = 'PREP' if $amount;
386 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
389 $self->payby('BILL');
390 $amount = $self->paid;
394 warn " inserting $self\n"
397 my $error = $self->SUPER::insert;
399 $dbh->rollback if $oldAutoCommit;
400 #return "inserting cust_main record (transaction rolled back): $error";
404 warn " setting invoicing list\n"
407 if ( $invoicing_list ) {
408 $error = $self->check_invoicing_list( $invoicing_list );
410 $dbh->rollback if $oldAutoCommit;
411 return "checking invoicing_list (transaction rolled back): $error";
413 $self->invoicing_list( $invoicing_list );
416 warn " ordering packages\n"
419 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
421 $dbh->rollback if $oldAutoCommit;
426 $dbh->rollback if $oldAutoCommit;
427 return "No svc_acct record to apply pre-paid time";
431 warn " inserting initial $payby payment of $amount\n"
433 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
435 $dbh->rollback if $oldAutoCommit;
436 return "inserting payment (transaction rolled back): $error";
440 unless ( $import || $skip_fuzzyfiles ) {
441 warn " queueing fuzzyfiles update\n"
443 $error = $self->queue_fuzzyfiles_update;
445 $dbh->rollback if $oldAutoCommit;
446 return "updating fuzzy search cache: $error";
450 warn " insert complete; committing transaction\n"
453 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
458 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
460 Like the insert method on an existing record, this method orders a package
461 and included services atomicaly. Pass a Tie::RefHash data structure to this
462 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
463 be a better explanation of this, but until then, here's an example:
466 tie %hash, 'Tie::RefHash'; #this part is important
468 $cust_pkg => [ $svc_acct ],
471 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
473 Services can be new, in which case they are inserted, or existing unaudited
474 services, in which case they are linked to the newly-created package.
476 Currently available options are: I<depend_jobnum> and I<noexport>.
478 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
479 on the supplied jobnum (they will not run until the specific job completes).
480 This can be used to defer provisioning until some action completes (such
481 as running the customer's credit card sucessfully).
483 The I<noexport> option is deprecated. If I<noexport> is set true, no
484 provisioning jobs (exports) are scheduled. (You can schedule them later with
485 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
486 on the cust_main object is not recommended, as existing services will also be
493 my $cust_pkgs = shift;
496 my %svc_options = ();
497 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
498 if exists $options{'depend_jobnum'};
499 warn "$me order_pkgs called with options ".
500 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
503 local $SIG{HUP} = 'IGNORE';
504 local $SIG{INT} = 'IGNORE';
505 local $SIG{QUIT} = 'IGNORE';
506 local $SIG{TERM} = 'IGNORE';
507 local $SIG{TSTP} = 'IGNORE';
508 local $SIG{PIPE} = 'IGNORE';
510 my $oldAutoCommit = $FS::UID::AutoCommit;
511 local $FS::UID::AutoCommit = 0;
514 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
516 foreach my $cust_pkg ( keys %$cust_pkgs ) {
517 $cust_pkg->custnum( $self->custnum );
518 my $error = $cust_pkg->insert;
520 $dbh->rollback if $oldAutoCommit;
521 return "inserting cust_pkg (transaction rolled back): $error";
523 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
524 if ( $svc_something->svcnum ) {
525 my $old_cust_svc = $svc_something->cust_svc;
526 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
527 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
528 $error = $new_cust_svc->replace($old_cust_svc);
530 $svc_something->pkgnum( $cust_pkg->pkgnum );
531 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
532 $svc_something->seconds( $svc_something->seconds + $$seconds );
535 $error = $svc_something->insert(%svc_options);
538 $dbh->rollback if $oldAutoCommit;
539 #return "inserting svc_ (transaction rolled back): $error";
545 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
549 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
551 Recharges this (existing) customer with the specified prepaid card (see
552 L<FS::prepay_credit>), specified either by I<identifier> or as an
553 FS::prepay_credit object. If there is an error, returns the error, otherwise
556 Optionally, two scalar references can be passed as well. They will have their
557 values filled in with the amount and number of seconds applied by this prepaid
562 sub recharge_prepay {
563 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
565 local $SIG{HUP} = 'IGNORE';
566 local $SIG{INT} = 'IGNORE';
567 local $SIG{QUIT} = 'IGNORE';
568 local $SIG{TERM} = 'IGNORE';
569 local $SIG{TSTP} = 'IGNORE';
570 local $SIG{PIPE} = 'IGNORE';
572 my $oldAutoCommit = $FS::UID::AutoCommit;
573 local $FS::UID::AutoCommit = 0;
576 my( $amount, $seconds ) = ( 0, 0 );
578 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
579 || $self->increment_seconds($seconds)
580 || $self->insert_cust_pay_prepay( $amount,
582 ? $prepay_credit->identifier
587 $dbh->rollback if $oldAutoCommit;
591 if ( defined($amountref) ) { $$amountref = $amount; }
592 if ( defined($secondsref) ) { $$secondsref = $seconds; }
594 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
599 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
601 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
602 specified either by I<identifier> or as an FS::prepay_credit object.
604 References to I<amount> and I<seconds> scalars should be passed as arguments
605 and will be incremented by the values of the prepaid card.
607 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
608 check or set this customer's I<agentnum>.
610 If there is an error, returns the error, otherwise returns false.
616 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
618 local $SIG{HUP} = 'IGNORE';
619 local $SIG{INT} = 'IGNORE';
620 local $SIG{QUIT} = 'IGNORE';
621 local $SIG{TERM} = 'IGNORE';
622 local $SIG{TSTP} = 'IGNORE';
623 local $SIG{PIPE} = 'IGNORE';
625 my $oldAutoCommit = $FS::UID::AutoCommit;
626 local $FS::UID::AutoCommit = 0;
629 unless ( ref($prepay_credit) ) {
631 my $identifier = $prepay_credit;
633 $prepay_credit = qsearchs(
635 { 'identifier' => $prepay_credit },
640 unless ( $prepay_credit ) {
641 $dbh->rollback if $oldAutoCommit;
642 return "Invalid prepaid card: ". $identifier;
647 if ( $prepay_credit->agentnum ) {
648 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
649 $dbh->rollback if $oldAutoCommit;
650 return "prepaid card not valid for agent ". $self->agentnum;
652 $self->agentnum($prepay_credit->agentnum);
655 my $error = $prepay_credit->delete;
657 $dbh->rollback if $oldAutoCommit;
658 return "removing prepay_credit (transaction rolled back): $error";
661 $$amountref += $prepay_credit->amount;
662 $$secondsref += $prepay_credit->seconds;
664 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
669 =item increment_seconds SECONDS
671 Updates this customer's single or primary account (see L<FS::svc_acct>) by
672 the specified number of seconds. If there is an error, returns the error,
673 otherwise returns false.
677 sub increment_seconds {
678 my( $self, $seconds ) = @_;
679 warn "$me increment_seconds called: $seconds seconds\n"
682 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
683 $self->ncancelled_pkgs;
686 return 'No packages with primary or single services found'.
687 ' to apply pre-paid time';
688 } elsif ( scalar(@cust_pkg) > 1 ) {
689 #maybe have a way to specify the package/account?
690 return 'Multiple packages found to apply pre-paid time';
693 my $cust_pkg = $cust_pkg[0];
694 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
698 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
701 return 'No account found to apply pre-paid time';
702 } elsif ( scalar(@cust_svc) > 1 ) {
703 return 'Multiple accounts found to apply pre-paid time';
706 my $svc_acct = $cust_svc[0]->svc_x;
707 warn " found service svcnum ". $svc_acct->pkgnum.
708 ' ('. $svc_acct->email. ")\n"
711 $svc_acct->increment_seconds($seconds);
715 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
717 Inserts a prepayment in the specified amount for this customer. An optional
718 second argument can specify the prepayment identifier for tracking purposes.
719 If there is an error, returns the error, otherwise returns false.
723 sub insert_cust_pay_prepay {
724 shift->insert_cust_pay('PREP', @_);
727 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
729 Inserts a cash payment in the specified amount for this customer. An optional
730 second argument can specify the payment identifier for tracking purposes.
731 If there is an error, returns the error, otherwise returns false.
735 sub insert_cust_pay_cash {
736 shift->insert_cust_pay('CASH', @_);
739 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
741 Inserts a Western Union payment in the specified amount for this customer. An
742 optional second argument can specify the prepayment identifier for tracking
743 purposes. If there is an error, returns the error, otherwise returns false.
747 sub insert_cust_pay_west {
748 shift->insert_cust_pay('WEST', @_);
751 sub insert_cust_pay {
752 my( $self, $payby, $amount ) = splice(@_, 0, 3);
753 my $payinfo = scalar(@_) ? shift : '';
755 my $cust_pay = new FS::cust_pay {
756 'custnum' => $self->custnum,
757 'paid' => sprintf('%.2f', $amount),
758 #'_date' => #date the prepaid card was purchased???
760 'payinfo' => $payinfo,
768 This method is deprecated. See the I<depend_jobnum> option to the insert and
769 order_pkgs methods for a better way to defer provisioning.
771 Re-schedules all exports by calling the B<reexport> method of all associated
772 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
773 otherwise returns false.
780 carp "WARNING: FS::cust_main::reexport is deprectated; ".
781 "use the depend_jobnum option to insert or order_pkgs to delay export";
783 local $SIG{HUP} = 'IGNORE';
784 local $SIG{INT} = 'IGNORE';
785 local $SIG{QUIT} = 'IGNORE';
786 local $SIG{TERM} = 'IGNORE';
787 local $SIG{TSTP} = 'IGNORE';
788 local $SIG{PIPE} = 'IGNORE';
790 my $oldAutoCommit = $FS::UID::AutoCommit;
791 local $FS::UID::AutoCommit = 0;
794 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
795 my $error = $cust_pkg->reexport;
797 $dbh->rollback if $oldAutoCommit;
802 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
807 =item delete NEW_CUSTNUM
809 This deletes the customer. If there is an error, returns the error, otherwise
812 This will completely remove all traces of the customer record. This is not
813 what you want when a customer cancels service; for that, cancel all of the
814 customer's packages (see L</cancel>).
816 If the customer has any uncancelled packages, you need to pass a new (valid)
817 customer number for those packages to be transferred to. Cancelled packages
818 will be deleted. Did I mention that this is NOT what you want when a customer
819 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
821 You can't delete a customer with invoices (see L<FS::cust_bill>),
822 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
823 refunds (see L<FS::cust_refund>).
830 local $SIG{HUP} = 'IGNORE';
831 local $SIG{INT} = 'IGNORE';
832 local $SIG{QUIT} = 'IGNORE';
833 local $SIG{TERM} = 'IGNORE';
834 local $SIG{TSTP} = 'IGNORE';
835 local $SIG{PIPE} = 'IGNORE';
837 my $oldAutoCommit = $FS::UID::AutoCommit;
838 local $FS::UID::AutoCommit = 0;
841 if ( $self->cust_bill ) {
842 $dbh->rollback if $oldAutoCommit;
843 return "Can't delete a customer with invoices";
845 if ( $self->cust_credit ) {
846 $dbh->rollback if $oldAutoCommit;
847 return "Can't delete a customer with credits";
849 if ( $self->cust_pay ) {
850 $dbh->rollback if $oldAutoCommit;
851 return "Can't delete a customer with payments";
853 if ( $self->cust_refund ) {
854 $dbh->rollback if $oldAutoCommit;
855 return "Can't delete a customer with refunds";
858 my @cust_pkg = $self->ncancelled_pkgs;
860 my $new_custnum = shift;
861 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
862 $dbh->rollback if $oldAutoCommit;
863 return "Invalid new customer number: $new_custnum";
865 foreach my $cust_pkg ( @cust_pkg ) {
866 my %hash = $cust_pkg->hash;
867 $hash{'custnum'} = $new_custnum;
868 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
869 my $error = $new_cust_pkg->replace($cust_pkg);
871 $dbh->rollback if $oldAutoCommit;
876 my @cancelled_cust_pkg = $self->all_pkgs;
877 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
878 my $error = $cust_pkg->delete;
880 $dbh->rollback if $oldAutoCommit;
885 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
886 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
888 my $error = $cust_main_invoice->delete;
890 $dbh->rollback if $oldAutoCommit;
895 my $error = $self->SUPER::delete;
897 $dbh->rollback if $oldAutoCommit;
901 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
908 Replaces the OLD_RECORD with this one in the database. If there is an error,
909 returns the error, otherwise returns false.
911 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
912 be set as the invoicing list (see L<"invoicing_list">). Errors return as
913 expected and rollback the entire transaction; it is not necessary to call
914 check_invoicing_list first. Here's an example:
916 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
925 local $SIG{HUP} = 'IGNORE';
926 local $SIG{INT} = 'IGNORE';
927 local $SIG{QUIT} = 'IGNORE';
928 local $SIG{TERM} = 'IGNORE';
929 local $SIG{TSTP} = 'IGNORE';
930 local $SIG{PIPE} = 'IGNORE';
932 # If the mask is blank then try to set it - if we can...
933 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
934 $self->paymask($self->payinfo);
937 # We absolutely have to have an old vs. new record to make this work.
938 if (!defined($old)) {
939 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
942 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
943 && $conf->config('users-allow_comp') ) {
944 return "You are not permitted to create complimentary accounts."
945 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
948 local($ignore_expired_card) = 1
949 if $old->payby =~ /^(CARD|DCRD)$/
950 && $self->payby =~ /^(CARD|DCRD)$/
951 && $old->payinfo eq $self->payinfo;
953 my $oldAutoCommit = $FS::UID::AutoCommit;
954 local $FS::UID::AutoCommit = 0;
957 my $error = $self->SUPER::replace($old);
960 $dbh->rollback if $oldAutoCommit;
964 if ( @param ) { # INVOICING_LIST_ARYREF
965 my $invoicing_list = shift @param;
966 $error = $self->check_invoicing_list( $invoicing_list );
968 $dbh->rollback if $oldAutoCommit;
971 $self->invoicing_list( $invoicing_list );
974 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
975 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
976 # card/check/lec info has changed, want to retry realtime_ invoice events
977 my $error = $self->retry_realtime;
979 $dbh->rollback if $oldAutoCommit;
984 unless ( $import || $skip_fuzzyfiles ) {
985 $error = $self->queue_fuzzyfiles_update;
987 $dbh->rollback if $oldAutoCommit;
988 return "updating fuzzy search cache: $error";
992 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
997 =item queue_fuzzyfiles_update
999 Used by insert & replace to update the fuzzy search cache
1003 sub queue_fuzzyfiles_update {
1006 local $SIG{HUP} = 'IGNORE';
1007 local $SIG{INT} = 'IGNORE';
1008 local $SIG{QUIT} = 'IGNORE';
1009 local $SIG{TERM} = 'IGNORE';
1010 local $SIG{TSTP} = 'IGNORE';
1011 local $SIG{PIPE} = 'IGNORE';
1013 my $oldAutoCommit = $FS::UID::AutoCommit;
1014 local $FS::UID::AutoCommit = 0;
1017 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1018 my $error = $queue->insert($self->getfield('last'), $self->company);
1020 $dbh->rollback if $oldAutoCommit;
1021 return "queueing job (transaction rolled back): $error";
1024 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1025 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1026 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1028 $dbh->rollback if $oldAutoCommit;
1029 return "queueing job (transaction rolled back): $error";
1033 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1040 Checks all fields to make sure this is a valid customer record. If there is
1041 an error, returns the error, otherwise returns false. Called by the insert
1042 and replace methods.
1049 warn "$me check BEFORE: \n". $self->_dump
1053 $self->ut_numbern('custnum')
1054 || $self->ut_number('agentnum')
1055 || $self->ut_number('refnum')
1056 || $self->ut_name('last')
1057 || $self->ut_name('first')
1058 || $self->ut_textn('company')
1059 || $self->ut_text('address1')
1060 || $self->ut_textn('address2')
1061 || $self->ut_text('city')
1062 || $self->ut_textn('county')
1063 || $self->ut_textn('state')
1064 || $self->ut_country('country')
1065 || $self->ut_anything('comments')
1066 || $self->ut_numbern('referral_custnum')
1068 #barf. need message catalogs. i18n. etc.
1069 $error .= "Please select an advertising source."
1070 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1071 return $error if $error;
1073 return "Unknown agent"
1074 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1076 return "Unknown refnum"
1077 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1079 return "Unknown referring custnum: ". $self->referral_custnum
1080 unless ! $self->referral_custnum
1081 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1083 if ( $self->ss eq '' ) {
1088 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1089 or return "Illegal social security number: ". $self->ss;
1090 $self->ss("$1-$2-$3");
1094 # bad idea to disable, causes billing to fail because of no tax rates later
1095 # unless ( $import ) {
1096 unless ( qsearch('cust_main_county', {
1097 'country' => $self->country,
1100 return "Unknown state/county/country: ".
1101 $self->state. "/". $self->county. "/". $self->country
1102 unless qsearch('cust_main_county',{
1103 'state' => $self->state,
1104 'county' => $self->county,
1105 'country' => $self->country,
1111 $self->ut_phonen('daytime', $self->country)
1112 || $self->ut_phonen('night', $self->country)
1113 || $self->ut_phonen('fax', $self->country)
1114 || $self->ut_zip('zip', $self->country)
1116 return $error if $error;
1119 last first company address1 address2 city county state zip
1120 country daytime night fax
1123 if ( defined $self->dbdef_table->column('ship_last') ) {
1124 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1126 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1130 $self->ut_name('ship_last')
1131 || $self->ut_name('ship_first')
1132 || $self->ut_textn('ship_company')
1133 || $self->ut_text('ship_address1')
1134 || $self->ut_textn('ship_address2')
1135 || $self->ut_text('ship_city')
1136 || $self->ut_textn('ship_county')
1137 || $self->ut_textn('ship_state')
1138 || $self->ut_country('ship_country')
1140 return $error if $error;
1142 #false laziness with above
1143 unless ( qsearchs('cust_main_county', {
1144 'country' => $self->ship_country,
1147 return "Unknown ship_state/ship_county/ship_country: ".
1148 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1149 unless qsearch('cust_main_county',{
1150 'state' => $self->ship_state,
1151 'county' => $self->ship_county,
1152 'country' => $self->ship_country,
1158 $self->ut_phonen('ship_daytime', $self->ship_country)
1159 || $self->ut_phonen('ship_night', $self->ship_country)
1160 || $self->ut_phonen('ship_fax', $self->ship_country)
1161 || $self->ut_zip('ship_zip', $self->ship_country)
1163 return $error if $error;
1165 } else { # ship_ info eq billing info, so don't store dup info in database
1166 $self->setfield("ship_$_", '')
1167 foreach qw( last first company address1 address2 city county state zip
1168 country daytime night fax );
1172 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1173 or return "Illegal payby: ". $self->payby;
1175 $error = $self->ut_numbern('paystart_month')
1176 || $self->ut_numbern('paystart_year')
1177 || $self->ut_numbern('payissue')
1179 return $error if $error;
1181 if ( $self->payip eq '' ) {
1184 $error = $self->ut_ip('payip');
1185 return $error if $error;
1188 # If it is encrypted and the private key is not availaible then we can't
1189 # check the credit card.
1191 my $check_payinfo = 1;
1193 if ($self->is_encrypted($self->payinfo)) {
1199 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1201 my $payinfo = $self->payinfo;
1202 $payinfo =~ s/\D//g;
1203 $payinfo =~ /^(\d{13,16})$/
1204 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1206 $self->payinfo($payinfo);
1208 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1210 return gettext('unknown_card_type')
1211 if cardtype($self->payinfo) eq "Unknown";
1213 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1214 return "Banned credit card" if $ban;
1216 if ( defined $self->dbdef_table->column('paycvv') ) {
1217 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1218 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1219 $self->paycvv =~ /^(\d{4})$/
1220 or return "CVV2 (CID) for American Express cards is four digits.";
1223 $self->paycvv =~ /^(\d{3})$/
1224 or return "CVV2 (CVC2/CID) is three digits.";
1232 my $cardtype = cardtype($payinfo);
1233 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1235 return "Start date or issue number is required for $cardtype cards"
1236 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1238 return "Start month must be between 1 and 12"
1239 if $self->paystart_month
1240 and $self->paystart_month < 1 || $self->paystart_month > 12;
1242 return "Start year must be 1990 or later"
1243 if $self->paystart_year
1244 and $self->paystart_year < 1990;
1246 return "Issue number must be beween 1 and 99"
1248 and $self->payissue < 1 || $self->payissue > 99;
1251 $self->paystart_month('');
1252 $self->paystart_year('');
1253 $self->payissue('');
1256 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1258 my $payinfo = $self->payinfo;
1259 $payinfo =~ s/[^\d\@]//g;
1260 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1261 $payinfo = "$1\@$2";
1262 $self->payinfo($payinfo);
1263 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1265 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1266 return "Banned ACH account" if $ban;
1268 } elsif ( $self->payby eq 'LECB' ) {
1270 my $payinfo = $self->payinfo;
1271 $payinfo =~ s/\D//g;
1272 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1274 $self->payinfo($payinfo);
1275 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1277 } elsif ( $self->payby eq 'BILL' ) {
1279 $error = $self->ut_textn('payinfo');
1280 return "Illegal P.O. number: ". $self->payinfo if $error;
1281 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1283 } elsif ( $self->payby eq 'COMP' ) {
1285 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1286 return "You are not permitted to create complimentary accounts."
1287 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1290 $error = $self->ut_textn('payinfo');
1291 return "Illegal comp account issuer: ". $self->payinfo if $error;
1292 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1294 } elsif ( $self->payby eq 'PREPAY' ) {
1296 my $payinfo = $self->payinfo;
1297 $payinfo =~ s/\W//g; #anything else would just confuse things
1298 $self->payinfo($payinfo);
1299 $error = $self->ut_alpha('payinfo');
1300 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1301 return "Unknown prepayment identifier"
1302 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1303 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1307 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1308 return "Expriation date required"
1309 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1313 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1314 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1315 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1316 ( $m, $y ) = ( $3, "20$2" );
1318 return "Illegal expiration date: ". $self->paydate;
1320 $self->paydate("$y-$m-01");
1321 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1322 return gettext('expired_card')
1324 && !$ignore_expired_card
1325 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1328 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1329 ( ! $conf->exists('require_cardname')
1330 || $self->payby !~ /^(CARD|DCRD)$/ )
1332 $self->payname( $self->first. " ". $self->getfield('last') );
1334 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1335 or return gettext('illegal_name'). " payname: ". $self->payname;
1339 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1342 $self->otaker(getotaker) unless $self->otaker;
1344 warn "$me check AFTER: \n". $self->_dump
1347 $self->SUPER::check;
1352 Returns all packages (see L<FS::cust_pkg>) for this customer.
1358 if ( $self->{'_pkgnum'} ) {
1359 values %{ $self->{'_pkgnum'}->cache };
1361 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1365 =item ncancelled_pkgs
1367 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1371 sub ncancelled_pkgs {
1373 if ( $self->{'_pkgnum'} ) {
1374 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1376 @{ [ # force list context
1377 qsearch( 'cust_pkg', {
1378 'custnum' => $self->custnum,
1381 qsearch( 'cust_pkg', {
1382 'custnum' => $self->custnum,
1389 =item suspended_pkgs
1391 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1395 sub suspended_pkgs {
1397 grep { $_->susp } $self->ncancelled_pkgs;
1400 =item unflagged_suspended_pkgs
1402 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1403 customer (thouse packages without the `manual_flag' set).
1407 sub unflagged_suspended_pkgs {
1409 return $self->suspended_pkgs
1410 unless dbdef->table('cust_pkg')->column('manual_flag');
1411 grep { ! $_->manual_flag } $self->suspended_pkgs;
1414 =item unsuspended_pkgs
1416 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1421 sub unsuspended_pkgs {
1423 grep { ! $_->susp } $self->ncancelled_pkgs;
1426 =item num_cancelled_pkgs
1428 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1433 sub num_cancelled_pkgs {
1435 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1439 my( $self, $sql ) = @_;
1440 my $sth = dbh->prepare(
1441 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1442 ) or die dbh->errstr;
1443 $sth->execute($self->custnum) or die $sth->errstr;
1444 $sth->fetchrow_arrayref->[0];
1449 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1450 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1451 on success or a list of errors.
1457 grep { $_->unsuspend } $self->suspended_pkgs;
1462 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1463 Always returns a list: an empty list on success or a list of errors.
1469 grep { $_->suspend } $self->unsuspended_pkgs;
1472 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1474 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1475 PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
1476 success or a list of errors.
1480 sub suspend_if_pkgpart {
1483 grep { $_->suspend }
1484 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1485 $self->unsuspended_pkgs;
1488 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1490 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1491 listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
1492 on success or a list of errors.
1496 sub suspend_unless_pkgpart {
1499 grep { $_->suspend }
1500 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1501 $self->unsuspended_pkgs;
1504 =item cancel [ OPTION => VALUE ... ]
1506 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1508 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1510 I<quiet> can be set true to supress email cancellation notices.
1512 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1514 I<ban> can be set true to ban this customer's credit card or ACH information,
1517 Always returns a list: an empty list on success or a list of errors.
1525 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1527 #should try decryption (we might have the private key)
1528 # and if not maybe queue a job for the server that does?
1529 return ( "Can't (yet) ban encrypted credit cards" )
1530 if $self->is_encrypted($self->payinfo);
1532 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1533 my $error = $ban->insert;
1534 return ( $error ) if $error;
1538 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1541 sub _banned_pay_hashref {
1552 'payby' => $payby2ban{$self->payby},
1553 'payinfo' => md5_base64($self->payinfo),
1560 Returns the agent (see L<FS::agent>) for this customer.
1566 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1571 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1572 conjunction with the collect method.
1574 Options are passed as name-value pairs.
1576 Currently available options are:
1578 resetup - if set true, re-charges setup fees.
1580 time - bills the customer as if it were that time. Specified as a UNIX
1581 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1582 L<Date::Parse> for conversion functions. For example:
1586 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1589 If there is an error, returns the error, otherwise returns false.
1594 my( $self, %options ) = @_;
1595 return '' if $self->payby eq 'COMP';
1596 warn "$me bill customer ". $self->custnum. "\n"
1599 my $time = $options{'time'} || time;
1604 local $SIG{HUP} = 'IGNORE';
1605 local $SIG{INT} = 'IGNORE';
1606 local $SIG{QUIT} = 'IGNORE';
1607 local $SIG{TERM} = 'IGNORE';
1608 local $SIG{TSTP} = 'IGNORE';
1609 local $SIG{PIPE} = 'IGNORE';
1611 my $oldAutoCommit = $FS::UID::AutoCommit;
1612 local $FS::UID::AutoCommit = 0;
1615 $self->select_for_update; #mutex
1617 # find the packages which are due for billing, find out how much they are
1618 # & generate invoice database.
1620 my( $total_setup, $total_recur ) = ( 0, 0 );
1621 #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1622 my @cust_bill_pkg = ();
1624 #my $taxable_charged = 0;##
1629 foreach my $cust_pkg (
1630 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1633 #NO!! next if $cust_pkg->cancel;
1634 next if $cust_pkg->getfield('cancel');
1636 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1638 #? to avoid use of uninitialized value errors... ?
1639 $cust_pkg->setfield('bill', '')
1640 unless defined($cust_pkg->bill);
1642 my $part_pkg = $cust_pkg->part_pkg;
1644 my %hash = $cust_pkg->hash;
1645 my $old_cust_pkg = new FS::cust_pkg \%hash;
1651 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1653 warn " bill setup\n" if $DEBUG > 1;
1655 $setup = eval { $cust_pkg->calc_setup( $time ) };
1657 $dbh->rollback if $oldAutoCommit;
1661 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1667 if ( $part_pkg->getfield('freq') ne '0' &&
1668 ! $cust_pkg->getfield('susp') &&
1669 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1672 warn " bill recur\n" if $DEBUG > 1;
1674 # XXX shared with $recur_prog
1675 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1677 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1679 $dbh->rollback if $oldAutoCommit;
1683 #change this bit to use Date::Manip? CAREFUL with timezones (see
1684 # mailing list archive)
1685 my ($sec,$min,$hour,$mday,$mon,$year) =
1686 (localtime($sdate) )[0,1,2,3,4,5];
1688 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1689 # only for figuring next bill date, nothing else, so, reset $sdate again
1691 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1692 $cust_pkg->last_bill($sdate)
1693 if $cust_pkg->dbdef_table->column('last_bill');
1695 if ( $part_pkg->freq =~ /^\d+$/ ) {
1696 $mon += $part_pkg->freq;
1697 until ( $mon < 12 ) { $mon -= 12; $year++; }
1698 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1700 $mday += $weeks * 7;
1701 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1704 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1708 $dbh->rollback if $oldAutoCommit;
1709 return "unparsable frequency: ". $part_pkg->freq;
1711 $cust_pkg->setfield('bill',
1712 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1715 warn "\$setup is undefined" unless defined($setup);
1716 warn "\$recur is undefined" unless defined($recur);
1717 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1719 if ( $cust_pkg->modified ) {
1721 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1724 $error=$cust_pkg->replace($old_cust_pkg);
1725 if ( $error ) { #just in case
1726 $dbh->rollback if $oldAutoCommit;
1727 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1730 $setup = sprintf( "%.2f", $setup );
1731 $recur = sprintf( "%.2f", $recur );
1732 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1733 $dbh->rollback if $oldAutoCommit;
1734 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1736 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1737 $dbh->rollback if $oldAutoCommit;
1738 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1740 if ( $setup != 0 || $recur != 0 ) {
1741 warn " charges (setup=$setup, recur=$recur); queueing line items\n"
1743 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1744 'pkgnum' => $cust_pkg->pkgnum,
1748 'edate' => $cust_pkg->bill,
1749 'details' => \@details,
1751 push @cust_bill_pkg, $cust_bill_pkg;
1752 $total_setup += $setup;
1753 $total_recur += $recur;
1755 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1757 my @taxes = qsearch( 'cust_main_county', {
1758 'state' => $self->state,
1759 'county' => $self->county,
1760 'country' => $self->country,
1761 'taxclass' => $part_pkg->taxclass,
1764 @taxes = qsearch( 'cust_main_county', {
1765 'state' => $self->state,
1766 'county' => $self->county,
1767 'country' => $self->country,
1772 #one more try at a whole-country tax rate
1774 @taxes = qsearch( 'cust_main_county', {
1777 'country' => $self->country,
1782 # maybe eliminate this entirely, along with all the 0% records
1784 $dbh->rollback if $oldAutoCommit;
1786 "fatal: can't find tax rate for state/county/country/taxclass ".
1787 join('/', ( map $self->$_(), qw(state county country) ),
1788 $part_pkg->taxclass ). "\n";
1791 foreach my $tax ( @taxes ) {
1793 my $taxable_charged = 0;
1794 $taxable_charged += $setup
1795 unless $part_pkg->setuptax =~ /^Y$/i
1796 || $tax->setuptax =~ /^Y$/i;
1797 $taxable_charged += $recur
1798 unless $part_pkg->recurtax =~ /^Y$/i
1799 || $tax->recurtax =~ /^Y$/i;
1800 next unless $taxable_charged;
1802 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1803 my ($mon,$year) = (localtime($sdate) )[4,5];
1805 my $freq = $part_pkg->freq || 1;
1806 if ( $freq !~ /(\d+)$/ ) {
1807 $dbh->rollback if $oldAutoCommit;
1808 return "daily/weekly package definitions not (yet?)".
1809 " compatible with monthly tax exemptions";
1811 my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1812 foreach my $which_month ( 1 .. $freq ) {
1814 'custnum' => $self->custnum,
1815 'taxnum' => $tax->taxnum,
1816 'year' => 1900+$year,
1819 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1820 until ( $mon < 13 ) { $mon -= 12; $year++; }
1821 my $cust_tax_exempt =
1822 qsearchs('cust_tax_exempt', \%hash)
1823 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1824 my $remaining_exemption = sprintf("%.2f",
1825 $tax->exempt_amount - $cust_tax_exempt->amount );
1826 if ( $remaining_exemption > 0 ) {
1827 my $addl = $remaining_exemption > $taxable_per_month
1828 ? $taxable_per_month
1829 : $remaining_exemption;
1830 $taxable_charged -= $addl;
1831 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1832 $cust_tax_exempt->hash,
1834 sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1836 $error = $new_cust_tax_exempt->exemptnum
1837 ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1838 : $new_cust_tax_exempt->insert;
1840 $dbh->rollback if $oldAutoCommit;
1841 return "fatal: can't update cust_tax_exempt: $error";
1844 } # if $remaining_exemption > 0
1846 } #foreach $which_month
1848 } #if $tax->exempt_amount
1850 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1852 #$tax += $taxable_charged * $cust_main_county->tax / 100
1853 $tax{ $tax->taxname || 'Tax' } +=
1854 $taxable_charged * $tax->tax / 100
1856 } #foreach my $tax ( @taxes )
1858 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1860 } #if $setup != 0 || $recur != 0
1862 } #if $cust_pkg->modified
1864 } #foreach my $cust_pkg
1866 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1867 # my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1869 unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1870 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1874 # unless ( $self->tax =~ /Y/i
1875 # || $self->payby eq 'COMP'
1876 # || $taxable_charged == 0 ) {
1877 # my $cust_main_county = qsearchs('cust_main_county',{
1878 # 'state' => $self->state,
1879 # 'county' => $self->county,
1880 # 'country' => $self->country,
1881 # } ) or die "fatal: can't find tax rate for state/county/country ".
1882 # $self->state. "/". $self->county. "/". $self->country. "\n";
1883 # my $tax = sprintf( "%.2f",
1884 # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1887 if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1889 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1890 my $tax = sprintf("%.2f", $tax{$taxname} );
1891 $charged = sprintf( "%.2f", $charged+$tax );
1893 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1899 'itemdesc' => $taxname,
1901 push @cust_bill_pkg, $cust_bill_pkg;
1904 } else { #1.4 schema
1907 foreach ( values %tax ) { $tax += $_ };
1908 $tax = sprintf("%.2f", $tax);
1910 $charged = sprintf( "%.2f", $charged+$tax );
1912 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1919 push @cust_bill_pkg, $cust_bill_pkg;
1924 my $cust_bill = new FS::cust_bill ( {
1925 'custnum' => $self->custnum,
1927 'charged' => $charged,
1929 $error = $cust_bill->insert;
1931 $dbh->rollback if $oldAutoCommit;
1932 return "can't create invoice for customer #". $self->custnum. ": $error";
1935 my $invnum = $cust_bill->invnum;
1937 foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1939 $cust_bill_pkg->invnum($invnum);
1940 $error = $cust_bill_pkg->insert;
1942 $dbh->rollback if $oldAutoCommit;
1943 return "can't create invoice line item for customer #". $self->custnum.
1948 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1952 =item collect OPTIONS
1954 (Attempt to) collect money for this customer's outstanding invoices (see
1955 L<FS::cust_bill>). Usually used after the bill method.
1957 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1958 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1959 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1961 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1962 and the invoice events web interface.
1964 If there is an error, returns the error, otherwise returns false.
1966 Options are passed as name-value pairs.
1968 Currently available options are:
1970 invoice_time - Use this time when deciding when to print invoices and
1971 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>
1972 for conversion functions.
1974 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1977 retry_card - Deprecated alias for 'retry'
1979 batch_card - This option is deprecated. See the invoice events web interface
1980 to control whether cards are batched or run against a realtime gateway.
1982 report_badcard - This option is deprecated.
1984 force_print - This option is deprecated; see the invoice events web interface.
1986 quiet - set true to surpress email card/ACH decline notices.
1991 my( $self, %options ) = @_;
1992 my $invoice_time = $options{'invoice_time'} || time;
1995 local $SIG{HUP} = 'IGNORE';
1996 local $SIG{INT} = 'IGNORE';
1997 local $SIG{QUIT} = 'IGNORE';
1998 local $SIG{TERM} = 'IGNORE';
1999 local $SIG{TSTP} = 'IGNORE';
2000 local $SIG{PIPE} = 'IGNORE';
2002 my $oldAutoCommit = $FS::UID::AutoCommit;
2003 local $FS::UID::AutoCommit = 0;
2006 $self->select_for_update; #mutex
2008 my $balance = $self->balance;
2009 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2011 unless ( $balance > 0 ) { #redundant?????
2012 $dbh->rollback if $oldAutoCommit; #hmm
2016 if ( exists($options{'retry_card'}) ) {
2017 carp 'retry_card option passed to collect is deprecated; use retry';
2018 $options{'retry'} ||= $options{'retry_card'};
2020 if ( exists($options{'retry'}) && $options{'retry'} ) {
2021 my $error = $self->retry_realtime;
2023 $dbh->rollback if $oldAutoCommit;
2028 foreach my $cust_bill ( $self->open_cust_bill ) {
2030 # don't try to charge for the same invoice if it's already in a batch
2031 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2033 last if $self->balance <= 0;
2035 warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2038 foreach my $part_bill_event (
2039 sort { $a->seconds <=> $b->seconds
2040 || $a->weight <=> $b->weight
2041 || $a->eventpart <=> $b->eventpart }
2042 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2043 && ! qsearch( 'cust_bill_event', {
2044 'invnum' => $cust_bill->invnum,
2045 'eventpart' => $_->eventpart,
2049 qsearch('part_bill_event', { 'payby' => $self->payby,
2050 'disabled' => '', } )
2053 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2054 || $self->balance <= 0; # or if balance<=0
2056 warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
2058 my $cust_main = $self; #for callback
2062 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2063 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2064 $error = eval $part_bill_event->eventcode;
2068 my $statustext = '';
2072 } elsif ( $error ) {
2074 $statustext = $error;
2079 #add cust_bill_event
2080 my $cust_bill_event = new FS::cust_bill_event {
2081 'invnum' => $cust_bill->invnum,
2082 'eventpart' => $part_bill_event->eventpart,
2083 #'_date' => $invoice_time,
2085 'status' => $status,
2086 'statustext' => $statustext,
2088 $error = $cust_bill_event->insert;
2090 #$dbh->rollback if $oldAutoCommit;
2091 #return "error: $error";
2093 # gah, even with transactions.
2094 $dbh->commit if $oldAutoCommit; #well.
2095 my $e = 'WARNING: Event run but database not updated - '.
2096 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2097 ', eventpart '. $part_bill_event->eventpart.
2108 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2113 =item retry_realtime
2115 Schedules realtime credit card / electronic check / LEC billing events for
2116 for retry. Useful if card information has changed or manual retry is desired.
2117 The 'collect' method must be called to actually retry the transaction.
2119 Implementation details: For each of this customer's open invoices, changes
2120 the status of the first "done" (with statustext error) realtime processing
2125 sub retry_realtime {
2128 local $SIG{HUP} = 'IGNORE';
2129 local $SIG{INT} = 'IGNORE';
2130 local $SIG{QUIT} = 'IGNORE';
2131 local $SIG{TERM} = 'IGNORE';
2132 local $SIG{TSTP} = 'IGNORE';
2133 local $SIG{PIPE} = 'IGNORE';
2135 my $oldAutoCommit = $FS::UID::AutoCommit;
2136 local $FS::UID::AutoCommit = 0;
2139 foreach my $cust_bill (
2140 grep { $_->cust_bill_event }
2141 $self->open_cust_bill
2143 my @cust_bill_event =
2144 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2146 #$_->part_bill_event->plan eq 'realtime-card'
2147 $_->part_bill_event->eventcode =~
2148 /\$cust_bill\->realtime_(card|ach|lec)/
2149 && $_->status eq 'done'
2152 $cust_bill->cust_bill_event;
2153 next unless @cust_bill_event;
2154 my $error = $cust_bill_event[0]->retry;
2156 $dbh->rollback if $oldAutoCommit;
2157 return "error scheduling invoice event for retry: $error";
2162 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2167 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2169 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2170 via a Business::OnlinePayment realtime gateway. See
2171 L<http://420.am/business-onlinepayment> for supported gateways.
2173 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2175 Available options are: I<description>, I<invnum>, I<quiet>
2177 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2178 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2179 if set, will override the value from the customer record.
2181 I<description> is a free-text field passed to the gateway. It defaults to
2182 "Internet services".
2184 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2185 specified invoice. If you don't specify an I<invnum> you might want to
2186 call the B<apply_payments> method.
2188 I<quiet> can be set true to surpress email decline notices.
2190 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2195 my( $self, $method, $amount, %options ) = @_;
2197 warn "$me realtime_bop: $method $amount\n";
2198 warn " $_ => $options{$_}\n" foreach keys %options;
2201 $options{'description'} ||= 'Internet services';
2203 eval "use Business::OnlinePayment";
2206 my $payinfo = exists($options{'payinfo'})
2207 ? $options{'payinfo'}
2215 if ( $options{'invnum'} ) {
2216 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2217 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2219 map { $_->part_pkg->taxclass }
2221 map { $_->cust_pkg }
2222 $cust_bill->cust_bill_pkg;
2223 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2224 #different taxclasses
2225 $taxclass = $taxclasses[0];
2229 #look for an agent gateway override first
2231 if ( $method eq 'CC' ) {
2232 $cardtype = cardtype($payinfo);
2233 } elsif ( $method eq 'ECHECK' ) {
2236 $cardtype = $method;
2240 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2241 cardtype => $cardtype,
2242 taxclass => $taxclass, } )
2243 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2245 taxclass => $taxclass, } )
2246 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2247 cardtype => $cardtype,
2249 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2251 taxclass => '', } );
2253 my $payment_gateway = '';
2254 my( $processor, $login, $password, $action, @bop_options );
2255 if ( $override ) { #use a payment gateway override
2257 $payment_gateway = $override->payment_gateway;
2259 $processor = $payment_gateway->gateway_module;
2260 $login = $payment_gateway->gateway_username;
2261 $password = $payment_gateway->gateway_password;
2262 $action = $payment_gateway->gateway_action;
2263 @bop_options = $payment_gateway->options;
2265 } else { #use the standard settings from the config
2267 ( $processor, $login, $password, $action, @bop_options ) =
2268 $self->default_payment_gateway($method);
2276 my $address = exists($options{'address1'})
2277 ? $options{'address1'}
2279 my $address2 = exists($options{'address2'})
2280 ? $options{'address2'}
2282 $address .= ", ". $address2 if length($address2);
2284 my $o_payname = exists($options{'payname'})
2285 ? $options{'payname'}
2287 my($payname, $payfirst, $paylast);
2288 if ( $o_payname && $method ne 'ECHECK' ) {
2289 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2290 or return "Illegal payname $payname";
2291 ($payfirst, $paylast) = ($1, $2);
2293 $payfirst = $self->getfield('first');
2294 $paylast = $self->getfield('last');
2295 $payname = "$payfirst $paylast";
2298 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2299 if ( $conf->exists('emailinvoiceauto')
2300 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2301 push @invoicing_list, $self->all_emails;
2304 my $email = ($conf->exists('business-onlinepayment-email-override'))
2305 ? $conf->config('business-onlinepayment-email-override')
2306 : $invoicing_list[0];
2310 my $payip = exists($options{'payip'})
2313 $content{customer_ip} = $payip
2316 if ( $method eq 'CC' ) {
2318 $content{card_number} = $payinfo;
2319 my $paydate = exists($options{'paydate'})
2320 ? $options{'paydate'}
2322 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2323 $content{expiration} = "$2/$1";
2325 my $paycvv = exists($options{'paycvv'})
2326 ? $options{'paycvv'}
2328 $content{cvv2} = $self->paycvv
2331 my $paystart_month = exists($options{'paystart_month'})
2332 ? $options{'paystart_month'}
2333 : $self->paystart_month;
2335 my $paystart_year = exists($options{'paystart_year'})
2336 ? $options{'paystart_year'}
2337 : $self->paystart_year;
2339 $content{card_start} = "$paystart_month/$paystart_year"
2340 if $paystart_month && $paystart_year;
2342 my $payissue = exists($options{'payissue'})
2343 ? $options{'payissue'}
2345 $content{issue_number} = $payissue if $payissue;
2347 $content{recurring_billing} = 'YES'
2348 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2350 'payinfo' => $payinfo,
2353 } elsif ( $method eq 'ECHECK' ) {
2354 ( $content{account_number}, $content{routing_code} ) =
2355 split('@', $payinfo);
2356 $content{bank_name} = $o_payname;
2357 $content{account_type} = 'CHECKING';
2358 $content{account_name} = $payname;
2359 $content{customer_org} = $self->company ? 'B' : 'I';
2360 $content{customer_ssn} = exists($options{'ss'})
2363 } elsif ( $method eq 'LEC' ) {
2364 $content{phone} = $payinfo;
2368 # run transaction(s)
2371 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2373 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2374 $transaction->content(
2377 'password' => $password,
2378 'action' => $action1,
2379 'description' => $options{'description'},
2380 'amount' => $amount,
2381 'invoice_number' => $options{'invnum'},
2382 'customer_id' => $self->custnum,
2383 'last_name' => $paylast,
2384 'first_name' => $payfirst,
2386 'address' => $address,
2387 'city' => ( exists($options{'city'})
2390 'state' => ( exists($options{'state'})
2393 'zip' => ( exists($options{'zip'})
2396 'country' => ( exists($options{'country'})
2397 ? $options{'country'}
2399 'referer' => 'http://cleanwhisker.420.am/',
2401 'phone' => $self->daytime || $self->night,
2404 $transaction->submit();
2406 if ( $transaction->is_success() && $action2 ) {
2407 my $auth = $transaction->authorization;
2408 my $ordernum = $transaction->can('order_number')
2409 ? $transaction->order_number
2413 new Business::OnlinePayment( $processor, @bop_options );
2420 password => $password,
2421 order_number => $ordernum,
2423 authorization => $auth,
2424 description => $options{'description'},
2427 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2428 transaction_sequence_num local_transaction_date
2429 local_transaction_time AVS_result_code )) {
2430 $capture{$field} = $transaction->$field() if $transaction->can($field);
2433 $capture->content( %capture );
2437 unless ( $capture->is_success ) {
2438 my $e = "Authorization sucessful but capture failed, custnum #".
2439 $self->custnum. ': '. $capture->result_code.
2440 ": ". $capture->error_message;
2448 # remove paycvv after initial transaction
2451 #false laziness w/misc/process/payment.cgi - check both to make sure working
2453 if ( defined $self->dbdef_table->column('paycvv')
2454 && length($self->paycvv)
2455 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2457 my $error = $self->remove_cvv;
2459 warn "WARNING: error removing cvv: $error\n";
2467 if ( $transaction->is_success() ) {
2469 my %method2payby = (
2476 if ( $payment_gateway ) { # agent override
2477 $paybatch = $payment_gateway->gatewaynum. '-';
2480 $paybatch .= "$processor:". $transaction->authorization;
2482 $paybatch .= ':'. $transaction->order_number
2483 if $transaction->can('order_number')
2484 && length($transaction->order_number);
2486 my $cust_pay = new FS::cust_pay ( {
2487 'custnum' => $self->custnum,
2488 'invnum' => $options{'invnum'},
2491 'payby' => $method2payby{$method},
2492 'payinfo' => $payinfo,
2493 'paybatch' => $paybatch,
2495 my $error = $cust_pay->insert;
2497 $cust_pay->invnum(''); #try again with no specific invnum
2498 my $error2 = $cust_pay->insert;
2500 # gah, even with transactions.
2501 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2502 "error inserting payment ($processor): $error2".
2503 " (previously tried insert with invnum #$options{'invnum'}" .
2509 return ''; #no error
2513 my $perror = "$processor error: ". $transaction->error_message;
2515 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2516 && $conf->exists('emaildecline')
2517 && grep { $_ ne 'POST' } $self->invoicing_list
2518 && ! grep { $transaction->error_message =~ /$_/ }
2519 $conf->config('emaildecline-exclude')
2521 my @templ = $conf->config('declinetemplate');
2522 my $template = new Text::Template (
2524 SOURCE => [ map "$_\n", @templ ],
2525 ) or return "($perror) can't create template: $Text::Template::ERROR";
2526 $template->compile()
2527 or return "($perror) can't compile template: $Text::Template::ERROR";
2529 my $templ_hash = { error => $transaction->error_message };
2531 my $error = send_email(
2532 'from' => $conf->config('invoice_from'),
2533 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2534 'subject' => 'Your payment could not be processed',
2535 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2538 $perror .= " (also received error sending decline notification: $error)"
2548 =item default_payment_gateway
2552 sub default_payment_gateway {
2553 my( $self, $method ) = @_;
2555 die "Real-time processing not enabled\n"
2556 unless $conf->exists('business-onlinepayment');
2559 my $bop_config = 'business-onlinepayment';
2560 $bop_config .= '-ach'
2561 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2562 my ( $processor, $login, $password, $action, @bop_options ) =
2563 $conf->config($bop_config);
2564 $action ||= 'normal authorization';
2565 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2566 die "No real-time processor is enabled - ".
2567 "did you set the business-onlinepayment configuration value?\n"
2570 ( $processor, $login, $password, $action, @bop_options )
2575 Removes the I<paycvv> field from the database directly.
2577 If there is an error, returns the error, otherwise returns false.
2583 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2584 or return dbh->errstr;
2585 $sth->execute($self->custnum)
2586 or return $sth->errstr;
2591 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2593 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2594 via a Business::OnlinePayment realtime gateway. See
2595 L<http://420.am/business-onlinepayment> for supported gateways.
2597 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2599 Available options are: I<amount>, I<reason>, I<paynum>
2601 Most gateways require a reference to an original payment transaction to refund,
2602 so you probably need to specify a I<paynum>.
2604 I<amount> defaults to the original amount of the payment if not specified.
2606 I<reason> specifies a reason for the refund.
2608 Implementation note: If I<amount> is unspecified or equal to the amount of the
2609 orignal payment, first an attempt is made to "void" the transaction via
2610 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2611 the normal attempt is made to "refund" ("credit") the transaction via the
2612 gateway is attempted.
2614 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2615 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2616 #if set, will override the value from the customer record.
2618 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2619 #specified invoice. If you don't specify an I<invnum> you might want to
2620 #call the B<apply_payments> method.
2624 #some false laziness w/realtime_bop, not enough to make it worth merging
2625 #but some useful small subs should be pulled out
2626 sub realtime_refund_bop {
2627 my( $self, $method, %options ) = @_;
2629 warn "$me realtime_refund_bop: $method refund\n";
2630 warn " $_ => $options{$_}\n" foreach keys %options;
2633 eval "use Business::OnlinePayment";
2637 # look up the original payment and optionally a gateway for that payment
2641 my $amount = $options{'amount'};
2643 my( $processor, $login, $password, @bop_options ) ;
2644 my( $auth, $order_number ) = ( '', '', '' );
2646 if ( $options{'paynum'} ) {
2648 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
2649 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2650 or return "Unknown paynum $options{'paynum'}";
2651 $amount ||= $cust_pay->paid;
2653 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2654 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2655 $cust_pay->paybatch;
2656 my $gatewaynum = '';
2657 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2659 if ( $gatewaynum ) { #gateway for the payment to be refunded
2661 my $payment_gateway =
2662 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2663 die "payment gateway $gatewaynum not found"
2664 unless $payment_gateway;
2666 $processor = $payment_gateway->gateway_module;
2667 $login = $payment_gateway->gateway_username;
2668 $password = $payment_gateway->gateway_password;
2669 @bop_options = $payment_gateway->options;
2671 } else { #try the default gateway
2673 my( $conf_processor, $unused_action );
2674 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2675 $self->default_payment_gateway($method);
2677 return "processor of payment $options{'paynum'} $processor does not".
2678 " match default processor $conf_processor"
2679 unless $processor eq $conf_processor;
2684 } else { # didn't specify a paynum, so look for agent gateway overrides
2685 # like a normal transaction
2688 if ( $method eq 'CC' ) {
2689 $cardtype = cardtype($self->payinfo);
2690 } elsif ( $method eq 'ECHECK' ) {
2693 $cardtype = $method;
2696 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2697 cardtype => $cardtype,
2699 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2701 taxclass => '', } );
2703 if ( $override ) { #use a payment gateway override
2705 my $payment_gateway = $override->payment_gateway;
2707 $processor = $payment_gateway->gateway_module;
2708 $login = $payment_gateway->gateway_username;
2709 $password = $payment_gateway->gateway_password;
2710 #$action = $payment_gateway->gateway_action;
2711 @bop_options = $payment_gateway->options;
2713 } else { #use the standard settings from the config
2716 ( $processor, $login, $password, $unused_action, @bop_options ) =
2717 $self->default_payment_gateway($method);
2722 return "neither amount nor paynum specified" unless $amount;
2727 'password' => $password,
2728 'order_number' => $order_number,
2729 'amount' => $amount,
2730 'referer' => 'http://cleanwhisker.420.am/',
2732 $content{authorization} = $auth
2733 if length($auth); #echeck/ACH transactions have an order # but no auth
2734 #(at least with authorize.net)
2736 #first try void if applicable
2737 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2738 warn " attempting void\n" if $DEBUG > 1;
2739 my $void = new Business::OnlinePayment( $processor, @bop_options );
2740 $void->content( 'action' => 'void', %content );
2742 if ( $void->is_success ) {
2743 my $error = $cust_pay->void($options{'reason'});
2745 # gah, even with transactions.
2746 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2747 "error voiding payment: $error";
2751 warn " void successful\n" if $DEBUG > 1;
2756 warn " void unsuccessful, trying refund\n"
2760 my $address = $self->address1;
2761 $address .= ", ". $self->address2 if $self->address2;
2763 my($payname, $payfirst, $paylast);
2764 if ( $self->payname && $method ne 'ECHECK' ) {
2765 $payname = $self->payname;
2766 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2767 or return "Illegal payname $payname";
2768 ($payfirst, $paylast) = ($1, $2);
2770 $payfirst = $self->getfield('first');
2771 $paylast = $self->getfield('last');
2772 $payname = "$payfirst $paylast";
2776 if ( $method eq 'CC' ) {
2779 $content{card_number} = $payinfo = $cust_pay->payinfo;
2780 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2781 #$content{expiration} = "$2/$1";
2783 $content{card_number} = $payinfo = $self->payinfo;
2784 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2785 $content{expiration} = "$2/$1";
2788 } elsif ( $method eq 'ECHECK' ) {
2789 ( $content{account_number}, $content{routing_code} ) =
2790 split('@', $payinfo = $self->payinfo);
2791 $content{bank_name} = $self->payname;
2792 $content{account_type} = 'CHECKING';
2793 $content{account_name} = $payname;
2794 $content{customer_org} = $self->company ? 'B' : 'I';
2795 $content{customer_ssn} = $self->ss;
2796 } elsif ( $method eq 'LEC' ) {
2797 $content{phone} = $payinfo = $self->payinfo;
2801 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2802 my %sub_content = $refund->content(
2803 'action' => 'credit',
2804 'customer_id' => $self->custnum,
2805 'last_name' => $paylast,
2806 'first_name' => $payfirst,
2808 'address' => $address,
2809 'city' => $self->city,
2810 'state' => $self->state,
2811 'zip' => $self->zip,
2812 'country' => $self->country,
2815 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2819 return "$processor error: ". $refund->error_message
2820 unless $refund->is_success();
2822 my %method2payby = (
2828 my $paybatch = "$processor:". $refund->authorization;
2829 $paybatch .= ':'. $refund->order_number
2830 if $refund->can('order_number') && $refund->order_number;
2832 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2833 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2834 last unless @cust_bill_pay;
2835 my $cust_bill_pay = pop @cust_bill_pay;
2836 my $error = $cust_bill_pay->delete;
2840 my $cust_refund = new FS::cust_refund ( {
2841 'custnum' => $self->custnum,
2842 'paynum' => $options{'paynum'},
2843 'refund' => $amount,
2845 'payby' => $method2payby{$method},
2846 'payinfo' => $payinfo,
2847 'paybatch' => $paybatch,
2848 'reason' => $options{'reason'} || 'card or ACH refund',
2850 my $error = $cust_refund->insert;
2852 $cust_refund->paynum(''); #try again with no specific paynum
2853 my $error2 = $cust_refund->insert;
2855 # gah, even with transactions.
2856 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2857 "error inserting refund ($processor): $error2".
2858 " (previously tried insert with paynum #$options{'paynum'}" .
2871 Returns the total owed for this customer on all invoices
2872 (see L<FS::cust_bill/owed>).
2878 $self->total_owed_date(2145859200); #12/31/2037
2881 =item total_owed_date TIME
2883 Returns the total owed for this customer on all invoices with date earlier than
2884 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2885 see L<Time::Local> and L<Date::Parse> for conversion functions.
2889 sub total_owed_date {
2893 foreach my $cust_bill (
2894 grep { $_->_date <= $time }
2895 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2897 $total_bill += $cust_bill->owed;
2899 sprintf( "%.2f", $total_bill );
2902 =item apply_credits OPTION => VALUE ...
2904 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2905 to outstanding invoice balances in chronological order (or reverse
2906 chronological order if the I<order> option is set to B<newest>) and returns the
2907 value of any remaining unapplied credits available for refund (see
2908 L<FS::cust_refund>).
2916 return 0 unless $self->total_credited;
2918 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2919 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2921 my @invoices = $self->open_cust_bill;
2922 @invoices = sort { $b->_date <=> $a->_date } @invoices
2923 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2926 foreach my $cust_bill ( @invoices ) {
2929 if ( !defined($credit) || $credit->credited == 0) {
2930 $credit = pop @credits or last;
2933 if ($cust_bill->owed >= $credit->credited) {
2934 $amount=$credit->credited;
2936 $amount=$cust_bill->owed;
2939 my $cust_credit_bill = new FS::cust_credit_bill ( {
2940 'crednum' => $credit->crednum,
2941 'invnum' => $cust_bill->invnum,
2942 'amount' => $amount,
2944 my $error = $cust_credit_bill->insert;
2945 die $error if $error;
2947 redo if ($cust_bill->owed > 0);
2951 return $self->total_credited;
2954 =item apply_payments
2956 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2957 to outstanding invoice balances in chronological order.
2959 #and returns the value of any remaining unapplied payments.
2963 sub apply_payments {
2968 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2969 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2971 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2972 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2976 foreach my $cust_bill ( @invoices ) {
2979 if ( !defined($payment) || $payment->unapplied == 0 ) {
2980 $payment = pop @payments or last;
2983 if ( $cust_bill->owed >= $payment->unapplied ) {
2984 $amount = $payment->unapplied;
2986 $amount = $cust_bill->owed;
2989 my $cust_bill_pay = new FS::cust_bill_pay ( {
2990 'paynum' => $payment->paynum,
2991 'invnum' => $cust_bill->invnum,
2992 'amount' => $amount,
2994 my $error = $cust_bill_pay->insert;
2995 die $error if $error;
2997 redo if ( $cust_bill->owed > 0);
3001 return $self->total_unapplied_payments;
3004 =item total_credited
3006 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3007 customer. See L<FS::cust_credit/credited>.
3011 sub total_credited {
3013 my $total_credit = 0;
3014 foreach my $cust_credit ( qsearch('cust_credit', {
3015 'custnum' => $self->custnum,
3017 $total_credit += $cust_credit->credited;
3019 sprintf( "%.2f", $total_credit );
3022 =item total_unapplied_payments
3024 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3025 See L<FS::cust_pay/unapplied>.
3029 sub total_unapplied_payments {
3031 my $total_unapplied = 0;
3032 foreach my $cust_pay ( qsearch('cust_pay', {
3033 'custnum' => $self->custnum,
3035 $total_unapplied += $cust_pay->unapplied;
3037 sprintf( "%.2f", $total_unapplied );
3042 Returns the balance for this customer (total_owed minus total_credited
3043 minus total_unapplied_payments).
3050 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3054 =item balance_date TIME
3056 Returns the balance for this customer, only considering invoices with date
3057 earlier than TIME (total_owed_date minus total_credited minus
3058 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3059 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3068 $self->total_owed_date($time)
3069 - $self->total_credited
3070 - $self->total_unapplied_payments
3074 =item paydate_monthyear
3076 Returns a two-element list consisting of the month and year of this customer's
3077 paydate (credit card expiration date for CARD customers)
3081 sub paydate_monthyear {
3083 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3085 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3092 =item payinfo_masked
3094 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.
3096 Credit Cards - Mask all but the last four characters.
3097 Checks - Mask all but last 2 of account number and bank routing number.
3098 Others - Do nothing, return the unmasked string.
3102 sub payinfo_masked {
3104 return $self->paymask;
3107 =item invoicing_list [ ARRAYREF ]
3109 If an arguement is given, sets these email addresses as invoice recipients
3110 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3111 (except as warnings), so use check_invoicing_list first.
3113 Returns a list of email addresses (with svcnum entries expanded).
3115 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3116 check it without disturbing anything by passing nothing.
3118 This interface may change in the future.
3122 sub invoicing_list {
3123 my( $self, $arrayref ) = @_;
3125 my @cust_main_invoice;
3126 if ( $self->custnum ) {
3127 @cust_main_invoice =
3128 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3130 @cust_main_invoice = ();
3132 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3133 #warn $cust_main_invoice->destnum;
3134 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3135 #warn $cust_main_invoice->destnum;
3136 my $error = $cust_main_invoice->delete;
3137 warn $error if $error;
3140 if ( $self->custnum ) {
3141 @cust_main_invoice =
3142 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3144 @cust_main_invoice = ();
3146 my %seen = map { $_->address => 1 } @cust_main_invoice;
3147 foreach my $address ( @{$arrayref} ) {
3148 next if exists $seen{$address} && $seen{$address};
3149 $seen{$address} = 1;
3150 my $cust_main_invoice = new FS::cust_main_invoice ( {
3151 'custnum' => $self->custnum,
3154 my $error = $cust_main_invoice->insert;
3155 warn $error if $error;
3158 if ( $self->custnum ) {
3160 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3166 =item check_invoicing_list ARRAYREF
3168 Checks these arguements as valid input for the invoicing_list method. If there
3169 is an error, returns the error, otherwise returns false.
3173 sub check_invoicing_list {
3174 my( $self, $arrayref ) = @_;
3175 foreach my $address ( @{$arrayref} ) {
3177 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3178 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3181 my $cust_main_invoice = new FS::cust_main_invoice ( {
3182 'custnum' => $self->custnum,
3185 my $error = $self->custnum
3186 ? $cust_main_invoice->check
3187 : $cust_main_invoice->checkdest
3189 return $error if $error;
3194 =item set_default_invoicing_list
3196 Sets the invoicing list to all accounts associated with this customer,
3197 overwriting any previous invoicing list.
3201 sub set_default_invoicing_list {
3203 $self->invoicing_list($self->all_emails);
3208 Returns the email addresses of all accounts provisioned for this customer.
3215 foreach my $cust_pkg ( $self->all_pkgs ) {
3216 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3218 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3219 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3221 $list{$_}=1 foreach map { $_->email } @svc_acct;
3226 =item invoicing_list_addpost
3228 Adds postal invoicing to this customer. If this customer is already configured
3229 to receive postal invoices, does nothing.
3233 sub invoicing_list_addpost {
3235 return if grep { $_ eq 'POST' } $self->invoicing_list;
3236 my @invoicing_list = $self->invoicing_list;
3237 push @invoicing_list, 'POST';
3238 $self->invoicing_list(\@invoicing_list);
3241 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3243 Returns an array of customers referred by this customer (referral_custnum set
3244 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3245 customers referred by customers referred by this customer and so on, inclusive.
3246 The default behavior is DEPTH 1 (no recursion).
3250 sub referral_cust_main {
3252 my $depth = @_ ? shift : 1;
3253 my $exclude = @_ ? shift : {};
3256 map { $exclude->{$_->custnum}++; $_; }
3257 grep { ! $exclude->{ $_->custnum } }
3258 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3262 map { $_->referral_cust_main($depth-1, $exclude) }
3269 =item referral_cust_main_ncancelled
3271 Same as referral_cust_main, except only returns customers with uncancelled
3276 sub referral_cust_main_ncancelled {
3278 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3281 =item referral_cust_pkg [ DEPTH ]
3283 Like referral_cust_main, except returns a flat list of all unsuspended (and
3284 uncancelled) packages for each customer. The number of items in this list may
3285 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3289 sub referral_cust_pkg {
3291 my $depth = @_ ? shift : 1;
3293 map { $_->unsuspended_pkgs }
3294 grep { $_->unsuspended_pkgs }
3295 $self->referral_cust_main($depth);
3298 =item referring_cust_main
3300 Returns the single cust_main record for the customer who referred this customer
3301 (referral_custnum), or false.
3305 sub referring_cust_main {
3307 return '' unless $self->referral_custnum;
3308 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3311 =item credit AMOUNT, REASON
3313 Applies a credit to this customer. If there is an error, returns the error,
3314 otherwise returns false.
3319 my( $self, $amount, $reason ) = @_;
3320 my $cust_credit = new FS::cust_credit {
3321 'custnum' => $self->custnum,
3322 'amount' => $amount,
3323 'reason' => $reason,
3325 $cust_credit->insert;
3328 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3330 Creates a one-time charge for this customer. If there is an error, returns
3331 the error, otherwise returns false.
3336 my ( $self, $amount ) = ( shift, shift );
3337 my $pkg = @_ ? shift : 'One-time charge';
3338 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3339 my $taxclass = @_ ? shift : '';
3341 local $SIG{HUP} = 'IGNORE';
3342 local $SIG{INT} = 'IGNORE';
3343 local $SIG{QUIT} = 'IGNORE';
3344 local $SIG{TERM} = 'IGNORE';
3345 local $SIG{TSTP} = 'IGNORE';
3346 local $SIG{PIPE} = 'IGNORE';
3348 my $oldAutoCommit = $FS::UID::AutoCommit;
3349 local $FS::UID::AutoCommit = 0;
3352 my $part_pkg = new FS::part_pkg ( {
3354 'comment' => $comment,
3355 #'setup' => $amount,
3358 'plandata' => "setup_fee=$amount",
3361 'taxclass' => $taxclass,
3364 my $error = $part_pkg->insert;
3366 $dbh->rollback if $oldAutoCommit;
3370 my $pkgpart = $part_pkg->pkgpart;
3371 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3372 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3373 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3374 $error = $type_pkgs->insert;
3376 $dbh->rollback if $oldAutoCommit;
3381 my $cust_pkg = new FS::cust_pkg ( {
3382 'custnum' => $self->custnum,
3383 'pkgpart' => $pkgpart,
3386 $error = $cust_pkg->insert;
3388 $dbh->rollback if $oldAutoCommit;
3392 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3399 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3405 sort { $a->_date <=> $b->_date }
3406 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3409 =item open_cust_bill
3411 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3416 sub open_cust_bill {
3418 grep { $_->owed > 0 } $self->cust_bill;
3423 Returns all the credits (see L<FS::cust_credit>) for this customer.
3429 sort { $a->_date <=> $b->_date }
3430 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3435 Returns all the payments (see L<FS::cust_pay>) for this customer.
3441 sort { $a->_date <=> $b->_date }
3442 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3447 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3453 sort { $a->_date <=> $b->_date }
3454 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3460 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3466 sort { $a->_date <=> $b->_date }
3467 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3470 =item select_for_update
3472 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3477 sub select_for_update {
3479 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3484 Returns a name string for this customer, either "Company (Last, First)" or
3491 my $name = $self->contact;
3492 $name = $self->company. " ($name)" if $self->company;
3498 Returns a name string for this (service/shipping) contact, either
3499 "Company (Last, First)" or "Last, First".
3505 if ( $self->get('ship_last') ) {
3506 my $name = $self->ship_contact;
3507 $name = $self->ship_company. " ($name)" if $self->ship_company;
3516 Returns this customer's full (billing) contact name only, "Last, First"
3522 $self->get('last'). ', '. $self->first;
3527 Returns this customer's full (shipping) contact name only, "Last, First"
3533 $self->get('ship_last')
3534 ? $self->get('ship_last'). ', '. $self->ship_first
3540 Returns a status string for this customer, currently:
3544 =item prospect - No packages have ever been ordered
3546 =item active - One or more recurring packages is active
3548 =item suspended - All non-cancelled recurring packages are suspended
3550 =item cancelled - All recurring packages are cancelled
3558 for my $status (qw( prospect active suspended cancelled )) {
3559 my $method = $status.'_sql';
3560 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3561 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3562 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3563 return $status if $sth->fetchrow_arrayref->[0];
3569 Returns a hex triplet color string for this customer's status.
3574 'prospect' => '000000',
3575 'active' => '00CC00',
3576 'suspended' => 'FF9900',
3577 'cancelled' => 'FF0000',
3581 $statuscolor{$self->status};
3586 =head1 CLASS METHODS
3592 Returns an SQL expression identifying prospective cust_main records (customers
3593 with no packages ever ordered)
3597 sub prospect_sql { "
3598 0 = ( SELECT COUNT(*) FROM cust_pkg
3599 WHERE cust_pkg.custnum = cust_main.custnum
3605 Returns an SQL expression identifying active cust_main records.
3610 0 < ( SELECT COUNT(*) FROM cust_pkg
3611 WHERE cust_pkg.custnum = cust_main.custnum
3612 AND ". FS::cust_pkg->active_sql. "
3619 Returns an SQL expression identifying suspended cust_main records.
3623 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3624 my $recurring_sql = "
3625 '0' != ( select freq from part_pkg
3626 where cust_pkg.pkgpart = part_pkg.pkgpart )
3629 sub suspended_sql { susp_sql(@_); }
3631 0 < ( SELECT COUNT(*) FROM cust_pkg
3632 WHERE cust_pkg.custnum = cust_main.custnum
3634 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3636 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3637 WHERE cust_pkg.custnum = cust_main.custnum
3638 AND ". FS::cust_pkg->active_sql. "
3645 Returns an SQL expression identifying cancelled cust_main records.
3649 sub cancelled_sql { cancel_sql(@_); }
3651 0 < ( SELECT COUNT(*) FROM cust_pkg
3652 WHERE cust_pkg.custnum = cust_main.custnum
3654 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3655 WHERE cust_pkg.custnum = cust_main.custnum
3657 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3661 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3663 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3664 records. Currently, only I<last> or I<company> may be specified (the
3665 appropriate ship_ field is also searched if applicable).
3667 Additional options are the same as FS::Record::qsearch
3672 my( $self, $fuzzy, $hash, @opt) = @_;
3677 check_and_rebuild_fuzzyfiles();
3678 foreach my $field ( keys %$fuzzy ) {
3679 my $sub = \&{"all_$field"};
3681 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3683 foreach ( keys %match ) {
3684 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3685 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3686 if defined dbdef->table('cust_main')->column('ship_last');
3691 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3703 =item smart_search OPTION => VALUE ...
3705 Accepts the following options: I<search>, the string to search for. The string
3706 will be searched for as a customer number, last name or company name, first
3707 searching for an exact match then fuzzy and substring matches.
3709 Any additional options treated as an additional qualifier on the search
3712 Returns a (possibly empty) array of FS::cust_main objects.
3718 my $search = delete $options{'search'};
3721 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3723 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3725 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3728 my $q_value = dbh->quote($value);
3731 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3732 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3733 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3734 if defined dbdef->table('cust_main')->column('ship_last');
3737 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3739 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3741 #still some false laziness w/ search/cust_main.cgi
3744 push @cust_main, qsearch( 'cust_main',
3745 { 'last' => { 'op' => 'ILIKE',
3746 'value' => "%$q_value%" },
3750 push @cust_main, qsearch( 'cust_main',
3751 { 'ship_last' => { 'op' => 'ILIKE',
3752 'value' => "%$q_value%" },
3757 if defined dbdef->table('cust_main')->column('ship_last');
3759 push @cust_main, qsearch( 'cust_main',
3760 { 'company' => { 'op' => 'ILIKE',
3761 'value' => "%$q_value%" },
3765 push @cust_main, qsearch( 'cust_main',
3766 { 'ship_company' => { 'op' => 'ILIKE',
3767 'value' => "%$q_value%" },
3771 if defined dbdef->table('cust_main')->column('ship_last');
3774 push @cust_main, FS::cust_main->fuzzy_search(
3775 { 'last' => $value },
3778 push @cust_main, FS::cust_main->fuzzy_search(
3779 { 'company' => $value },
3791 =item check_and_rebuild_fuzzyfiles
3795 sub check_and_rebuild_fuzzyfiles {
3796 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3797 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3798 or &rebuild_fuzzyfiles;
3801 =item rebuild_fuzzyfiles
3805 sub rebuild_fuzzyfiles {
3807 use Fcntl qw(:flock);
3809 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3813 open(LASTLOCK,">>$dir/cust_main.last")
3814 or die "can't open $dir/cust_main.last: $!";
3815 flock(LASTLOCK,LOCK_EX)
3816 or die "can't lock $dir/cust_main.last: $!";
3818 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3820 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3821 if defined dbdef->table('cust_main')->column('ship_last');
3823 open (LASTCACHE,">$dir/cust_main.last.tmp")
3824 or die "can't open $dir/cust_main.last.tmp: $!";
3825 print LASTCACHE join("\n", @all_last), "\n";
3826 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3828 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3833 open(COMPANYLOCK,">>$dir/cust_main.company")
3834 or die "can't open $dir/cust_main.company: $!";
3835 flock(COMPANYLOCK,LOCK_EX)
3836 or die "can't lock $dir/cust_main.company: $!";
3838 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3840 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3841 if defined dbdef->table('cust_main')->column('ship_last');
3843 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3844 or die "can't open $dir/cust_main.company.tmp: $!";
3845 print COMPANYCACHE join("\n", @all_company), "\n";
3846 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3848 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3858 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3859 open(LASTCACHE,"<$dir/cust_main.last")
3860 or die "can't open $dir/cust_main.last: $!";
3861 my @array = map { chomp; $_; } <LASTCACHE>;
3871 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3872 open(COMPANYCACHE,"<$dir/cust_main.company")
3873 or die "can't open $dir/cust_main.last: $!";
3874 my @array = map { chomp; $_; } <COMPANYCACHE>;
3879 =item append_fuzzyfiles LASTNAME COMPANY
3883 sub append_fuzzyfiles {
3884 my( $last, $company ) = @_;
3886 &check_and_rebuild_fuzzyfiles;
3888 use Fcntl qw(:flock);
3890 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3894 open(LAST,">>$dir/cust_main.last")
3895 or die "can't open $dir/cust_main.last: $!";
3897 or die "can't lock $dir/cust_main.last: $!";
3899 print LAST "$last\n";
3902 or die "can't unlock $dir/cust_main.last: $!";
3908 open(COMPANY,">>$dir/cust_main.company")
3909 or die "can't open $dir/cust_main.company: $!";
3910 flock(COMPANY,LOCK_EX)
3911 or die "can't lock $dir/cust_main.company: $!";
3913 print COMPANY "$company\n";
3915 flock(COMPANY,LOCK_UN)
3916 or die "can't unlock $dir/cust_main.company: $!";
3930 #warn join('-',keys %$param);
3931 my $fh = $param->{filehandle};
3932 my $agentnum = $param->{agentnum};
3933 my $refnum = $param->{refnum};
3934 my $pkgpart = $param->{pkgpart};
3935 my @fields = @{$param->{fields}};
3937 eval "use Date::Parse;";
3939 eval "use Text::CSV_XS;";
3942 my $csv = new Text::CSV_XS;
3949 local $SIG{HUP} = 'IGNORE';
3950 local $SIG{INT} = 'IGNORE';
3951 local $SIG{QUIT} = 'IGNORE';
3952 local $SIG{TERM} = 'IGNORE';
3953 local $SIG{TSTP} = 'IGNORE';
3954 local $SIG{PIPE} = 'IGNORE';
3956 my $oldAutoCommit = $FS::UID::AutoCommit;
3957 local $FS::UID::AutoCommit = 0;
3960 #while ( $columns = $csv->getline($fh) ) {
3962 while ( defined($line=<$fh>) ) {
3964 $csv->parse($line) or do {
3965 $dbh->rollback if $oldAutoCommit;
3966 return "can't parse: ". $csv->error_input();
3969 my @columns = $csv->fields();
3970 #warn join('-',@columns);
3973 agentnum => $agentnum,
3975 country => $conf->config('countrydefault') || 'US',
3976 payby => 'BILL', #default
3977 paydate => '12/2037', #default
3979 my $billtime = time;
3980 my %cust_pkg = ( pkgpart => $pkgpart );
3981 foreach my $field ( @fields ) {
3982 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3983 #$cust_pkg{$1} = str2time( shift @$columns );
3984 if ( $1 eq 'setup' ) {
3985 $billtime = str2time(shift @columns);
3987 $cust_pkg{$1} = str2time( shift @columns );
3990 #$cust_main{$field} = shift @$columns;
3991 $cust_main{$field} = shift @columns;
3995 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3996 my $cust_main = new FS::cust_main ( \%cust_main );
3998 tie my %hash, 'Tie::RefHash'; #this part is important
3999 $hash{$cust_pkg} = [] if $pkgpart;
4000 my $error = $cust_main->insert( \%hash );
4003 $dbh->rollback if $oldAutoCommit;
4004 return "can't insert customer for $line: $error";
4007 #false laziness w/bill.cgi
4008 $error = $cust_main->bill( 'time' => $billtime );
4010 $dbh->rollback if $oldAutoCommit;
4011 return "can't bill customer for $line: $error";
4014 $cust_main->apply_payments;
4015 $cust_main->apply_credits;
4017 $error = $cust_main->collect();
4019 $dbh->rollback if $oldAutoCommit;
4020 return "can't collect customer for $line: $error";
4026 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4028 return "Empty file!" unless $imported;
4040 #warn join('-',keys %$param);
4041 my $fh = $param->{filehandle};
4042 my @fields = @{$param->{fields}};
4044 eval "use Date::Parse;";
4046 eval "use Text::CSV_XS;";
4049 my $csv = new Text::CSV_XS;
4056 local $SIG{HUP} = 'IGNORE';
4057 local $SIG{INT} = 'IGNORE';
4058 local $SIG{QUIT} = 'IGNORE';
4059 local $SIG{TERM} = 'IGNORE';
4060 local $SIG{TSTP} = 'IGNORE';
4061 local $SIG{PIPE} = 'IGNORE';
4063 my $oldAutoCommit = $FS::UID::AutoCommit;
4064 local $FS::UID::AutoCommit = 0;
4067 #while ( $columns = $csv->getline($fh) ) {
4069 while ( defined($line=<$fh>) ) {
4071 $csv->parse($line) or do {
4072 $dbh->rollback if $oldAutoCommit;
4073 return "can't parse: ". $csv->error_input();
4076 my @columns = $csv->fields();
4077 #warn join('-',@columns);
4080 foreach my $field ( @fields ) {
4081 $row{$field} = shift @columns;
4084 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4085 unless ( $cust_main ) {
4086 $dbh->rollback if $oldAutoCommit;
4087 return "unknown custnum $row{'custnum'}";
4090 if ( $row{'amount'} > 0 ) {
4091 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4093 $dbh->rollback if $oldAutoCommit;
4097 } elsif ( $row{'amount'} < 0 ) {
4098 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4101 $dbh->rollback if $oldAutoCommit;
4111 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4113 return "Empty file!" unless $imported;
4125 The delete method should possibly take an FS::cust_main object reference
4126 instead of a scalar customer number.
4128 Bill and collect options should probably be passed as references instead of a
4131 There should probably be a configuration file with a list of allowed credit
4134 No multiple currency support (probably a larger project than just this module).
4136 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4140 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4141 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4142 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.