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;
46 use FS::cust_tax_exempt_pkg;
48 use FS::payment_gateway;
49 use FS::agent_payment_gateway;
52 @ISA = qw( FS::Record );
54 @EXPORT_OK = qw( smart_search );
56 $realtime_bop_decline_quiet = 0;
58 # 1 is mostly method/subroutine entry and options
59 # 2 traces progress of some operations
60 # 3 is even more information including possibly sensitive data
62 $me = '[FS::cust_main]';
66 $ignore_expired_card = 0;
68 @encrypted_fields = ('payinfo', 'paycvv');
70 #ask FS::UID to run this stuff for us later
71 #$FS::UID::callback{'FS::cust_main'} = sub {
72 install_callback FS::UID sub {
74 #yes, need it for stuff below (prolly should be cached)
79 my ( $hashref, $cache ) = @_;
80 if ( exists $hashref->{'pkgnum'} ) {
81 # #@{ $self->{'_pkgnum'} } = ();
82 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
83 $self->{'_pkgnum'} = $subcache;
84 #push @{ $self->{'_pkgnum'} },
85 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
91 FS::cust_main - Object methods for cust_main records
97 $record = new FS::cust_main \%hash;
98 $record = new FS::cust_main { 'column' => 'value' };
100 $error = $record->insert;
102 $error = $new_record->replace($old_record);
104 $error = $record->delete;
106 $error = $record->check;
108 @cust_pkg = $record->all_pkgs;
110 @cust_pkg = $record->ncancelled_pkgs;
112 @cust_pkg = $record->suspended_pkgs;
114 $error = $record->bill;
115 $error = $record->bill %options;
116 $error = $record->bill 'time' => $time;
118 $error = $record->collect;
119 $error = $record->collect %options;
120 $error = $record->collect 'invoice_time' => $time,
125 An FS::cust_main object represents a customer. FS::cust_main inherits from
126 FS::Record. The following fields are currently supported:
130 =item custnum - primary key (assigned automatically for new customers)
132 =item agentnum - agent (see L<FS::agent>)
134 =item refnum - Advertising source (see L<FS::part_referral>)
140 =item ss - social security number (optional)
142 =item company - (optional)
146 =item address2 - (optional)
150 =item county - (optional, see L<FS::cust_main_county>)
152 =item state - (see L<FS::cust_main_county>)
156 =item country - (see L<FS::cust_main_county>)
158 =item daytime - phone (optional)
160 =item night - phone (optional)
162 =item fax - phone (optional)
164 =item ship_first - name
166 =item ship_last - name
168 =item ship_company - (optional)
172 =item ship_address2 - (optional)
176 =item ship_county - (optional, see L<FS::cust_main_county>)
178 =item ship_state - (see L<FS::cust_main_county>)
182 =item ship_country - (see L<FS::cust_main_county>)
184 =item ship_daytime - phone (optional)
186 =item ship_night - phone (optional)
188 =item ship_fax - phone (optional)
192 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>)
196 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
201 my($self,$payinfo) = @_;
202 if ( defined($payinfo) ) {
203 $self->paymask($payinfo);
204 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
206 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
214 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
218 =item paymask - Masked payment type
224 Mask all but the last four characters.
228 Mask all but last 2 of account number and bank routing number.
232 Do nothing, return the unmasked string.
241 # If it doesn't exist then generate it
242 my $paymask=$self->getfield('paymask');
243 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
244 $value = $self->payinfo;
247 if ( defined($value) && !$self->is_encrypted($value)) {
248 my $payinfo = $value;
249 my $payby = $self->payby;
250 if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
251 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
252 } elsif ($payby eq 'CHEK' ||
253 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
254 my( $account, $aba ) = split('@', $payinfo );
255 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
256 } else { # Tie up loose ends
259 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
260 } elsif (defined($value) && $self->is_encrypted($value)) {
266 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
268 =item paystart_month - start date month (maestro/solo cards only)
270 =item paystart_year - start date year (maestro/solo cards only)
272 =item payissue - issue number (maestro/solo cards only)
274 =item payname - name on card or billing name
276 =item payip - IP address from which payment information was received
278 =item tax - tax exempt, empty or `Y'
280 =item otaker - order taker (assigned automatically, see L<FS::UID>)
282 =item comments - comments (optional)
284 =item referral_custnum - referring customer number
294 Creates a new customer. To add the customer to the database, see L<"insert">.
296 Note that this stores the hash reference, not a distinct copy of the hash it
297 points to. You can ask the object for a copy with the I<hash> method.
301 sub table { 'cust_main'; }
303 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
305 Adds this customer to the database. If there is an error, returns the error,
306 otherwise returns false.
308 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
309 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
310 are inserted atomicly, or the transaction is rolled back. Passing an empty
311 hash reference is equivalent to not supplying this parameter. There should be
312 a better explanation of this, but until then, here's an example:
315 tie %hash, 'Tie::RefHash'; #this part is important
317 $cust_pkg => [ $svc_acct ],
320 $cust_main->insert( \%hash );
322 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
323 be set as the invoicing list (see L<"invoicing_list">). Errors return as
324 expected and rollback the entire transaction; it is not necessary to call
325 check_invoicing_list first. The invoicing_list is set after the records in the
326 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
327 invoicing_list destination to the newly-created svc_acct. Here's an example:
329 $cust_main->insert( {}, [ $email, 'POST' ] );
331 Currently available options are: I<depend_jobnum> and I<noexport>.
333 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
334 on the supplied jobnum (they will not run until the specific job completes).
335 This can be used to defer provisioning until some action completes (such
336 as running the customer's credit card sucessfully).
338 The I<noexport> option is deprecated. If I<noexport> is set true, no
339 provisioning jobs (exports) are scheduled. (You can schedule them later with
340 the B<reexport> method.)
346 my $cust_pkgs = @_ ? shift : {};
347 my $invoicing_list = @_ ? shift : '';
349 warn "$me insert called with options ".
350 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
353 local $SIG{HUP} = 'IGNORE';
354 local $SIG{INT} = 'IGNORE';
355 local $SIG{QUIT} = 'IGNORE';
356 local $SIG{TERM} = 'IGNORE';
357 local $SIG{TSTP} = 'IGNORE';
358 local $SIG{PIPE} = 'IGNORE';
360 my $oldAutoCommit = $FS::UID::AutoCommit;
361 local $FS::UID::AutoCommit = 0;
364 my $prepay_identifier = '';
365 my( $amount, $seconds ) = ( 0, 0 );
367 if ( $self->payby eq 'PREPAY' ) {
369 $self->payby('BILL');
370 $prepay_identifier = $self->payinfo;
373 warn " looking up prepaid card $prepay_identifier\n"
376 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
378 $dbh->rollback if $oldAutoCommit;
379 #return "error applying prepaid card (transaction rolled back): $error";
383 $payby = 'PREP' if $amount;
385 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
388 $self->payby('BILL');
389 $amount = $self->paid;
393 warn " inserting $self\n"
396 my $error = $self->SUPER::insert;
398 $dbh->rollback if $oldAutoCommit;
399 #return "inserting cust_main record (transaction rolled back): $error";
403 warn " setting invoicing list\n"
406 if ( $invoicing_list ) {
407 $error = $self->check_invoicing_list( $invoicing_list );
409 $dbh->rollback if $oldAutoCommit;
410 return "checking invoicing_list (transaction rolled back): $error";
412 $self->invoicing_list( $invoicing_list );
415 warn " ordering packages\n"
418 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
420 $dbh->rollback if $oldAutoCommit;
425 $dbh->rollback if $oldAutoCommit;
426 return "No svc_acct record to apply pre-paid time";
430 warn " inserting initial $payby payment of $amount\n"
432 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
434 $dbh->rollback if $oldAutoCommit;
435 return "inserting payment (transaction rolled back): $error";
439 unless ( $import || $skip_fuzzyfiles ) {
440 warn " queueing fuzzyfiles update\n"
442 $error = $self->queue_fuzzyfiles_update;
444 $dbh->rollback if $oldAutoCommit;
445 return "updating fuzzy search cache: $error";
449 warn " insert complete; committing transaction\n"
452 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
457 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
459 Like the insert method on an existing record, this method orders a package
460 and included services atomicaly. Pass a Tie::RefHash data structure to this
461 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
462 be a better explanation of this, but until then, here's an example:
465 tie %hash, 'Tie::RefHash'; #this part is important
467 $cust_pkg => [ $svc_acct ],
470 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
472 Services can be new, in which case they are inserted, or existing unaudited
473 services, in which case they are linked to the newly-created package.
475 Currently available options are: I<depend_jobnum> and I<noexport>.
477 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
478 on the supplied jobnum (they will not run until the specific job completes).
479 This can be used to defer provisioning until some action completes (such
480 as running the customer's credit card sucessfully).
482 The I<noexport> option is deprecated. If I<noexport> is set true, no
483 provisioning jobs (exports) are scheduled. (You can schedule them later with
484 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
485 on the cust_main object is not recommended, as existing services will also be
492 my $cust_pkgs = shift;
495 my %svc_options = ();
496 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
497 if exists $options{'depend_jobnum'};
498 warn "$me order_pkgs called with options ".
499 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
502 local $SIG{HUP} = 'IGNORE';
503 local $SIG{INT} = 'IGNORE';
504 local $SIG{QUIT} = 'IGNORE';
505 local $SIG{TERM} = 'IGNORE';
506 local $SIG{TSTP} = 'IGNORE';
507 local $SIG{PIPE} = 'IGNORE';
509 my $oldAutoCommit = $FS::UID::AutoCommit;
510 local $FS::UID::AutoCommit = 0;
513 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
515 foreach my $cust_pkg ( keys %$cust_pkgs ) {
516 $cust_pkg->custnum( $self->custnum );
517 my $error = $cust_pkg->insert;
519 $dbh->rollback if $oldAutoCommit;
520 return "inserting cust_pkg (transaction rolled back): $error";
522 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
523 if ( $svc_something->svcnum ) {
524 my $old_cust_svc = $svc_something->cust_svc;
525 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
526 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
527 $error = $new_cust_svc->replace($old_cust_svc);
529 $svc_something->pkgnum( $cust_pkg->pkgnum );
530 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
531 $svc_something->seconds( $svc_something->seconds + $$seconds );
534 $error = $svc_something->insert(%svc_options);
537 $dbh->rollback if $oldAutoCommit;
538 #return "inserting svc_ (transaction rolled back): $error";
544 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
548 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
550 Recharges this (existing) customer with the specified prepaid card (see
551 L<FS::prepay_credit>), specified either by I<identifier> or as an
552 FS::prepay_credit object. If there is an error, returns the error, otherwise
555 Optionally, two scalar references can be passed as well. They will have their
556 values filled in with the amount and number of seconds applied by this prepaid
561 sub recharge_prepay {
562 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
564 local $SIG{HUP} = 'IGNORE';
565 local $SIG{INT} = 'IGNORE';
566 local $SIG{QUIT} = 'IGNORE';
567 local $SIG{TERM} = 'IGNORE';
568 local $SIG{TSTP} = 'IGNORE';
569 local $SIG{PIPE} = 'IGNORE';
571 my $oldAutoCommit = $FS::UID::AutoCommit;
572 local $FS::UID::AutoCommit = 0;
575 my( $amount, $seconds ) = ( 0, 0 );
577 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
578 || $self->increment_seconds($seconds)
579 || $self->insert_cust_pay_prepay( $amount,
581 ? $prepay_credit->identifier
586 $dbh->rollback if $oldAutoCommit;
590 if ( defined($amountref) ) { $$amountref = $amount; }
591 if ( defined($secondsref) ) { $$secondsref = $seconds; }
593 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
598 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
600 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
601 specified either by I<identifier> or as an FS::prepay_credit object.
603 References to I<amount> and I<seconds> scalars should be passed as arguments
604 and will be incremented by the values of the prepaid card.
606 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
607 check or set this customer's I<agentnum>.
609 If there is an error, returns the error, otherwise returns false.
615 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
617 local $SIG{HUP} = 'IGNORE';
618 local $SIG{INT} = 'IGNORE';
619 local $SIG{QUIT} = 'IGNORE';
620 local $SIG{TERM} = 'IGNORE';
621 local $SIG{TSTP} = 'IGNORE';
622 local $SIG{PIPE} = 'IGNORE';
624 my $oldAutoCommit = $FS::UID::AutoCommit;
625 local $FS::UID::AutoCommit = 0;
628 unless ( ref($prepay_credit) ) {
630 my $identifier = $prepay_credit;
632 $prepay_credit = qsearchs(
634 { 'identifier' => $prepay_credit },
639 unless ( $prepay_credit ) {
640 $dbh->rollback if $oldAutoCommit;
641 return "Invalid prepaid card: ". $identifier;
646 if ( $prepay_credit->agentnum ) {
647 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
648 $dbh->rollback if $oldAutoCommit;
649 return "prepaid card not valid for agent ". $self->agentnum;
651 $self->agentnum($prepay_credit->agentnum);
654 my $error = $prepay_credit->delete;
656 $dbh->rollback if $oldAutoCommit;
657 return "removing prepay_credit (transaction rolled back): $error";
660 $$amountref += $prepay_credit->amount;
661 $$secondsref += $prepay_credit->seconds;
663 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
668 =item increment_seconds SECONDS
670 Updates this customer's single or primary account (see L<FS::svc_acct>) by
671 the specified number of seconds. If there is an error, returns the error,
672 otherwise returns false.
676 sub increment_seconds {
677 my( $self, $seconds ) = @_;
678 warn "$me increment_seconds called: $seconds seconds\n"
681 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
682 $self->ncancelled_pkgs;
685 return 'No packages with primary or single services found'.
686 ' to apply pre-paid time';
687 } elsif ( scalar(@cust_pkg) > 1 ) {
688 #maybe have a way to specify the package/account?
689 return 'Multiple packages found to apply pre-paid time';
692 my $cust_pkg = $cust_pkg[0];
693 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
697 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
700 return 'No account found to apply pre-paid time';
701 } elsif ( scalar(@cust_svc) > 1 ) {
702 return 'Multiple accounts found to apply pre-paid time';
705 my $svc_acct = $cust_svc[0]->svc_x;
706 warn " found service svcnum ". $svc_acct->pkgnum.
707 ' ('. $svc_acct->email. ")\n"
710 $svc_acct->increment_seconds($seconds);
714 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
716 Inserts a prepayment in the specified amount for this customer. An optional
717 second argument can specify the prepayment identifier for tracking purposes.
718 If there is an error, returns the error, otherwise returns false.
722 sub insert_cust_pay_prepay {
723 shift->insert_cust_pay('PREP', @_);
726 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
728 Inserts a cash payment in the specified amount for this customer. An optional
729 second argument can specify the payment identifier for tracking purposes.
730 If there is an error, returns the error, otherwise returns false.
734 sub insert_cust_pay_cash {
735 shift->insert_cust_pay('CASH', @_);
738 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
740 Inserts a Western Union payment in the specified amount for this customer. An
741 optional second argument can specify the prepayment identifier for tracking
742 purposes. If there is an error, returns the error, otherwise returns false.
746 sub insert_cust_pay_west {
747 shift->insert_cust_pay('WEST', @_);
750 sub insert_cust_pay {
751 my( $self, $payby, $amount ) = splice(@_, 0, 3);
752 my $payinfo = scalar(@_) ? shift : '';
754 my $cust_pay = new FS::cust_pay {
755 'custnum' => $self->custnum,
756 'paid' => sprintf('%.2f', $amount),
757 #'_date' => #date the prepaid card was purchased???
759 'payinfo' => $payinfo,
767 This method is deprecated. See the I<depend_jobnum> option to the insert and
768 order_pkgs methods for a better way to defer provisioning.
770 Re-schedules all exports by calling the B<reexport> method of all associated
771 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
772 otherwise returns false.
779 carp "WARNING: FS::cust_main::reexport is deprectated; ".
780 "use the depend_jobnum option to insert or order_pkgs to delay export";
782 local $SIG{HUP} = 'IGNORE';
783 local $SIG{INT} = 'IGNORE';
784 local $SIG{QUIT} = 'IGNORE';
785 local $SIG{TERM} = 'IGNORE';
786 local $SIG{TSTP} = 'IGNORE';
787 local $SIG{PIPE} = 'IGNORE';
789 my $oldAutoCommit = $FS::UID::AutoCommit;
790 local $FS::UID::AutoCommit = 0;
793 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
794 my $error = $cust_pkg->reexport;
796 $dbh->rollback if $oldAutoCommit;
801 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
806 =item delete NEW_CUSTNUM
808 This deletes the customer. If there is an error, returns the error, otherwise
811 This will completely remove all traces of the customer record. This is not
812 what you want when a customer cancels service; for that, cancel all of the
813 customer's packages (see L</cancel>).
815 If the customer has any uncancelled packages, you need to pass a new (valid)
816 customer number for those packages to be transferred to. Cancelled packages
817 will be deleted. Did I mention that this is NOT what you want when a customer
818 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
820 You can't delete a customer with invoices (see L<FS::cust_bill>),
821 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
822 refunds (see L<FS::cust_refund>).
829 local $SIG{HUP} = 'IGNORE';
830 local $SIG{INT} = 'IGNORE';
831 local $SIG{QUIT} = 'IGNORE';
832 local $SIG{TERM} = 'IGNORE';
833 local $SIG{TSTP} = 'IGNORE';
834 local $SIG{PIPE} = 'IGNORE';
836 my $oldAutoCommit = $FS::UID::AutoCommit;
837 local $FS::UID::AutoCommit = 0;
840 if ( $self->cust_bill ) {
841 $dbh->rollback if $oldAutoCommit;
842 return "Can't delete a customer with invoices";
844 if ( $self->cust_credit ) {
845 $dbh->rollback if $oldAutoCommit;
846 return "Can't delete a customer with credits";
848 if ( $self->cust_pay ) {
849 $dbh->rollback if $oldAutoCommit;
850 return "Can't delete a customer with payments";
852 if ( $self->cust_refund ) {
853 $dbh->rollback if $oldAutoCommit;
854 return "Can't delete a customer with refunds";
857 my @cust_pkg = $self->ncancelled_pkgs;
859 my $new_custnum = shift;
860 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
861 $dbh->rollback if $oldAutoCommit;
862 return "Invalid new customer number: $new_custnum";
864 foreach my $cust_pkg ( @cust_pkg ) {
865 my %hash = $cust_pkg->hash;
866 $hash{'custnum'} = $new_custnum;
867 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
868 my $error = $new_cust_pkg->replace($cust_pkg);
870 $dbh->rollback if $oldAutoCommit;
875 my @cancelled_cust_pkg = $self->all_pkgs;
876 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
877 my $error = $cust_pkg->delete;
879 $dbh->rollback if $oldAutoCommit;
884 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
885 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
887 my $error = $cust_main_invoice->delete;
889 $dbh->rollback if $oldAutoCommit;
894 my $error = $self->SUPER::delete;
896 $dbh->rollback if $oldAutoCommit;
900 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
905 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
907 Replaces the OLD_RECORD with this one in the database. If there is an error,
908 returns the error, otherwise returns false.
910 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
911 be set as the invoicing list (see L<"invoicing_list">). Errors return as
912 expected and rollback the entire transaction; it is not necessary to call
913 check_invoicing_list first. Here's an example:
915 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
924 local $SIG{HUP} = 'IGNORE';
925 local $SIG{INT} = 'IGNORE';
926 local $SIG{QUIT} = 'IGNORE';
927 local $SIG{TERM} = 'IGNORE';
928 local $SIG{TSTP} = 'IGNORE';
929 local $SIG{PIPE} = 'IGNORE';
931 # If the mask is blank then try to set it - if we can...
932 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
933 $self->paymask($self->payinfo);
936 # We absolutely have to have an old vs. new record to make this work.
937 if (!defined($old)) {
938 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
941 if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
942 && $conf->config('users-allow_comp') ) {
943 return "You are not permitted to create complimentary accounts."
944 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
947 local($ignore_expired_card) = 1
948 if $old->payby =~ /^(CARD|DCRD)$/
949 && $self->payby =~ /^(CARD|DCRD)$/
950 && $old->payinfo eq $self->payinfo;
952 my $oldAutoCommit = $FS::UID::AutoCommit;
953 local $FS::UID::AutoCommit = 0;
956 my $error = $self->SUPER::replace($old);
959 $dbh->rollback if $oldAutoCommit;
963 if ( @param ) { # INVOICING_LIST_ARYREF
964 my $invoicing_list = shift @param;
965 $error = $self->check_invoicing_list( $invoicing_list );
967 $dbh->rollback if $oldAutoCommit;
970 $self->invoicing_list( $invoicing_list );
973 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
974 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
975 # card/check/lec info has changed, want to retry realtime_ invoice events
976 my $error = $self->retry_realtime;
978 $dbh->rollback if $oldAutoCommit;
983 unless ( $import || $skip_fuzzyfiles ) {
984 $error = $self->queue_fuzzyfiles_update;
986 $dbh->rollback if $oldAutoCommit;
987 return "updating fuzzy search cache: $error";
991 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
996 =item queue_fuzzyfiles_update
998 Used by insert & replace to update the fuzzy search cache
1002 sub queue_fuzzyfiles_update {
1005 local $SIG{HUP} = 'IGNORE';
1006 local $SIG{INT} = 'IGNORE';
1007 local $SIG{QUIT} = 'IGNORE';
1008 local $SIG{TERM} = 'IGNORE';
1009 local $SIG{TSTP} = 'IGNORE';
1010 local $SIG{PIPE} = 'IGNORE';
1012 my $oldAutoCommit = $FS::UID::AutoCommit;
1013 local $FS::UID::AutoCommit = 0;
1016 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1017 my $error = $queue->insert($self->getfield('last'), $self->company);
1019 $dbh->rollback if $oldAutoCommit;
1020 return "queueing job (transaction rolled back): $error";
1023 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1024 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1025 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1027 $dbh->rollback if $oldAutoCommit;
1028 return "queueing job (transaction rolled back): $error";
1032 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1039 Checks all fields to make sure this is a valid customer record. If there is
1040 an error, returns the error, otherwise returns false. Called by the insert
1041 and replace methods.
1048 warn "$me check BEFORE: \n". $self->_dump
1052 $self->ut_numbern('custnum')
1053 || $self->ut_number('agentnum')
1054 || $self->ut_number('refnum')
1055 || $self->ut_name('last')
1056 || $self->ut_name('first')
1057 || $self->ut_textn('company')
1058 || $self->ut_text('address1')
1059 || $self->ut_textn('address2')
1060 || $self->ut_text('city')
1061 || $self->ut_textn('county')
1062 || $self->ut_textn('state')
1063 || $self->ut_country('country')
1064 || $self->ut_anything('comments')
1065 || $self->ut_numbern('referral_custnum')
1067 #barf. need message catalogs. i18n. etc.
1068 $error .= "Please select an advertising source."
1069 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1070 return $error if $error;
1072 return "Unknown agent"
1073 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1075 return "Unknown refnum"
1076 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1078 return "Unknown referring custnum: ". $self->referral_custnum
1079 unless ! $self->referral_custnum
1080 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1082 if ( $self->ss eq '' ) {
1087 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1088 or return "Illegal social security number: ". $self->ss;
1089 $self->ss("$1-$2-$3");
1093 # bad idea to disable, causes billing to fail because of no tax rates later
1094 # unless ( $import ) {
1095 unless ( qsearch('cust_main_county', {
1096 'country' => $self->country,
1099 return "Unknown state/county/country: ".
1100 $self->state. "/". $self->county. "/". $self->country
1101 unless qsearch('cust_main_county',{
1102 'state' => $self->state,
1103 'county' => $self->county,
1104 'country' => $self->country,
1110 $self->ut_phonen('daytime', $self->country)
1111 || $self->ut_phonen('night', $self->country)
1112 || $self->ut_phonen('fax', $self->country)
1113 || $self->ut_zip('zip', $self->country)
1115 return $error if $error;
1118 last first company address1 address2 city county state zip
1119 country daytime night fax
1122 if ( defined $self->dbdef_table->column('ship_last') ) {
1123 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1125 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1129 $self->ut_name('ship_last')
1130 || $self->ut_name('ship_first')
1131 || $self->ut_textn('ship_company')
1132 || $self->ut_text('ship_address1')
1133 || $self->ut_textn('ship_address2')
1134 || $self->ut_text('ship_city')
1135 || $self->ut_textn('ship_county')
1136 || $self->ut_textn('ship_state')
1137 || $self->ut_country('ship_country')
1139 return $error if $error;
1141 #false laziness with above
1142 unless ( qsearchs('cust_main_county', {
1143 'country' => $self->ship_country,
1146 return "Unknown ship_state/ship_county/ship_country: ".
1147 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1148 unless qsearch('cust_main_county',{
1149 'state' => $self->ship_state,
1150 'county' => $self->ship_county,
1151 'country' => $self->ship_country,
1157 $self->ut_phonen('ship_daytime', $self->ship_country)
1158 || $self->ut_phonen('ship_night', $self->ship_country)
1159 || $self->ut_phonen('ship_fax', $self->ship_country)
1160 || $self->ut_zip('ship_zip', $self->ship_country)
1162 return $error if $error;
1164 } else { # ship_ info eq billing info, so don't store dup info in database
1165 $self->setfield("ship_$_", '')
1166 foreach qw( last first company address1 address2 city county state zip
1167 country daytime night fax );
1171 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1172 or return "Illegal payby: ". $self->payby;
1174 $error = $self->ut_numbern('paystart_month')
1175 || $self->ut_numbern('paystart_year')
1176 || $self->ut_numbern('payissue')
1178 return $error if $error;
1180 if ( $self->payip eq '' ) {
1183 $error = $self->ut_ip('payip');
1184 return $error if $error;
1187 # If it is encrypted and the private key is not availaible then we can't
1188 # check the credit card.
1190 my $check_payinfo = 1;
1192 if ($self->is_encrypted($self->payinfo)) {
1198 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1200 my $payinfo = $self->payinfo;
1201 $payinfo =~ s/\D//g;
1202 $payinfo =~ /^(\d{13,16})$/
1203 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1205 $self->payinfo($payinfo);
1207 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1209 return gettext('unknown_card_type')
1210 if cardtype($self->payinfo) eq "Unknown";
1212 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1213 return "Banned credit card" if $ban;
1215 if ( defined $self->dbdef_table->column('paycvv') ) {
1216 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1217 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1218 $self->paycvv =~ /^(\d{4})$/
1219 or return "CVV2 (CID) for American Express cards is four digits.";
1222 $self->paycvv =~ /^(\d{3})$/
1223 or return "CVV2 (CVC2/CID) is three digits.";
1231 my $cardtype = cardtype($payinfo);
1232 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1234 return "Start date or issue number is required for $cardtype cards"
1235 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1237 return "Start month must be between 1 and 12"
1238 if $self->paystart_month
1239 and $self->paystart_month < 1 || $self->paystart_month > 12;
1241 return "Start year must be 1990 or later"
1242 if $self->paystart_year
1243 and $self->paystart_year < 1990;
1245 return "Issue number must be beween 1 and 99"
1247 and $self->payissue < 1 || $self->payissue > 99;
1250 $self->paystart_month('');
1251 $self->paystart_year('');
1252 $self->payissue('');
1255 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1257 my $payinfo = $self->payinfo;
1258 $payinfo =~ s/[^\d\@]//g;
1259 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1260 $payinfo = "$1\@$2";
1261 $self->payinfo($payinfo);
1262 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1264 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1265 return "Banned ACH account" if $ban;
1267 } elsif ( $self->payby eq 'LECB' ) {
1269 my $payinfo = $self->payinfo;
1270 $payinfo =~ s/\D//g;
1271 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1273 $self->payinfo($payinfo);
1274 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1276 } elsif ( $self->payby eq 'BILL' ) {
1278 $error = $self->ut_textn('payinfo');
1279 return "Illegal P.O. number: ". $self->payinfo if $error;
1280 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1282 } elsif ( $self->payby eq 'COMP' ) {
1284 if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1285 return "You are not permitted to create complimentary accounts."
1286 unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1289 $error = $self->ut_textn('payinfo');
1290 return "Illegal comp account issuer: ". $self->payinfo if $error;
1291 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1293 } elsif ( $self->payby eq 'PREPAY' ) {
1295 my $payinfo = $self->payinfo;
1296 $payinfo =~ s/\W//g; #anything else would just confuse things
1297 $self->payinfo($payinfo);
1298 $error = $self->ut_alpha('payinfo');
1299 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1300 return "Unknown prepayment identifier"
1301 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1302 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1306 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1307 return "Expriation date required"
1308 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1312 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1313 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1314 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1315 ( $m, $y ) = ( $3, "20$2" );
1317 return "Illegal expiration date: ". $self->paydate;
1319 $self->paydate("$y-$m-01");
1320 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1321 return gettext('expired_card')
1323 && !$ignore_expired_card
1324 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1327 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1328 ( ! $conf->exists('require_cardname')
1329 || $self->payby !~ /^(CARD|DCRD)$/ )
1331 $self->payname( $self->first. " ". $self->getfield('last') );
1333 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1334 or return gettext('illegal_name'). " payname: ". $self->payname;
1338 $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1341 $self->otaker(getotaker) unless $self->otaker;
1343 warn "$me check AFTER: \n". $self->_dump
1346 $self->SUPER::check;
1351 Returns all packages (see L<FS::cust_pkg>) for this customer.
1357 if ( $self->{'_pkgnum'} ) {
1358 values %{ $self->{'_pkgnum'}->cache };
1360 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1364 =item ncancelled_pkgs
1366 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1370 sub ncancelled_pkgs {
1372 if ( $self->{'_pkgnum'} ) {
1373 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1375 @{ [ # force list context
1376 qsearch( 'cust_pkg', {
1377 'custnum' => $self->custnum,
1380 qsearch( 'cust_pkg', {
1381 'custnum' => $self->custnum,
1388 =item suspended_pkgs
1390 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1394 sub suspended_pkgs {
1396 grep { $_->susp } $self->ncancelled_pkgs;
1399 =item unflagged_suspended_pkgs
1401 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1402 customer (thouse packages without the `manual_flag' set).
1406 sub unflagged_suspended_pkgs {
1408 return $self->suspended_pkgs
1409 unless dbdef->table('cust_pkg')->column('manual_flag');
1410 grep { ! $_->manual_flag } $self->suspended_pkgs;
1413 =item unsuspended_pkgs
1415 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1420 sub unsuspended_pkgs {
1422 grep { ! $_->susp } $self->ncancelled_pkgs;
1425 =item num_cancelled_pkgs
1427 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1432 sub num_cancelled_pkgs {
1434 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1438 my( $self, $sql ) = @_;
1439 my $sth = dbh->prepare(
1440 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1441 ) or die dbh->errstr;
1442 $sth->execute($self->custnum) or die $sth->errstr;
1443 $sth->fetchrow_arrayref->[0];
1448 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1449 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1450 on success or a list of errors.
1456 grep { $_->unsuspend } $self->suspended_pkgs;
1461 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1463 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>).
1477 Returns a list: an empty list on success or a list of errors.
1481 sub suspend_if_pkgpart {
1484 grep { $_->suspend }
1485 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1486 $self->unsuspended_pkgs;
1489 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1491 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1492 listed PKGPARTs (see L<FS::part_pkg>).
1494 Returns a list: an empty list on success or a list of errors.
1498 sub suspend_unless_pkgpart {
1501 grep { $_->suspend }
1502 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1503 $self->unsuspended_pkgs;
1506 =item cancel [ OPTION => VALUE ... ]
1508 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1510 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1512 I<quiet> can be set true to supress email cancellation notices.
1514 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1516 I<ban> can be set true to ban this customer's credit card or ACH information,
1519 Always returns a list: an empty list on success or a list of errors.
1527 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1529 #should try decryption (we might have the private key)
1530 # and if not maybe queue a job for the server that does?
1531 return ( "Can't (yet) ban encrypted credit cards" )
1532 if $self->is_encrypted($self->payinfo);
1534 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1535 my $error = $ban->insert;
1536 return ( $error ) if $error;
1540 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1543 sub _banned_pay_hashref {
1554 'payby' => $payby2ban{$self->payby},
1555 'payinfo' => md5_base64($self->payinfo),
1562 Returns the agent (see L<FS::agent>) for this customer.
1568 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1573 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1574 conjunction with the collect method.
1576 Options are passed as name-value pairs.
1578 Currently available options are:
1580 resetup - if set true, re-charges setup fees.
1582 time - bills the customer as if it were that time. Specified as a UNIX
1583 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1584 L<Date::Parse> for conversion functions. For example:
1588 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1591 If there is an error, returns the error, otherwise returns false.
1596 my( $self, %options ) = @_;
1597 return '' if $self->payby eq 'COMP';
1598 warn "$me bill customer ". $self->custnum. "\n"
1601 my $time = $options{'time'} || time;
1606 local $SIG{HUP} = 'IGNORE';
1607 local $SIG{INT} = 'IGNORE';
1608 local $SIG{QUIT} = 'IGNORE';
1609 local $SIG{TERM} = 'IGNORE';
1610 local $SIG{TSTP} = 'IGNORE';
1611 local $SIG{PIPE} = 'IGNORE';
1613 my $oldAutoCommit = $FS::UID::AutoCommit;
1614 local $FS::UID::AutoCommit = 0;
1617 $self->select_for_update; #mutex
1619 #create a new invoice
1620 #(we'll remove it later if it doesn't actually need to be generated [contains
1621 # no line items] and we're inside a transaciton so nothing else will see it)
1622 my $cust_bill = new FS::cust_bill ( {
1623 'custnum' => $self->custnum,
1625 #'charged' => $charged,
1628 $error = $cust_bill->insert;
1630 $dbh->rollback if $oldAutoCommit;
1631 return "can't create invoice for customer #". $self->custnum. ": $error";
1633 my $invnum = $cust_bill->invnum;
1636 # find the packages which are due for billing, find out how much they are
1637 # & generate invoice database.
1640 my( $total_setup, $total_recur ) = ( 0, 0 );
1643 foreach my $cust_pkg (
1644 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1647 #NO!! next if $cust_pkg->cancel;
1648 next if $cust_pkg->getfield('cancel');
1650 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1652 #? to avoid use of uninitialized value errors... ?
1653 $cust_pkg->setfield('bill', '')
1654 unless defined($cust_pkg->bill);
1656 my $part_pkg = $cust_pkg->part_pkg;
1658 my %hash = $cust_pkg->hash;
1659 my $old_cust_pkg = new FS::cust_pkg \%hash;
1668 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1670 warn " bill setup\n" if $DEBUG > 1;
1672 $setup = eval { $cust_pkg->calc_setup( $time ) };
1674 $dbh->rollback if $oldAutoCommit;
1678 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1682 # bill recurring fee
1687 if ( $part_pkg->getfield('freq') ne '0' &&
1688 ! $cust_pkg->getfield('susp') &&
1689 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1692 warn " bill recur\n" if $DEBUG > 1;
1694 # XXX shared with $recur_prog
1695 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1697 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1699 $dbh->rollback if $oldAutoCommit;
1703 #change this bit to use Date::Manip? CAREFUL with timezones (see
1704 # mailing list archive)
1705 my ($sec,$min,$hour,$mday,$mon,$year) =
1706 (localtime($sdate) )[0,1,2,3,4,5];
1708 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1709 # only for figuring next bill date, nothing else, so, reset $sdate again
1711 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1712 $cust_pkg->last_bill($sdate)
1713 if $cust_pkg->dbdef_table->column('last_bill');
1715 if ( $part_pkg->freq =~ /^\d+$/ ) {
1716 $mon += $part_pkg->freq;
1717 until ( $mon < 12 ) { $mon -= 12; $year++; }
1718 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1720 $mday += $weeks * 7;
1721 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1724 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1728 $dbh->rollback if $oldAutoCommit;
1729 return "unparsable frequency: ". $part_pkg->freq;
1731 $cust_pkg->setfield('bill',
1732 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1735 warn "\$setup is undefined" unless defined($setup);
1736 warn "\$recur is undefined" unless defined($recur);
1737 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1740 # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1743 if ( $cust_pkg->modified ) {
1745 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1748 $error=$cust_pkg->replace($old_cust_pkg);
1749 if ( $error ) { #just in case
1750 $dbh->rollback if $oldAutoCommit;
1751 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1754 $setup = sprintf( "%.2f", $setup );
1755 $recur = sprintf( "%.2f", $recur );
1756 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1757 $dbh->rollback if $oldAutoCommit;
1758 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1760 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1761 $dbh->rollback if $oldAutoCommit;
1762 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1765 if ( $setup != 0 || $recur != 0 ) {
1767 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1769 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1770 'invnum' => $invnum,
1771 'pkgnum' => $cust_pkg->pkgnum,
1775 'edate' => $cust_pkg->bill,
1776 'details' => \@details,
1778 $error = $cust_bill_pkg->insert;
1780 $dbh->rollback if $oldAutoCommit;
1781 return "can't create invoice line item for invoice #$invnum: $error";
1783 $total_setup += $setup;
1784 $total_recur += $recur;
1790 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1792 my @taxes = qsearch( 'cust_main_county', {
1793 'state' => $self->state,
1794 'county' => $self->county,
1795 'country' => $self->country,
1796 'taxclass' => $part_pkg->taxclass,
1799 @taxes = qsearch( 'cust_main_county', {
1800 'state' => $self->state,
1801 'county' => $self->county,
1802 'country' => $self->country,
1807 #one more try at a whole-country tax rate
1809 @taxes = qsearch( 'cust_main_county', {
1812 'country' => $self->country,
1817 # maybe eliminate this entirely, along with all the 0% records
1819 $dbh->rollback if $oldAutoCommit;
1821 "fatal: can't find tax rate for state/county/country/taxclass ".
1822 join('/', ( map $self->$_(), qw(state county country) ),
1823 $part_pkg->taxclass ). "\n";
1826 foreach my $tax ( @taxes ) {
1828 my $taxable_charged = 0;
1829 $taxable_charged += $setup
1830 unless $part_pkg->setuptax =~ /^Y$/i
1831 || $tax->setuptax =~ /^Y$/i;
1832 $taxable_charged += $recur
1833 unless $part_pkg->recurtax =~ /^Y$/i
1834 || $tax->recurtax =~ /^Y$/i;
1835 next unless $taxable_charged;
1837 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1838 #my ($mon,$year) = (localtime($sdate) )[4,5];
1839 my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1841 my $freq = $part_pkg->freq || 1;
1842 if ( $freq !~ /(\d+)$/ ) {
1843 $dbh->rollback if $oldAutoCommit;
1844 return "daily/weekly package definitions not (yet?)".
1845 " compatible with monthly tax exemptions";
1847 my $taxable_per_month =
1848 sprintf("%.2f", $taxable_charged / $freq );
1850 #call the whole thing off if this customer has any old
1851 #exemption records...
1852 my @cust_tax_exempt =
1853 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1854 if ( @cust_tax_exempt ) {
1855 $dbh->rollback if $oldAutoCommit;
1857 'this customer still has old-style tax exemption records; '.
1858 'run bin/fs-migrate-cust_tax_exempt?';
1861 foreach my $which_month ( 1 .. $freq ) {
1863 #maintain the new exemption table now
1866 FROM cust_tax_exempt_pkg
1867 LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1868 LEFT JOIN cust_bill USING ( invnum )
1874 my $sth = dbh->prepare($sql) or do {
1875 $dbh->rollback if $oldAutoCommit;
1876 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1884 $dbh->rollback if $oldAutoCommit;
1885 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1887 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1889 my $remaining_exemption =
1890 $tax->exempt_amount - $existing_exemption;
1891 if ( $remaining_exemption > 0 ) {
1892 my $addl = $remaining_exemption > $taxable_per_month
1893 ? $taxable_per_month
1894 : $remaining_exemption;
1895 $taxable_charged -= $addl;
1897 my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1898 'billpkgnum' => $cust_bill_pkg->billpkgnum,
1899 'taxnum' => $tax->taxnum,
1900 'year' => 1900+$year,
1902 'amount' => sprintf("%.2f", $addl ),
1904 $error = $cust_tax_exempt_pkg->insert;
1906 $dbh->rollback if $oldAutoCommit;
1907 return "fatal: can't insert cust_tax_exempt_pkg: $error";
1909 } # if $remaining_exemption > 0
1913 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1914 until ( $mon < 13 ) { $mon -= 12; $year++; }
1916 } #foreach $which_month
1918 } #if $tax->exempt_amount
1920 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1922 #$tax += $taxable_charged * $cust_main_county->tax / 100
1923 $tax{ $tax->taxname || 'Tax' } +=
1924 $taxable_charged * $tax->tax / 100
1926 } #foreach my $tax ( @taxes )
1928 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1930 } #if $setup != 0 || $recur != 0
1932 } #if $cust_pkg->modified
1934 } #foreach my $cust_pkg
1936 unless ( $cust_bill->cust_bill_pkg ) {
1937 $cust_bill->delete; #don't create an invoice w/o line items
1938 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1942 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1944 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1945 my $tax = sprintf("%.2f", $tax{$taxname} );
1946 $charged = sprintf( "%.2f", $charged+$tax );
1948 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1949 'invnum' => $invnum,
1955 'itemdesc' => $taxname,
1957 $error = $cust_bill_pkg->insert;
1959 $dbh->rollback if $oldAutoCommit;
1960 return "can't create invoice line item for invoice #$invnum: $error";
1962 $total_setup += $tax;
1966 $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1967 $error = $cust_bill->replace;
1969 $dbh->rollback if $oldAutoCommit;
1970 return "can't update charged for invoice #$invnum: $error";
1973 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1977 =item collect OPTIONS
1979 (Attempt to) collect money for this customer's outstanding invoices (see
1980 L<FS::cust_bill>). Usually used after the bill method.
1982 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1983 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1984 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1986 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1987 and the invoice events web interface.
1989 If there is an error, returns the error, otherwise returns false.
1991 Options are passed as name-value pairs.
1993 Currently available options are:
1995 invoice_time - Use this time when deciding when to print invoices and
1996 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>
1997 for conversion functions.
1999 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2002 quiet - set true to surpress email card/ACH decline notices.
2004 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2010 my( $self, %options ) = @_;
2011 my $invoice_time = $options{'invoice_time'} || time;
2014 local $SIG{HUP} = 'IGNORE';
2015 local $SIG{INT} = 'IGNORE';
2016 local $SIG{QUIT} = 'IGNORE';
2017 local $SIG{TERM} = 'IGNORE';
2018 local $SIG{TSTP} = 'IGNORE';
2019 local $SIG{PIPE} = 'IGNORE';
2021 my $oldAutoCommit = $FS::UID::AutoCommit;
2022 local $FS::UID::AutoCommit = 0;
2025 $self->select_for_update; #mutex
2027 my $balance = $self->balance;
2028 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2030 unless ( $balance > 0 ) { #redundant?????
2031 $dbh->rollback if $oldAutoCommit; #hmm
2035 if ( exists($options{'retry_card'}) ) {
2036 carp 'retry_card option passed to collect is deprecated; use retry';
2037 $options{'retry'} ||= $options{'retry_card'};
2039 if ( exists($options{'retry'}) && $options{'retry'} ) {
2040 my $error = $self->retry_realtime;
2042 $dbh->rollback if $oldAutoCommit;
2048 if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2049 $extra_sql = " AND freq = '1m' ";
2051 $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2054 foreach my $cust_bill ( $self->open_cust_bill ) {
2056 # don't try to charge for the same invoice if it's already in a batch
2057 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2059 last if $self->balance <= 0;
2061 warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2064 foreach my $part_bill_event (
2065 sort { $a->seconds <=> $b->seconds
2066 || $a->weight <=> $b->weight
2067 || $a->eventpart <=> $b->eventpart }
2068 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2069 && ! qsearch( 'cust_bill_event', {
2070 'invnum' => $cust_bill->invnum,
2071 'eventpart' => $_->eventpart,
2076 'table' => 'part_bill_event',
2077 'hashref' => { 'payby' => $self->payby,
2078 'disabled' => '', },
2079 'extra_sql' => $extra_sql,
2083 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2084 || $self->balance <= 0; # or if balance<=0
2086 warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
2088 my $cust_main = $self; #for callback
2092 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2093 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2094 $error = eval $part_bill_event->eventcode;
2098 my $statustext = '';
2102 } elsif ( $error ) {
2104 $statustext = $error;
2109 #add cust_bill_event
2110 my $cust_bill_event = new FS::cust_bill_event {
2111 'invnum' => $cust_bill->invnum,
2112 'eventpart' => $part_bill_event->eventpart,
2113 #'_date' => $invoice_time,
2115 'status' => $status,
2116 'statustext' => $statustext,
2118 $error = $cust_bill_event->insert;
2120 #$dbh->rollback if $oldAutoCommit;
2121 #return "error: $error";
2123 # gah, even with transactions.
2124 $dbh->commit if $oldAutoCommit; #well.
2125 my $e = 'WARNING: Event run but database not updated - '.
2126 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2127 ', eventpart '. $part_bill_event->eventpart.
2138 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2143 =item retry_realtime
2145 Schedules realtime credit card / electronic check / LEC billing events for
2146 for retry. Useful if card information has changed or manual retry is desired.
2147 The 'collect' method must be called to actually retry the transaction.
2149 Implementation details: For each of this customer's open invoices, changes
2150 the status of the first "done" (with statustext error) realtime processing
2155 sub retry_realtime {
2158 local $SIG{HUP} = 'IGNORE';
2159 local $SIG{INT} = 'IGNORE';
2160 local $SIG{QUIT} = 'IGNORE';
2161 local $SIG{TERM} = 'IGNORE';
2162 local $SIG{TSTP} = 'IGNORE';
2163 local $SIG{PIPE} = 'IGNORE';
2165 my $oldAutoCommit = $FS::UID::AutoCommit;
2166 local $FS::UID::AutoCommit = 0;
2169 foreach my $cust_bill (
2170 grep { $_->cust_bill_event }
2171 $self->open_cust_bill
2173 my @cust_bill_event =
2174 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2176 #$_->part_bill_event->plan eq 'realtime-card'
2177 $_->part_bill_event->eventcode =~
2178 /\$cust_bill\->realtime_(card|ach|lec)/
2179 && $_->status eq 'done'
2182 $cust_bill->cust_bill_event;
2183 next unless @cust_bill_event;
2184 my $error = $cust_bill_event[0]->retry;
2186 $dbh->rollback if $oldAutoCommit;
2187 return "error scheduling invoice event for retry: $error";
2192 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2197 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2199 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2200 via a Business::OnlinePayment realtime gateway. See
2201 L<http://420.am/business-onlinepayment> for supported gateways.
2203 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2205 Available options are: I<description>, I<invnum>, I<quiet>
2207 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2208 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2209 if set, will override the value from the customer record.
2211 I<description> is a free-text field passed to the gateway. It defaults to
2212 "Internet services".
2214 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2215 specified invoice. If you don't specify an I<invnum> you might want to
2216 call the B<apply_payments> method.
2218 I<quiet> can be set true to surpress email decline notices.
2220 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2225 my( $self, $method, $amount, %options ) = @_;
2227 warn "$me realtime_bop: $method $amount\n";
2228 warn " $_ => $options{$_}\n" foreach keys %options;
2231 $options{'description'} ||= 'Internet services';
2233 eval "use Business::OnlinePayment";
2236 my $payinfo = exists($options{'payinfo'})
2237 ? $options{'payinfo'}
2245 if ( $options{'invnum'} ) {
2246 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2247 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2249 map { $_->part_pkg->taxclass }
2251 map { $_->cust_pkg }
2252 $cust_bill->cust_bill_pkg;
2253 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2254 #different taxclasses
2255 $taxclass = $taxclasses[0];
2259 #look for an agent gateway override first
2261 if ( $method eq 'CC' ) {
2262 $cardtype = cardtype($payinfo);
2263 } elsif ( $method eq 'ECHECK' ) {
2266 $cardtype = $method;
2270 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2271 cardtype => $cardtype,
2272 taxclass => $taxclass, } )
2273 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2275 taxclass => $taxclass, } )
2276 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2277 cardtype => $cardtype,
2279 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2281 taxclass => '', } );
2283 my $payment_gateway = '';
2284 my( $processor, $login, $password, $action, @bop_options );
2285 if ( $override ) { #use a payment gateway override
2287 $payment_gateway = $override->payment_gateway;
2289 $processor = $payment_gateway->gateway_module;
2290 $login = $payment_gateway->gateway_username;
2291 $password = $payment_gateway->gateway_password;
2292 $action = $payment_gateway->gateway_action;
2293 @bop_options = $payment_gateway->options;
2295 } else { #use the standard settings from the config
2297 ( $processor, $login, $password, $action, @bop_options ) =
2298 $self->default_payment_gateway($method);
2306 my $address = exists($options{'address1'})
2307 ? $options{'address1'}
2309 my $address2 = exists($options{'address2'})
2310 ? $options{'address2'}
2312 $address .= ", ". $address2 if length($address2);
2314 my $o_payname = exists($options{'payname'})
2315 ? $options{'payname'}
2317 my($payname, $payfirst, $paylast);
2318 if ( $o_payname && $method ne 'ECHECK' ) {
2319 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2320 or return "Illegal payname $payname";
2321 ($payfirst, $paylast) = ($1, $2);
2323 $payfirst = $self->getfield('first');
2324 $paylast = $self->getfield('last');
2325 $payname = "$payfirst $paylast";
2328 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2329 if ( $conf->exists('emailinvoiceauto')
2330 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2331 push @invoicing_list, $self->all_emails;
2334 my $email = ($conf->exists('business-onlinepayment-email-override'))
2335 ? $conf->config('business-onlinepayment-email-override')
2336 : $invoicing_list[0];
2340 my $payip = exists($options{'payip'})
2343 $content{customer_ip} = $payip
2346 if ( $method eq 'CC' ) {
2348 $content{card_number} = $payinfo;
2349 my $paydate = exists($options{'paydate'})
2350 ? $options{'paydate'}
2352 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2353 $content{expiration} = "$2/$1";
2355 my $paycvv = exists($options{'paycvv'})
2356 ? $options{'paycvv'}
2358 $content{cvv2} = $self->paycvv
2361 my $paystart_month = exists($options{'paystart_month'})
2362 ? $options{'paystart_month'}
2363 : $self->paystart_month;
2365 my $paystart_year = exists($options{'paystart_year'})
2366 ? $options{'paystart_year'}
2367 : $self->paystart_year;
2369 $content{card_start} = "$paystart_month/$paystart_year"
2370 if $paystart_month && $paystart_year;
2372 my $payissue = exists($options{'payissue'})
2373 ? $options{'payissue'}
2375 $content{issue_number} = $payissue if $payissue;
2377 $content{recurring_billing} = 'YES'
2378 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2380 'payinfo' => $payinfo,
2383 } elsif ( $method eq 'ECHECK' ) {
2384 ( $content{account_number}, $content{routing_code} ) =
2385 split('@', $payinfo);
2386 $content{bank_name} = $o_payname;
2387 $content{account_type} = 'CHECKING';
2388 $content{account_name} = $payname;
2389 $content{customer_org} = $self->company ? 'B' : 'I';
2390 $content{customer_ssn} = exists($options{'ss'})
2393 } elsif ( $method eq 'LEC' ) {
2394 $content{phone} = $payinfo;
2398 # run transaction(s)
2401 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2403 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2404 $transaction->content(
2407 'password' => $password,
2408 'action' => $action1,
2409 'description' => $options{'description'},
2410 'amount' => $amount,
2411 'invoice_number' => $options{'invnum'},
2412 'customer_id' => $self->custnum,
2413 'last_name' => $paylast,
2414 'first_name' => $payfirst,
2416 'address' => $address,
2417 'city' => ( exists($options{'city'})
2420 'state' => ( exists($options{'state'})
2423 'zip' => ( exists($options{'zip'})
2426 'country' => ( exists($options{'country'})
2427 ? $options{'country'}
2429 'referer' => 'http://cleanwhisker.420.am/',
2431 'phone' => $self->daytime || $self->night,
2434 $transaction->submit();
2436 if ( $transaction->is_success() && $action2 ) {
2437 my $auth = $transaction->authorization;
2438 my $ordernum = $transaction->can('order_number')
2439 ? $transaction->order_number
2443 new Business::OnlinePayment( $processor, @bop_options );
2450 password => $password,
2451 order_number => $ordernum,
2453 authorization => $auth,
2454 description => $options{'description'},
2457 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2458 transaction_sequence_num local_transaction_date
2459 local_transaction_time AVS_result_code )) {
2460 $capture{$field} = $transaction->$field() if $transaction->can($field);
2463 $capture->content( %capture );
2467 unless ( $capture->is_success ) {
2468 my $e = "Authorization sucessful but capture failed, custnum #".
2469 $self->custnum. ': '. $capture->result_code.
2470 ": ". $capture->error_message;
2478 # remove paycvv after initial transaction
2481 #false laziness w/misc/process/payment.cgi - check both to make sure working
2483 if ( defined $self->dbdef_table->column('paycvv')
2484 && length($self->paycvv)
2485 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2487 my $error = $self->remove_cvv;
2489 warn "WARNING: error removing cvv: $error\n";
2497 if ( $transaction->is_success() ) {
2499 my %method2payby = (
2506 if ( $payment_gateway ) { # agent override
2507 $paybatch = $payment_gateway->gatewaynum. '-';
2510 $paybatch .= "$processor:". $transaction->authorization;
2512 $paybatch .= ':'. $transaction->order_number
2513 if $transaction->can('order_number')
2514 && length($transaction->order_number);
2516 my $cust_pay = new FS::cust_pay ( {
2517 'custnum' => $self->custnum,
2518 'invnum' => $options{'invnum'},
2521 'payby' => $method2payby{$method},
2522 'payinfo' => $payinfo,
2523 'paybatch' => $paybatch,
2525 my $error = $cust_pay->insert;
2527 $cust_pay->invnum(''); #try again with no specific invnum
2528 my $error2 = $cust_pay->insert;
2530 # gah, even with transactions.
2531 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2532 "error inserting payment ($processor): $error2".
2533 " (previously tried insert with invnum #$options{'invnum'}" .
2539 return ''; #no error
2543 my $perror = "$processor error: ". $transaction->error_message;
2545 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2546 && $conf->exists('emaildecline')
2547 && grep { $_ ne 'POST' } $self->invoicing_list
2548 && ! grep { $transaction->error_message =~ /$_/ }
2549 $conf->config('emaildecline-exclude')
2551 my @templ = $conf->config('declinetemplate');
2552 my $template = new Text::Template (
2554 SOURCE => [ map "$_\n", @templ ],
2555 ) or return "($perror) can't create template: $Text::Template::ERROR";
2556 $template->compile()
2557 or return "($perror) can't compile template: $Text::Template::ERROR";
2559 my $templ_hash = { error => $transaction->error_message };
2561 my $error = send_email(
2562 'from' => $conf->config('invoice_from'),
2563 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2564 'subject' => 'Your payment could not be processed',
2565 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2568 $perror .= " (also received error sending decline notification: $error)"
2578 =item default_payment_gateway
2582 sub default_payment_gateway {
2583 my( $self, $method ) = @_;
2585 die "Real-time processing not enabled\n"
2586 unless $conf->exists('business-onlinepayment');
2589 my $bop_config = 'business-onlinepayment';
2590 $bop_config .= '-ach'
2591 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2592 my ( $processor, $login, $password, $action, @bop_options ) =
2593 $conf->config($bop_config);
2594 $action ||= 'normal authorization';
2595 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2596 die "No real-time processor is enabled - ".
2597 "did you set the business-onlinepayment configuration value?\n"
2600 ( $processor, $login, $password, $action, @bop_options )
2605 Removes the I<paycvv> field from the database directly.
2607 If there is an error, returns the error, otherwise returns false.
2613 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2614 or return dbh->errstr;
2615 $sth->execute($self->custnum)
2616 or return $sth->errstr;
2621 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2623 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2624 via a Business::OnlinePayment realtime gateway. See
2625 L<http://420.am/business-onlinepayment> for supported gateways.
2627 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2629 Available options are: I<amount>, I<reason>, I<paynum>
2631 Most gateways require a reference to an original payment transaction to refund,
2632 so you probably need to specify a I<paynum>.
2634 I<amount> defaults to the original amount of the payment if not specified.
2636 I<reason> specifies a reason for the refund.
2638 Implementation note: If I<amount> is unspecified or equal to the amount of the
2639 orignal payment, first an attempt is made to "void" the transaction via
2640 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2641 the normal attempt is made to "refund" ("credit") the transaction via the
2642 gateway is attempted.
2644 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2645 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2646 #if set, will override the value from the customer record.
2648 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2649 #specified invoice. If you don't specify an I<invnum> you might want to
2650 #call the B<apply_payments> method.
2654 #some false laziness w/realtime_bop, not enough to make it worth merging
2655 #but some useful small subs should be pulled out
2656 sub realtime_refund_bop {
2657 my( $self, $method, %options ) = @_;
2659 warn "$me realtime_refund_bop: $method refund\n";
2660 warn " $_ => $options{$_}\n" foreach keys %options;
2663 eval "use Business::OnlinePayment";
2667 # look up the original payment and optionally a gateway for that payment
2671 my $amount = $options{'amount'};
2673 my( $processor, $login, $password, @bop_options ) ;
2674 my( $auth, $order_number ) = ( '', '', '' );
2676 if ( $options{'paynum'} ) {
2678 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
2679 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2680 or return "Unknown paynum $options{'paynum'}";
2681 $amount ||= $cust_pay->paid;
2683 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2684 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2685 $cust_pay->paybatch;
2686 my $gatewaynum = '';
2687 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2689 if ( $gatewaynum ) { #gateway for the payment to be refunded
2691 my $payment_gateway =
2692 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2693 die "payment gateway $gatewaynum not found"
2694 unless $payment_gateway;
2696 $processor = $payment_gateway->gateway_module;
2697 $login = $payment_gateway->gateway_username;
2698 $password = $payment_gateway->gateway_password;
2699 @bop_options = $payment_gateway->options;
2701 } else { #try the default gateway
2703 my( $conf_processor, $unused_action );
2704 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2705 $self->default_payment_gateway($method);
2707 return "processor of payment $options{'paynum'} $processor does not".
2708 " match default processor $conf_processor"
2709 unless $processor eq $conf_processor;
2714 } else { # didn't specify a paynum, so look for agent gateway overrides
2715 # like a normal transaction
2718 if ( $method eq 'CC' ) {
2719 $cardtype = cardtype($self->payinfo);
2720 } elsif ( $method eq 'ECHECK' ) {
2723 $cardtype = $method;
2726 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2727 cardtype => $cardtype,
2729 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2731 taxclass => '', } );
2733 if ( $override ) { #use a payment gateway override
2735 my $payment_gateway = $override->payment_gateway;
2737 $processor = $payment_gateway->gateway_module;
2738 $login = $payment_gateway->gateway_username;
2739 $password = $payment_gateway->gateway_password;
2740 #$action = $payment_gateway->gateway_action;
2741 @bop_options = $payment_gateway->options;
2743 } else { #use the standard settings from the config
2746 ( $processor, $login, $password, $unused_action, @bop_options ) =
2747 $self->default_payment_gateway($method);
2752 return "neither amount nor paynum specified" unless $amount;
2757 'password' => $password,
2758 'order_number' => $order_number,
2759 'amount' => $amount,
2760 'referer' => 'http://cleanwhisker.420.am/',
2762 $content{authorization} = $auth
2763 if length($auth); #echeck/ACH transactions have an order # but no auth
2764 #(at least with authorize.net)
2766 #first try void if applicable
2767 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2768 warn " attempting void\n" if $DEBUG > 1;
2769 my $void = new Business::OnlinePayment( $processor, @bop_options );
2770 $void->content( 'action' => 'void', %content );
2772 if ( $void->is_success ) {
2773 my $error = $cust_pay->void($options{'reason'});
2775 # gah, even with transactions.
2776 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2777 "error voiding payment: $error";
2781 warn " void successful\n" if $DEBUG > 1;
2786 warn " void unsuccessful, trying refund\n"
2790 my $address = $self->address1;
2791 $address .= ", ". $self->address2 if $self->address2;
2793 my($payname, $payfirst, $paylast);
2794 if ( $self->payname && $method ne 'ECHECK' ) {
2795 $payname = $self->payname;
2796 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2797 or return "Illegal payname $payname";
2798 ($payfirst, $paylast) = ($1, $2);
2800 $payfirst = $self->getfield('first');
2801 $paylast = $self->getfield('last');
2802 $payname = "$payfirst $paylast";
2806 if ( $method eq 'CC' ) {
2809 $content{card_number} = $payinfo = $cust_pay->payinfo;
2810 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2811 #$content{expiration} = "$2/$1";
2813 $content{card_number} = $payinfo = $self->payinfo;
2814 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2815 $content{expiration} = "$2/$1";
2818 } elsif ( $method eq 'ECHECK' ) {
2819 ( $content{account_number}, $content{routing_code} ) =
2820 split('@', $payinfo = $self->payinfo);
2821 $content{bank_name} = $self->payname;
2822 $content{account_type} = 'CHECKING';
2823 $content{account_name} = $payname;
2824 $content{customer_org} = $self->company ? 'B' : 'I';
2825 $content{customer_ssn} = $self->ss;
2826 } elsif ( $method eq 'LEC' ) {
2827 $content{phone} = $payinfo = $self->payinfo;
2831 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2832 my %sub_content = $refund->content(
2833 'action' => 'credit',
2834 'customer_id' => $self->custnum,
2835 'last_name' => $paylast,
2836 'first_name' => $payfirst,
2838 'address' => $address,
2839 'city' => $self->city,
2840 'state' => $self->state,
2841 'zip' => $self->zip,
2842 'country' => $self->country,
2845 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2849 return "$processor error: ". $refund->error_message
2850 unless $refund->is_success();
2852 my %method2payby = (
2858 my $paybatch = "$processor:". $refund->authorization;
2859 $paybatch .= ':'. $refund->order_number
2860 if $refund->can('order_number') && $refund->order_number;
2862 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2863 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2864 last unless @cust_bill_pay;
2865 my $cust_bill_pay = pop @cust_bill_pay;
2866 my $error = $cust_bill_pay->delete;
2870 my $cust_refund = new FS::cust_refund ( {
2871 'custnum' => $self->custnum,
2872 'paynum' => $options{'paynum'},
2873 'refund' => $amount,
2875 'payby' => $method2payby{$method},
2876 'payinfo' => $payinfo,
2877 'paybatch' => $paybatch,
2878 'reason' => $options{'reason'} || 'card or ACH refund',
2880 my $error = $cust_refund->insert;
2882 $cust_refund->paynum(''); #try again with no specific paynum
2883 my $error2 = $cust_refund->insert;
2885 # gah, even with transactions.
2886 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2887 "error inserting refund ($processor): $error2".
2888 " (previously tried insert with paynum #$options{'paynum'}" .
2901 Returns the total owed for this customer on all invoices
2902 (see L<FS::cust_bill/owed>).
2908 $self->total_owed_date(2145859200); #12/31/2037
2911 =item total_owed_date TIME
2913 Returns the total owed for this customer on all invoices with date earlier than
2914 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2915 see L<Time::Local> and L<Date::Parse> for conversion functions.
2919 sub total_owed_date {
2923 foreach my $cust_bill (
2924 grep { $_->_date <= $time }
2925 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2927 $total_bill += $cust_bill->owed;
2929 sprintf( "%.2f", $total_bill );
2932 =item apply_credits OPTION => VALUE ...
2934 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2935 to outstanding invoice balances in chronological order (or reverse
2936 chronological order if the I<order> option is set to B<newest>) and returns the
2937 value of any remaining unapplied credits available for refund (see
2938 L<FS::cust_refund>).
2946 return 0 unless $self->total_credited;
2948 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2949 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2951 my @invoices = $self->open_cust_bill;
2952 @invoices = sort { $b->_date <=> $a->_date } @invoices
2953 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2956 foreach my $cust_bill ( @invoices ) {
2959 if ( !defined($credit) || $credit->credited == 0) {
2960 $credit = pop @credits or last;
2963 if ($cust_bill->owed >= $credit->credited) {
2964 $amount=$credit->credited;
2966 $amount=$cust_bill->owed;
2969 my $cust_credit_bill = new FS::cust_credit_bill ( {
2970 'crednum' => $credit->crednum,
2971 'invnum' => $cust_bill->invnum,
2972 'amount' => $amount,
2974 my $error = $cust_credit_bill->insert;
2975 die $error if $error;
2977 redo if ($cust_bill->owed > 0);
2981 return $self->total_credited;
2984 =item apply_payments
2986 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2987 to outstanding invoice balances in chronological order.
2989 #and returns the value of any remaining unapplied payments.
2993 sub apply_payments {
2998 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2999 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3001 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3002 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3006 foreach my $cust_bill ( @invoices ) {
3009 if ( !defined($payment) || $payment->unapplied == 0 ) {
3010 $payment = pop @payments or last;
3013 if ( $cust_bill->owed >= $payment->unapplied ) {
3014 $amount = $payment->unapplied;
3016 $amount = $cust_bill->owed;
3019 my $cust_bill_pay = new FS::cust_bill_pay ( {
3020 'paynum' => $payment->paynum,
3021 'invnum' => $cust_bill->invnum,
3022 'amount' => $amount,
3024 my $error = $cust_bill_pay->insert;
3025 die $error if $error;
3027 redo if ( $cust_bill->owed > 0);
3031 return $self->total_unapplied_payments;
3034 =item total_credited
3036 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3037 customer. See L<FS::cust_credit/credited>.
3041 sub total_credited {
3043 my $total_credit = 0;
3044 foreach my $cust_credit ( qsearch('cust_credit', {
3045 'custnum' => $self->custnum,
3047 $total_credit += $cust_credit->credited;
3049 sprintf( "%.2f", $total_credit );
3052 =item total_unapplied_payments
3054 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3055 See L<FS::cust_pay/unapplied>.
3059 sub total_unapplied_payments {
3061 my $total_unapplied = 0;
3062 foreach my $cust_pay ( qsearch('cust_pay', {
3063 'custnum' => $self->custnum,
3065 $total_unapplied += $cust_pay->unapplied;
3067 sprintf( "%.2f", $total_unapplied );
3072 Returns the balance for this customer (total_owed minus total_credited
3073 minus total_unapplied_payments).
3080 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3084 =item balance_date TIME
3086 Returns the balance for this customer, only considering invoices with date
3087 earlier than TIME (total_owed_date minus total_credited minus
3088 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3089 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3098 $self->total_owed_date($time)
3099 - $self->total_credited
3100 - $self->total_unapplied_payments
3104 =item paydate_monthyear
3106 Returns a two-element list consisting of the month and year of this customer's
3107 paydate (credit card expiration date for CARD customers)
3111 sub paydate_monthyear {
3113 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3115 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3122 =item payinfo_masked
3124 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.
3126 Credit Cards - Mask all but the last four characters.
3127 Checks - Mask all but last 2 of account number and bank routing number.
3128 Others - Do nothing, return the unmasked string.
3132 sub payinfo_masked {
3134 return $self->paymask;
3137 =item invoicing_list [ ARRAYREF ]
3139 If an arguement is given, sets these email addresses as invoice recipients
3140 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3141 (except as warnings), so use check_invoicing_list first.
3143 Returns a list of email addresses (with svcnum entries expanded).
3145 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3146 check it without disturbing anything by passing nothing.
3148 This interface may change in the future.
3152 sub invoicing_list {
3153 my( $self, $arrayref ) = @_;
3155 my @cust_main_invoice;
3156 if ( $self->custnum ) {
3157 @cust_main_invoice =
3158 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3160 @cust_main_invoice = ();
3162 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3163 #warn $cust_main_invoice->destnum;
3164 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3165 #warn $cust_main_invoice->destnum;
3166 my $error = $cust_main_invoice->delete;
3167 warn $error if $error;
3170 if ( $self->custnum ) {
3171 @cust_main_invoice =
3172 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3174 @cust_main_invoice = ();
3176 my %seen = map { $_->address => 1 } @cust_main_invoice;
3177 foreach my $address ( @{$arrayref} ) {
3178 next if exists $seen{$address} && $seen{$address};
3179 $seen{$address} = 1;
3180 my $cust_main_invoice = new FS::cust_main_invoice ( {
3181 'custnum' => $self->custnum,
3184 my $error = $cust_main_invoice->insert;
3185 warn $error if $error;
3188 if ( $self->custnum ) {
3190 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3196 =item check_invoicing_list ARRAYREF
3198 Checks these arguements as valid input for the invoicing_list method. If there
3199 is an error, returns the error, otherwise returns false.
3203 sub check_invoicing_list {
3204 my( $self, $arrayref ) = @_;
3205 foreach my $address ( @{$arrayref} ) {
3207 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3208 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3211 my $cust_main_invoice = new FS::cust_main_invoice ( {
3212 'custnum' => $self->custnum,
3215 my $error = $self->custnum
3216 ? $cust_main_invoice->check
3217 : $cust_main_invoice->checkdest
3219 return $error if $error;
3224 =item set_default_invoicing_list
3226 Sets the invoicing list to all accounts associated with this customer,
3227 overwriting any previous invoicing list.
3231 sub set_default_invoicing_list {
3233 $self->invoicing_list($self->all_emails);
3238 Returns the email addresses of all accounts provisioned for this customer.
3245 foreach my $cust_pkg ( $self->all_pkgs ) {
3246 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3248 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3249 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3251 $list{$_}=1 foreach map { $_->email } @svc_acct;
3256 =item invoicing_list_addpost
3258 Adds postal invoicing to this customer. If this customer is already configured
3259 to receive postal invoices, does nothing.
3263 sub invoicing_list_addpost {
3265 return if grep { $_ eq 'POST' } $self->invoicing_list;
3266 my @invoicing_list = $self->invoicing_list;
3267 push @invoicing_list, 'POST';
3268 $self->invoicing_list(\@invoicing_list);
3271 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3273 Returns an array of customers referred by this customer (referral_custnum set
3274 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3275 customers referred by customers referred by this customer and so on, inclusive.
3276 The default behavior is DEPTH 1 (no recursion).
3280 sub referral_cust_main {
3282 my $depth = @_ ? shift : 1;
3283 my $exclude = @_ ? shift : {};
3286 map { $exclude->{$_->custnum}++; $_; }
3287 grep { ! $exclude->{ $_->custnum } }
3288 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3292 map { $_->referral_cust_main($depth-1, $exclude) }
3299 =item referral_cust_main_ncancelled
3301 Same as referral_cust_main, except only returns customers with uncancelled
3306 sub referral_cust_main_ncancelled {
3308 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3311 =item referral_cust_pkg [ DEPTH ]
3313 Like referral_cust_main, except returns a flat list of all unsuspended (and
3314 uncancelled) packages for each customer. The number of items in this list may
3315 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3319 sub referral_cust_pkg {
3321 my $depth = @_ ? shift : 1;
3323 map { $_->unsuspended_pkgs }
3324 grep { $_->unsuspended_pkgs }
3325 $self->referral_cust_main($depth);
3328 =item referring_cust_main
3330 Returns the single cust_main record for the customer who referred this customer
3331 (referral_custnum), or false.
3335 sub referring_cust_main {
3337 return '' unless $self->referral_custnum;
3338 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3341 =item credit AMOUNT, REASON
3343 Applies a credit to this customer. If there is an error, returns the error,
3344 otherwise returns false.
3349 my( $self, $amount, $reason ) = @_;
3350 my $cust_credit = new FS::cust_credit {
3351 'custnum' => $self->custnum,
3352 'amount' => $amount,
3353 'reason' => $reason,
3355 $cust_credit->insert;
3358 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3360 Creates a one-time charge for this customer. If there is an error, returns
3361 the error, otherwise returns false.
3366 my ( $self, $amount ) = ( shift, shift );
3367 my $pkg = @_ ? shift : 'One-time charge';
3368 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3369 my $taxclass = @_ ? shift : '';
3371 local $SIG{HUP} = 'IGNORE';
3372 local $SIG{INT} = 'IGNORE';
3373 local $SIG{QUIT} = 'IGNORE';
3374 local $SIG{TERM} = 'IGNORE';
3375 local $SIG{TSTP} = 'IGNORE';
3376 local $SIG{PIPE} = 'IGNORE';
3378 my $oldAutoCommit = $FS::UID::AutoCommit;
3379 local $FS::UID::AutoCommit = 0;
3382 my $part_pkg = new FS::part_pkg ( {
3384 'comment' => $comment,
3385 #'setup' => $amount,
3388 'plandata' => "setup_fee=$amount",
3391 'taxclass' => $taxclass,
3394 my $error = $part_pkg->insert;
3396 $dbh->rollback if $oldAutoCommit;
3400 my $pkgpart = $part_pkg->pkgpart;
3401 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3402 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3403 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3404 $error = $type_pkgs->insert;
3406 $dbh->rollback if $oldAutoCommit;
3411 my $cust_pkg = new FS::cust_pkg ( {
3412 'custnum' => $self->custnum,
3413 'pkgpart' => $pkgpart,
3416 $error = $cust_pkg->insert;
3418 $dbh->rollback if $oldAutoCommit;
3422 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3429 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3435 sort { $a->_date <=> $b->_date }
3436 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3439 =item open_cust_bill
3441 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3446 sub open_cust_bill {
3448 grep { $_->owed > 0 } $self->cust_bill;
3453 Returns all the credits (see L<FS::cust_credit>) for this customer.
3459 sort { $a->_date <=> $b->_date }
3460 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3465 Returns all the payments (see L<FS::cust_pay>) for this customer.
3471 sort { $a->_date <=> $b->_date }
3472 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3477 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3483 sort { $a->_date <=> $b->_date }
3484 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3490 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3496 sort { $a->_date <=> $b->_date }
3497 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3500 =item select_for_update
3502 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3507 sub select_for_update {
3509 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3514 Returns a name string for this customer, either "Company (Last, First)" or
3521 my $name = $self->contact;
3522 $name = $self->company. " ($name)" if $self->company;
3528 Returns a name string for this (service/shipping) contact, either
3529 "Company (Last, First)" or "Last, First".
3535 if ( $self->get('ship_last') ) {
3536 my $name = $self->ship_contact;
3537 $name = $self->ship_company. " ($name)" if $self->ship_company;
3546 Returns this customer's full (billing) contact name only, "Last, First"
3552 $self->get('last'). ', '. $self->first;
3557 Returns this customer's full (shipping) contact name only, "Last, First"
3563 $self->get('ship_last')
3564 ? $self->get('ship_last'). ', '. $self->ship_first
3570 Returns a status string for this customer, currently:
3574 =item prospect - No packages have ever been ordered
3576 =item active - One or more recurring packages is active
3578 =item suspended - All non-cancelled recurring packages are suspended
3580 =item cancelled - All recurring packages are cancelled
3588 for my $status (qw( prospect active suspended cancelled )) {
3589 my $method = $status.'_sql';
3590 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3591 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3592 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3593 return $status if $sth->fetchrow_arrayref->[0];
3599 Returns a hex triplet color string for this customer's status.
3604 'prospect' => '000000',
3605 'active' => '00CC00',
3606 'suspended' => 'FF9900',
3607 'cancelled' => 'FF0000',
3611 $statuscolor{$self->status};
3616 =head1 CLASS METHODS
3622 Returns an SQL expression identifying prospective cust_main records (customers
3623 with no packages ever ordered)
3627 sub prospect_sql { "
3628 0 = ( SELECT COUNT(*) FROM cust_pkg
3629 WHERE cust_pkg.custnum = cust_main.custnum
3635 Returns an SQL expression identifying active cust_main records.
3640 0 < ( SELECT COUNT(*) FROM cust_pkg
3641 WHERE cust_pkg.custnum = cust_main.custnum
3642 AND ". FS::cust_pkg->active_sql. "
3649 Returns an SQL expression identifying suspended cust_main records.
3653 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3654 my $recurring_sql = "
3655 '0' != ( select freq from part_pkg
3656 where cust_pkg.pkgpart = part_pkg.pkgpart )
3659 sub suspended_sql { susp_sql(@_); }
3661 0 < ( SELECT COUNT(*) FROM cust_pkg
3662 WHERE cust_pkg.custnum = cust_main.custnum
3664 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3666 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3667 WHERE cust_pkg.custnum = cust_main.custnum
3668 AND ". FS::cust_pkg->active_sql. "
3675 Returns an SQL expression identifying cancelled cust_main records.
3679 sub cancelled_sql { cancel_sql(@_); }
3681 0 < ( SELECT COUNT(*) FROM cust_pkg
3682 WHERE cust_pkg.custnum = cust_main.custnum
3684 AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3685 WHERE cust_pkg.custnum = cust_main.custnum
3687 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3691 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3693 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3694 records. Currently, only I<last> or I<company> may be specified (the
3695 appropriate ship_ field is also searched if applicable).
3697 Additional options are the same as FS::Record::qsearch
3702 my( $self, $fuzzy, $hash, @opt) = @_;
3707 check_and_rebuild_fuzzyfiles();
3708 foreach my $field ( keys %$fuzzy ) {
3709 my $sub = \&{"all_$field"};
3711 $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3713 foreach ( keys %match ) {
3714 push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3715 push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3716 if defined dbdef->table('cust_main')->column('ship_last');
3721 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3733 =item smart_search OPTION => VALUE ...
3735 Accepts the following options: I<search>, the string to search for. The string
3736 will be searched for as a customer number, last name or company name, first
3737 searching for an exact match then fuzzy and substring matches.
3739 Any additional options treated as an additional qualifier on the search
3742 Returns a (possibly empty) array of FS::cust_main objects.
3748 my $search = delete $options{'search'};
3751 if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3753 push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3755 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3758 my $q_value = dbh->quote($value);
3761 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3762 $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3763 $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3764 if defined dbdef->table('cust_main')->column('ship_last');
3767 push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3769 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
3771 #still some false laziness w/ search/cust_main.cgi
3774 push @cust_main, qsearch( 'cust_main',
3775 { 'last' => { 'op' => 'ILIKE',
3776 'value' => "%$q_value%" },
3780 push @cust_main, qsearch( 'cust_main',
3781 { 'ship_last' => { 'op' => 'ILIKE',
3782 'value' => "%$q_value%" },
3787 if defined dbdef->table('cust_main')->column('ship_last');
3789 push @cust_main, qsearch( 'cust_main',
3790 { 'company' => { 'op' => 'ILIKE',
3791 'value' => "%$q_value%" },
3795 push @cust_main, qsearch( 'cust_main',
3796 { 'ship_company' => { 'op' => 'ILIKE',
3797 'value' => "%$q_value%" },
3801 if defined dbdef->table('cust_main')->column('ship_last');
3804 push @cust_main, FS::cust_main->fuzzy_search(
3805 { 'last' => $value },
3808 push @cust_main, FS::cust_main->fuzzy_search(
3809 { 'company' => $value },
3821 =item check_and_rebuild_fuzzyfiles
3825 sub check_and_rebuild_fuzzyfiles {
3826 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3827 -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3828 or &rebuild_fuzzyfiles;
3831 =item rebuild_fuzzyfiles
3835 sub rebuild_fuzzyfiles {
3837 use Fcntl qw(:flock);
3839 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3843 open(LASTLOCK,">>$dir/cust_main.last")
3844 or die "can't open $dir/cust_main.last: $!";
3845 flock(LASTLOCK,LOCK_EX)
3846 or die "can't lock $dir/cust_main.last: $!";
3848 my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3850 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3851 if defined dbdef->table('cust_main')->column('ship_last');
3853 open (LASTCACHE,">$dir/cust_main.last.tmp")
3854 or die "can't open $dir/cust_main.last.tmp: $!";
3855 print LASTCACHE join("\n", @all_last), "\n";
3856 close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3858 rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3863 open(COMPANYLOCK,">>$dir/cust_main.company")
3864 or die "can't open $dir/cust_main.company: $!";
3865 flock(COMPANYLOCK,LOCK_EX)
3866 or die "can't lock $dir/cust_main.company: $!";
3868 my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3870 grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3871 if defined dbdef->table('cust_main')->column('ship_last');
3873 open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3874 or die "can't open $dir/cust_main.company.tmp: $!";
3875 print COMPANYCACHE join("\n", @all_company), "\n";
3876 close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3878 rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3888 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3889 open(LASTCACHE,"<$dir/cust_main.last")
3890 or die "can't open $dir/cust_main.last: $!";
3891 my @array = map { chomp; $_; } <LASTCACHE>;
3901 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3902 open(COMPANYCACHE,"<$dir/cust_main.company")
3903 or die "can't open $dir/cust_main.last: $!";
3904 my @array = map { chomp; $_; } <COMPANYCACHE>;
3909 =item append_fuzzyfiles LASTNAME COMPANY
3913 sub append_fuzzyfiles {
3914 my( $last, $company ) = @_;
3916 &check_and_rebuild_fuzzyfiles;
3918 use Fcntl qw(:flock);
3920 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3924 open(LAST,">>$dir/cust_main.last")
3925 or die "can't open $dir/cust_main.last: $!";
3927 or die "can't lock $dir/cust_main.last: $!";
3929 print LAST "$last\n";
3932 or die "can't unlock $dir/cust_main.last: $!";
3938 open(COMPANY,">>$dir/cust_main.company")
3939 or die "can't open $dir/cust_main.company: $!";
3940 flock(COMPANY,LOCK_EX)
3941 or die "can't lock $dir/cust_main.company: $!";
3943 print COMPANY "$company\n";
3945 flock(COMPANY,LOCK_UN)
3946 or die "can't unlock $dir/cust_main.company: $!";
3960 #warn join('-',keys %$param);
3961 my $fh = $param->{filehandle};
3962 my $agentnum = $param->{agentnum};
3963 my $refnum = $param->{refnum};
3964 my $pkgpart = $param->{pkgpart};
3965 my @fields = @{$param->{fields}};
3967 eval "use Date::Parse;";
3969 eval "use Text::CSV_XS;";
3972 my $csv = new Text::CSV_XS;
3979 local $SIG{HUP} = 'IGNORE';
3980 local $SIG{INT} = 'IGNORE';
3981 local $SIG{QUIT} = 'IGNORE';
3982 local $SIG{TERM} = 'IGNORE';
3983 local $SIG{TSTP} = 'IGNORE';
3984 local $SIG{PIPE} = 'IGNORE';
3986 my $oldAutoCommit = $FS::UID::AutoCommit;
3987 local $FS::UID::AutoCommit = 0;
3990 #while ( $columns = $csv->getline($fh) ) {
3992 while ( defined($line=<$fh>) ) {
3994 $csv->parse($line) or do {
3995 $dbh->rollback if $oldAutoCommit;
3996 return "can't parse: ". $csv->error_input();
3999 my @columns = $csv->fields();
4000 #warn join('-',@columns);
4003 agentnum => $agentnum,
4005 country => $conf->config('countrydefault') || 'US',
4006 payby => 'BILL', #default
4007 paydate => '12/2037', #default
4009 my $billtime = time;
4010 my %cust_pkg = ( pkgpart => $pkgpart );
4011 foreach my $field ( @fields ) {
4012 if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4013 #$cust_pkg{$1} = str2time( shift @$columns );
4014 if ( $1 eq 'setup' ) {
4015 $billtime = str2time(shift @columns);
4017 $cust_pkg{$1} = str2time( shift @columns );
4020 #$cust_main{$field} = shift @$columns;
4021 $cust_main{$field} = shift @columns;
4025 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4026 my $cust_main = new FS::cust_main ( \%cust_main );
4028 tie my %hash, 'Tie::RefHash'; #this part is important
4029 $hash{$cust_pkg} = [] if $pkgpart;
4030 my $error = $cust_main->insert( \%hash );
4033 $dbh->rollback if $oldAutoCommit;
4034 return "can't insert customer for $line: $error";
4037 #false laziness w/bill.cgi
4038 $error = $cust_main->bill( 'time' => $billtime );
4040 $dbh->rollback if $oldAutoCommit;
4041 return "can't bill customer for $line: $error";
4044 $cust_main->apply_payments;
4045 $cust_main->apply_credits;
4047 $error = $cust_main->collect();
4049 $dbh->rollback if $oldAutoCommit;
4050 return "can't collect customer for $line: $error";
4056 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4058 return "Empty file!" unless $imported;
4070 #warn join('-',keys %$param);
4071 my $fh = $param->{filehandle};
4072 my @fields = @{$param->{fields}};
4074 eval "use Date::Parse;";
4076 eval "use Text::CSV_XS;";
4079 my $csv = new Text::CSV_XS;
4086 local $SIG{HUP} = 'IGNORE';
4087 local $SIG{INT} = 'IGNORE';
4088 local $SIG{QUIT} = 'IGNORE';
4089 local $SIG{TERM} = 'IGNORE';
4090 local $SIG{TSTP} = 'IGNORE';
4091 local $SIG{PIPE} = 'IGNORE';
4093 my $oldAutoCommit = $FS::UID::AutoCommit;
4094 local $FS::UID::AutoCommit = 0;
4097 #while ( $columns = $csv->getline($fh) ) {
4099 while ( defined($line=<$fh>) ) {
4101 $csv->parse($line) or do {
4102 $dbh->rollback if $oldAutoCommit;
4103 return "can't parse: ". $csv->error_input();
4106 my @columns = $csv->fields();
4107 #warn join('-',@columns);
4110 foreach my $field ( @fields ) {
4111 $row{$field} = shift @columns;
4114 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4115 unless ( $cust_main ) {
4116 $dbh->rollback if $oldAutoCommit;
4117 return "unknown custnum $row{'custnum'}";
4120 if ( $row{'amount'} > 0 ) {
4121 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4123 $dbh->rollback if $oldAutoCommit;
4127 } elsif ( $row{'amount'} < 0 ) {
4128 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4131 $dbh->rollback if $oldAutoCommit;
4141 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4143 return "Empty file!" unless $imported;
4155 The delete method should possibly take an FS::cust_main object reference
4156 instead of a scalar customer number.
4158 Bill and collect options should probably be passed as references instead of a
4161 There should probably be a configuration file with a list of allowed credit
4164 No multiple currency support (probably a larger project than just this module).
4166 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4170 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4171 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4172 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.