4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
5 $import $skip_fuzzyfiles $ignore_expired_card );
6 use vars qw( $realtime_bop_decline_quiet ); #ugh
11 eval "use Time::Local;";
12 die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
13 if $] < 5.006 && !defined($Time::Local::VERSION);
14 #eval "use Time::Local qw(timelocal timelocal_nocheck);";
15 eval "use Time::Local qw(timelocal_nocheck);";
17 use Digest::MD5 qw(md5_base64);
21 use String::Approx qw(amatch);
22 use Business::CreditCard 0.28;
24 use FS::UID qw( getotaker dbh );
25 use FS::Record qw( qsearchs qsearch dbdef );
26 use FS::Misc qw( send_email );
27 use FS::Msgcat qw(gettext);
31 use FS::cust_bill_pkg;
33 use FS::cust_pay_void;
36 use FS::part_referral;
37 use FS::cust_main_county;
39 use FS::cust_main_invoice;
40 use FS::cust_credit_bill;
41 use FS::cust_bill_pay;
42 use FS::prepay_credit;
45 use FS::part_bill_event;
46 use FS::cust_bill_event;
47 use FS::cust_tax_exempt;
48 use FS::cust_tax_exempt_pkg;
50 use FS::payment_gateway;
51 use FS::agent_payment_gateway;
54 @ISA = qw( FS::Record );
56 @EXPORT_OK = qw( smart_search );
58 $realtime_bop_decline_quiet = 0;
60 # 1 is mostly method/subroutine entry and options
61 # 2 traces progress of some operations
62 # 3 is even more information including possibly sensitive data
64 $me = '[FS::cust_main]';
68 $ignore_expired_card = 0;
70 @encrypted_fields = ('payinfo', 'paycvv');
72 #ask FS::UID to run this stuff for us later
73 #$FS::UID::callback{'FS::cust_main'} = sub {
74 install_callback FS::UID sub {
76 #yes, need it for stuff below (prolly should be cached)
81 my ( $hashref, $cache ) = @_;
82 if ( exists $hashref->{'pkgnum'} ) {
83 #@{ $self->{'_pkgnum'} } = ();
84 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
85 $self->{'_pkgnum'} = $subcache;
86 #push @{ $self->{'_pkgnum'} },
87 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
93 FS::cust_main - Object methods for cust_main records
99 $record = new FS::cust_main \%hash;
100 $record = new FS::cust_main { 'column' => 'value' };
102 $error = $record->insert;
104 $error = $new_record->replace($old_record);
106 $error = $record->delete;
108 $error = $record->check;
110 @cust_pkg = $record->all_pkgs;
112 @cust_pkg = $record->ncancelled_pkgs;
114 @cust_pkg = $record->suspended_pkgs;
116 $error = $record->bill;
117 $error = $record->bill %options;
118 $error = $record->bill 'time' => $time;
120 $error = $record->collect;
121 $error = $record->collect %options;
122 $error = $record->collect 'invoice_time' => $time,
127 An FS::cust_main object represents a customer. FS::cust_main inherits from
128 FS::Record. The following fields are currently supported:
132 =item custnum - primary key (assigned automatically for new customers)
134 =item agentnum - agent (see L<FS::agent>)
136 =item refnum - Advertising source (see L<FS::part_referral>)
142 =item ss - social security number (optional)
144 =item company - (optional)
148 =item address2 - (optional)
152 =item county - (optional, see L<FS::cust_main_county>)
154 =item state - (see L<FS::cust_main_county>)
158 =item country - (see L<FS::cust_main_county>)
160 =item daytime - phone (optional)
162 =item night - phone (optional)
164 =item fax - phone (optional)
166 =item ship_first - name
168 =item ship_last - name
170 =item ship_company - (optional)
174 =item ship_address2 - (optional)
178 =item ship_county - (optional, see L<FS::cust_main_county>)
180 =item ship_state - (see L<FS::cust_main_county>)
184 =item ship_country - (see L<FS::cust_main_county>)
186 =item ship_daytime - phone (optional)
188 =item ship_night - phone (optional)
190 =item ship_fax - phone (optional)
194 I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
198 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
203 my($self,$payinfo) = @_;
204 if ( defined($payinfo) ) {
205 $self->paymask($payinfo);
206 $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
208 $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
216 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
220 =item paymask - Masked payment type
226 Mask all but the last four characters.
230 Mask all but last 2 of account number and bank routing number.
234 Do nothing, return the unmasked string.
243 # If it doesn't exist then generate it
244 my $paymask=$self->getfield('paymask');
245 if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
246 $value = $self->payinfo;
249 if ( defined($value) && !$self->is_encrypted($value)) {
250 my $payinfo = $value;
251 my $payby = $self->payby;
252 if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
253 $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
254 } elsif ($payby eq 'CHEK' ||
255 $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
256 my( $account, $aba ) = split('@', $payinfo );
257 $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
258 } else { # Tie up loose ends
261 $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
262 } elsif (defined($value) && $self->is_encrypted($value)) {
268 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
270 =item paystart_month - start date month (maestro/solo cards only)
272 =item paystart_year - start date year (maestro/solo cards only)
274 =item payissue - issue number (maestro/solo cards only)
276 =item payname - name on card or billing name
278 =item payip - IP address from which payment information was received
280 =item tax - tax exempt, empty or `Y'
282 =item otaker - order taker (assigned automatically, see L<FS::UID>)
284 =item comments - comments (optional)
286 =item referral_custnum - referring customer number
288 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
298 Creates a new customer. To add the customer to the database, see L<"insert">.
300 Note that this stores the hash reference, not a distinct copy of the hash it
301 points to. You can ask the object for a copy with the I<hash> method.
305 sub table { 'cust_main'; }
307 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
309 Adds this customer to the database. If there is an error, returns the error,
310 otherwise returns false.
312 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
313 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
314 are inserted atomicly, or the transaction is rolled back. Passing an empty
315 hash reference is equivalent to not supplying this parameter. There should be
316 a better explanation of this, but until then, here's an example:
319 tie %hash, 'Tie::RefHash'; #this part is important
321 $cust_pkg => [ $svc_acct ],
324 $cust_main->insert( \%hash );
326 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
327 be set as the invoicing list (see L<"invoicing_list">). Errors return as
328 expected and rollback the entire transaction; it is not necessary to call
329 check_invoicing_list first. The invoicing_list is set after the records in the
330 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
331 invoicing_list destination to the newly-created svc_acct. Here's an example:
333 $cust_main->insert( {}, [ $email, 'POST' ] );
335 Currently available options are: I<depend_jobnum> and I<noexport>.
337 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
338 on the supplied jobnum (they will not run until the specific job completes).
339 This can be used to defer provisioning until some action completes (such
340 as running the customer's credit card successfully).
342 The I<noexport> option is deprecated. If I<noexport> is set true, no
343 provisioning jobs (exports) are scheduled. (You can schedule them later with
344 the B<reexport> method.)
350 my $cust_pkgs = @_ ? shift : {};
351 my $invoicing_list = @_ ? shift : '';
353 warn "$me insert called with options ".
354 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
357 local $SIG{HUP} = 'IGNORE';
358 local $SIG{INT} = 'IGNORE';
359 local $SIG{QUIT} = 'IGNORE';
360 local $SIG{TERM} = 'IGNORE';
361 local $SIG{TSTP} = 'IGNORE';
362 local $SIG{PIPE} = 'IGNORE';
364 my $oldAutoCommit = $FS::UID::AutoCommit;
365 local $FS::UID::AutoCommit = 0;
368 my $prepay_identifier = '';
369 my( $amount, $seconds ) = ( 0, 0 );
371 if ( $self->payby eq 'PREPAY' ) {
373 $self->payby('BILL');
374 $prepay_identifier = $self->payinfo;
377 warn " looking up prepaid card $prepay_identifier\n"
380 my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
382 $dbh->rollback if $oldAutoCommit;
383 #return "error applying prepaid card (transaction rolled back): $error";
387 $payby = 'PREP' if $amount;
389 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
392 $self->payby('BILL');
393 $amount = $self->paid;
397 warn " inserting $self\n"
400 my $error = $self->SUPER::insert;
402 $dbh->rollback if $oldAutoCommit;
403 #return "inserting cust_main record (transaction rolled back): $error";
407 warn " setting invoicing list\n"
410 if ( $invoicing_list ) {
411 $error = $self->check_invoicing_list( $invoicing_list );
413 $dbh->rollback if $oldAutoCommit;
414 return "checking invoicing_list (transaction rolled back): $error";
416 $self->invoicing_list( $invoicing_list );
419 warn " ordering packages\n"
422 $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
424 $dbh->rollback if $oldAutoCommit;
429 $dbh->rollback if $oldAutoCommit;
430 return "No svc_acct record to apply pre-paid time";
434 warn " inserting initial $payby payment of $amount\n"
436 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
438 $dbh->rollback if $oldAutoCommit;
439 return "inserting payment (transaction rolled back): $error";
443 unless ( $import || $skip_fuzzyfiles ) {
444 warn " queueing fuzzyfiles update\n"
446 $error = $self->queue_fuzzyfiles_update;
448 $dbh->rollback if $oldAutoCommit;
449 return "updating fuzzy search cache: $error";
453 warn " insert complete; committing transaction\n"
456 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
461 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
463 Like the insert method on an existing record, this method orders a package
464 and included services atomicaly. Pass a Tie::RefHash data structure to this
465 method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should
466 be a better explanation of this, but until then, here's an example:
469 tie %hash, 'Tie::RefHash'; #this part is important
471 $cust_pkg => [ $svc_acct ],
474 $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
476 Services can be new, in which case they are inserted, or existing unaudited
477 services, in which case they are linked to the newly-created package.
479 Currently available options are: I<depend_jobnum> and I<noexport>.
481 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
482 on the supplied jobnum (they will not run until the specific job completes).
483 This can be used to defer provisioning until some action completes (such
484 as running the customer's credit card successfully).
486 The I<noexport> option is deprecated. If I<noexport> is set true, no
487 provisioning jobs (exports) are scheduled. (You can schedule them later with
488 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
489 on the cust_main object is not recommended, as existing services will also be
496 my $cust_pkgs = shift;
499 my %svc_options = ();
500 $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
501 if exists $options{'depend_jobnum'};
502 warn "$me order_pkgs called with options ".
503 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
506 local $SIG{HUP} = 'IGNORE';
507 local $SIG{INT} = 'IGNORE';
508 local $SIG{QUIT} = 'IGNORE';
509 local $SIG{TERM} = 'IGNORE';
510 local $SIG{TSTP} = 'IGNORE';
511 local $SIG{PIPE} = 'IGNORE';
513 my $oldAutoCommit = $FS::UID::AutoCommit;
514 local $FS::UID::AutoCommit = 0;
517 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
519 foreach my $cust_pkg ( keys %$cust_pkgs ) {
520 $cust_pkg->custnum( $self->custnum );
521 my $error = $cust_pkg->insert;
523 $dbh->rollback if $oldAutoCommit;
524 return "inserting cust_pkg (transaction rolled back): $error";
526 foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
527 if ( $svc_something->svcnum ) {
528 my $old_cust_svc = $svc_something->cust_svc;
529 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
530 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
531 $error = $new_cust_svc->replace($old_cust_svc);
533 $svc_something->pkgnum( $cust_pkg->pkgnum );
534 if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
535 $svc_something->seconds( $svc_something->seconds + $$seconds );
538 $error = $svc_something->insert(%svc_options);
541 $dbh->rollback if $oldAutoCommit;
542 #return "inserting svc_ (transaction rolled back): $error";
548 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
552 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
554 Recharges this (existing) customer with the specified prepaid card (see
555 L<FS::prepay_credit>), specified either by I<identifier> or as an
556 FS::prepay_credit object. If there is an error, returns the error, otherwise
559 Optionally, two scalar references can be passed as well. They will have their
560 values filled in with the amount and number of seconds applied by this prepaid
565 sub recharge_prepay {
566 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
568 local $SIG{HUP} = 'IGNORE';
569 local $SIG{INT} = 'IGNORE';
570 local $SIG{QUIT} = 'IGNORE';
571 local $SIG{TERM} = 'IGNORE';
572 local $SIG{TSTP} = 'IGNORE';
573 local $SIG{PIPE} = 'IGNORE';
575 my $oldAutoCommit = $FS::UID::AutoCommit;
576 local $FS::UID::AutoCommit = 0;
579 my( $amount, $seconds ) = ( 0, 0 );
581 my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
582 || $self->increment_seconds($seconds)
583 || $self->insert_cust_pay_prepay( $amount,
585 ? $prepay_credit->identifier
590 $dbh->rollback if $oldAutoCommit;
594 if ( defined($amountref) ) { $$amountref = $amount; }
595 if ( defined($secondsref) ) { $$secondsref = $seconds; }
597 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
602 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
604 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
605 specified either by I<identifier> or as an FS::prepay_credit object.
607 References to I<amount> and I<seconds> scalars should be passed as arguments
608 and will be incremented by the values of the prepaid card.
610 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
611 check or set this customer's I<agentnum>.
613 If there is an error, returns the error, otherwise returns false.
619 my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
621 local $SIG{HUP} = 'IGNORE';
622 local $SIG{INT} = 'IGNORE';
623 local $SIG{QUIT} = 'IGNORE';
624 local $SIG{TERM} = 'IGNORE';
625 local $SIG{TSTP} = 'IGNORE';
626 local $SIG{PIPE} = 'IGNORE';
628 my $oldAutoCommit = $FS::UID::AutoCommit;
629 local $FS::UID::AutoCommit = 0;
632 unless ( ref($prepay_credit) ) {
634 my $identifier = $prepay_credit;
636 $prepay_credit = qsearchs(
638 { 'identifier' => $prepay_credit },
643 unless ( $prepay_credit ) {
644 $dbh->rollback if $oldAutoCommit;
645 return "Invalid prepaid card: ". $identifier;
650 if ( $prepay_credit->agentnum ) {
651 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
652 $dbh->rollback if $oldAutoCommit;
653 return "prepaid card not valid for agent ". $self->agentnum;
655 $self->agentnum($prepay_credit->agentnum);
658 my $error = $prepay_credit->delete;
660 $dbh->rollback if $oldAutoCommit;
661 return "removing prepay_credit (transaction rolled back): $error";
664 $$amountref += $prepay_credit->amount;
665 $$secondsref += $prepay_credit->seconds;
667 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
672 =item increment_seconds SECONDS
674 Updates this customer's single or primary account (see L<FS::svc_acct>) by
675 the specified number of seconds. If there is an error, returns the error,
676 otherwise returns false.
680 sub increment_seconds {
681 my( $self, $seconds ) = @_;
682 warn "$me increment_seconds called: $seconds seconds\n"
685 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
686 $self->ncancelled_pkgs;
689 return 'No packages with primary or single services found'.
690 ' to apply pre-paid time';
691 } elsif ( scalar(@cust_pkg) > 1 ) {
692 #maybe have a way to specify the package/account?
693 return 'Multiple packages found to apply pre-paid time';
696 my $cust_pkg = $cust_pkg[0];
697 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
701 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
704 return 'No account found to apply pre-paid time';
705 } elsif ( scalar(@cust_svc) > 1 ) {
706 return 'Multiple accounts found to apply pre-paid time';
709 my $svc_acct = $cust_svc[0]->svc_x;
710 warn " found service svcnum ". $svc_acct->pkgnum.
711 ' ('. $svc_acct->email. ")\n"
714 $svc_acct->increment_seconds($seconds);
718 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
720 Inserts a prepayment in the specified amount for this customer. An optional
721 second argument can specify the prepayment identifier for tracking purposes.
722 If there is an error, returns the error, otherwise returns false.
726 sub insert_cust_pay_prepay {
727 shift->insert_cust_pay('PREP', @_);
730 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
732 Inserts a cash payment in the specified amount for this customer. An optional
733 second argument can specify the payment identifier for tracking purposes.
734 If there is an error, returns the error, otherwise returns false.
738 sub insert_cust_pay_cash {
739 shift->insert_cust_pay('CASH', @_);
742 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
744 Inserts a Western Union payment in the specified amount for this customer. An
745 optional second argument can specify the prepayment identifier for tracking
746 purposes. If there is an error, returns the error, otherwise returns false.
750 sub insert_cust_pay_west {
751 shift->insert_cust_pay('WEST', @_);
754 sub insert_cust_pay {
755 my( $self, $payby, $amount ) = splice(@_, 0, 3);
756 my $payinfo = scalar(@_) ? shift : '';
758 my $cust_pay = new FS::cust_pay {
759 'custnum' => $self->custnum,
760 'paid' => sprintf('%.2f', $amount),
761 #'_date' => #date the prepaid card was purchased???
763 'payinfo' => $payinfo,
771 This method is deprecated. See the I<depend_jobnum> option to the insert and
772 order_pkgs methods for a better way to defer provisioning.
774 Re-schedules all exports by calling the B<reexport> method of all associated
775 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
776 otherwise returns false.
783 carp "WARNING: FS::cust_main::reexport is deprectated; ".
784 "use the depend_jobnum option to insert or order_pkgs to delay export";
786 local $SIG{HUP} = 'IGNORE';
787 local $SIG{INT} = 'IGNORE';
788 local $SIG{QUIT} = 'IGNORE';
789 local $SIG{TERM} = 'IGNORE';
790 local $SIG{TSTP} = 'IGNORE';
791 local $SIG{PIPE} = 'IGNORE';
793 my $oldAutoCommit = $FS::UID::AutoCommit;
794 local $FS::UID::AutoCommit = 0;
797 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
798 my $error = $cust_pkg->reexport;
800 $dbh->rollback if $oldAutoCommit;
805 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
810 =item delete NEW_CUSTNUM
812 This deletes the customer. If there is an error, returns the error, otherwise
815 This will completely remove all traces of the customer record. This is not
816 what you want when a customer cancels service; for that, cancel all of the
817 customer's packages (see L</cancel>).
819 If the customer has any uncancelled packages, you need to pass a new (valid)
820 customer number for those packages to be transferred to. Cancelled packages
821 will be deleted. Did I mention that this is NOT what you want when a customer
822 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
824 You can't delete a customer with invoices (see L<FS::cust_bill>),
825 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
826 refunds (see L<FS::cust_refund>).
833 local $SIG{HUP} = 'IGNORE';
834 local $SIG{INT} = 'IGNORE';
835 local $SIG{QUIT} = 'IGNORE';
836 local $SIG{TERM} = 'IGNORE';
837 local $SIG{TSTP} = 'IGNORE';
838 local $SIG{PIPE} = 'IGNORE';
840 my $oldAutoCommit = $FS::UID::AutoCommit;
841 local $FS::UID::AutoCommit = 0;
844 if ( $self->cust_bill ) {
845 $dbh->rollback if $oldAutoCommit;
846 return "Can't delete a customer with invoices";
848 if ( $self->cust_credit ) {
849 $dbh->rollback if $oldAutoCommit;
850 return "Can't delete a customer with credits";
852 if ( $self->cust_pay ) {
853 $dbh->rollback if $oldAutoCommit;
854 return "Can't delete a customer with payments";
856 if ( $self->cust_refund ) {
857 $dbh->rollback if $oldAutoCommit;
858 return "Can't delete a customer with refunds";
861 my @cust_pkg = $self->ncancelled_pkgs;
863 my $new_custnum = shift;
864 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
865 $dbh->rollback if $oldAutoCommit;
866 return "Invalid new customer number: $new_custnum";
868 foreach my $cust_pkg ( @cust_pkg ) {
869 my %hash = $cust_pkg->hash;
870 $hash{'custnum'} = $new_custnum;
871 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
872 my $error = $new_cust_pkg->replace($cust_pkg);
874 $dbh->rollback if $oldAutoCommit;
879 my @cancelled_cust_pkg = $self->all_pkgs;
880 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
881 my $error = $cust_pkg->delete;
883 $dbh->rollback if $oldAutoCommit;
888 foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
889 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
891 my $error = $cust_main_invoice->delete;
893 $dbh->rollback if $oldAutoCommit;
898 my $error = $self->SUPER::delete;
900 $dbh->rollback if $oldAutoCommit;
904 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
909 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
911 Replaces the OLD_RECORD with this one in the database. If there is an error,
912 returns the error, otherwise returns false.
914 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
915 be set as the invoicing list (see L<"invoicing_list">). Errors return as
916 expected and rollback the entire transaction; it is not necessary to call
917 check_invoicing_list first. Here's an example:
919 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
927 warn "$me replace called\n"
930 local $SIG{HUP} = 'IGNORE';
931 local $SIG{INT} = 'IGNORE';
932 local $SIG{QUIT} = 'IGNORE';
933 local $SIG{TERM} = 'IGNORE';
934 local $SIG{TSTP} = 'IGNORE';
935 local $SIG{PIPE} = 'IGNORE';
937 # If the mask is blank then try to set it - if we can...
938 if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
939 $self->paymask($self->payinfo);
942 # We absolutely have to have an old vs. new record to make this work.
943 if (!defined($old)) {
944 $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
947 my $curuser = $FS::CurrentUser::CurrentUser;
948 if ( $self->payby eq 'COMP'
949 && $self->payby ne $old->payby
950 && ! $curuser->access_right('Complimentary customer')
953 return "You are not permitted to create complimentary accounts.";
956 local($ignore_expired_card) = 1
957 if $old->payby =~ /^(CARD|DCRD)$/
958 && $self->payby =~ /^(CARD|DCRD)$/
959 && $old->payinfo eq $self->payinfo;
961 my $oldAutoCommit = $FS::UID::AutoCommit;
962 local $FS::UID::AutoCommit = 0;
965 my $error = $self->SUPER::replace($old);
968 $dbh->rollback if $oldAutoCommit;
972 if ( @param ) { # INVOICING_LIST_ARYREF
973 my $invoicing_list = shift @param;
974 $error = $self->check_invoicing_list( $invoicing_list );
976 $dbh->rollback if $oldAutoCommit;
979 $self->invoicing_list( $invoicing_list );
982 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
983 grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
984 # card/check/lec info has changed, want to retry realtime_ invoice events
985 my $error = $self->retry_realtime;
987 $dbh->rollback if $oldAutoCommit;
992 unless ( $import || $skip_fuzzyfiles ) {
993 $error = $self->queue_fuzzyfiles_update;
995 $dbh->rollback if $oldAutoCommit;
996 return "updating fuzzy search cache: $error";
1000 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1005 =item queue_fuzzyfiles_update
1007 Used by insert & replace to update the fuzzy search cache
1011 sub queue_fuzzyfiles_update {
1014 local $SIG{HUP} = 'IGNORE';
1015 local $SIG{INT} = 'IGNORE';
1016 local $SIG{QUIT} = 'IGNORE';
1017 local $SIG{TERM} = 'IGNORE';
1018 local $SIG{TSTP} = 'IGNORE';
1019 local $SIG{PIPE} = 'IGNORE';
1021 my $oldAutoCommit = $FS::UID::AutoCommit;
1022 local $FS::UID::AutoCommit = 0;
1025 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1026 my $error = $queue->insert($self->getfield('last'), $self->company);
1028 $dbh->rollback if $oldAutoCommit;
1029 return "queueing job (transaction rolled back): $error";
1032 if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1033 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1034 $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1036 $dbh->rollback if $oldAutoCommit;
1037 return "queueing job (transaction rolled back): $error";
1041 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1048 Checks all fields to make sure this is a valid customer record. If there is
1049 an error, returns the error, otherwise returns false. Called by the insert
1050 and replace methods.
1057 warn "$me check BEFORE: \n". $self->_dump
1061 $self->ut_numbern('custnum')
1062 || $self->ut_number('agentnum')
1063 || $self->ut_textn('agent_custid')
1064 || $self->ut_number('refnum')
1065 || $self->ut_name('last')
1066 || $self->ut_name('first')
1067 || $self->ut_textn('company')
1068 || $self->ut_text('address1')
1069 || $self->ut_textn('address2')
1070 || $self->ut_text('city')
1071 || $self->ut_textn('county')
1072 || $self->ut_textn('state')
1073 || $self->ut_country('country')
1074 || $self->ut_anything('comments')
1075 || $self->ut_numbern('referral_custnum')
1077 #barf. need message catalogs. i18n. etc.
1078 $error .= "Please select an advertising source."
1079 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1080 return $error if $error;
1082 return "Unknown agent"
1083 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1085 return "Unknown refnum"
1086 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1088 return "Unknown referring custnum: ". $self->referral_custnum
1089 unless ! $self->referral_custnum
1090 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1092 if ( $self->ss eq '' ) {
1097 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1098 or return "Illegal social security number: ". $self->ss;
1099 $self->ss("$1-$2-$3");
1103 # bad idea to disable, causes billing to fail because of no tax rates later
1104 # unless ( $import ) {
1105 unless ( qsearch('cust_main_county', {
1106 'country' => $self->country,
1109 return "Unknown state/county/country: ".
1110 $self->state. "/". $self->county. "/". $self->country
1111 unless qsearch('cust_main_county',{
1112 'state' => $self->state,
1113 'county' => $self->county,
1114 'country' => $self->country,
1120 $self->ut_phonen('daytime', $self->country)
1121 || $self->ut_phonen('night', $self->country)
1122 || $self->ut_phonen('fax', $self->country)
1123 || $self->ut_zip('zip', $self->country)
1125 return $error if $error;
1128 last first company address1 address2 city county state zip
1129 country daytime night fax
1132 if ( defined $self->dbdef_table->column('ship_last') ) {
1133 if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1135 && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1139 $self->ut_name('ship_last')
1140 || $self->ut_name('ship_first')
1141 || $self->ut_textn('ship_company')
1142 || $self->ut_text('ship_address1')
1143 || $self->ut_textn('ship_address2')
1144 || $self->ut_text('ship_city')
1145 || $self->ut_textn('ship_county')
1146 || $self->ut_textn('ship_state')
1147 || $self->ut_country('ship_country')
1149 return $error if $error;
1151 #false laziness with above
1152 unless ( qsearchs('cust_main_county', {
1153 'country' => $self->ship_country,
1156 return "Unknown ship_state/ship_county/ship_country: ".
1157 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1158 unless qsearch('cust_main_county',{
1159 'state' => $self->ship_state,
1160 'county' => $self->ship_county,
1161 'country' => $self->ship_country,
1167 $self->ut_phonen('ship_daytime', $self->ship_country)
1168 || $self->ut_phonen('ship_night', $self->ship_country)
1169 || $self->ut_phonen('ship_fax', $self->ship_country)
1170 || $self->ut_zip('ship_zip', $self->ship_country)
1172 return $error if $error;
1174 } else { # ship_ info eq billing info, so don't store dup info in database
1175 $self->setfield("ship_$_", '')
1176 foreach qw( last first company address1 address2 city county state zip
1177 country daytime night fax );
1181 $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1182 or return "Illegal payby: ". $self->payby;
1184 $error = $self->ut_numbern('paystart_month')
1185 || $self->ut_numbern('paystart_year')
1186 || $self->ut_numbern('payissue')
1188 return $error if $error;
1190 if ( $self->payip eq '' ) {
1193 $error = $self->ut_ip('payip');
1194 return $error if $error;
1197 # If it is encrypted and the private key is not availaible then we can't
1198 # check the credit card.
1200 my $check_payinfo = 1;
1202 if ($self->is_encrypted($self->payinfo)) {
1208 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1210 my $payinfo = $self->payinfo;
1211 $payinfo =~ s/\D//g;
1212 $payinfo =~ /^(\d{13,16})$/
1213 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1215 $self->payinfo($payinfo);
1217 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1219 return gettext('unknown_card_type')
1220 if cardtype($self->payinfo) eq "Unknown";
1222 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1224 return 'Banned credit card: banned on '.
1225 time2str('%a %h %o at %r', $ban->_date).
1226 ' by '. $ban->otaker.
1227 ' (ban# '. $ban->bannum. ')';
1230 if ( defined $self->dbdef_table->column('paycvv') ) {
1231 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1232 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1233 $self->paycvv =~ /^(\d{4})$/
1234 or return "CVV2 (CID) for American Express cards is four digits.";
1237 $self->paycvv =~ /^(\d{3})$/
1238 or return "CVV2 (CVC2/CID) is three digits.";
1246 my $cardtype = cardtype($payinfo);
1247 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1249 return "Start date or issue number is required for $cardtype cards"
1250 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1252 return "Start month must be between 1 and 12"
1253 if $self->paystart_month
1254 and $self->paystart_month < 1 || $self->paystart_month > 12;
1256 return "Start year must be 1990 or later"
1257 if $self->paystart_year
1258 and $self->paystart_year < 1990;
1260 return "Issue number must be beween 1 and 99"
1262 and $self->payissue < 1 || $self->payissue > 99;
1265 $self->paystart_month('');
1266 $self->paystart_year('');
1267 $self->payissue('');
1270 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1272 my $payinfo = $self->payinfo;
1273 $payinfo =~ s/[^\d\@]//g;
1274 if ( $conf->exists('echeck-nonus') ) {
1275 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1276 $payinfo = "$1\@$2";
1278 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1279 $payinfo = "$1\@$2";
1281 $self->payinfo($payinfo);
1282 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1284 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1286 return 'Banned ACH account: banned on '.
1287 time2str('%a %h %o at %r', $ban->_date).
1288 ' by '. $ban->otaker.
1289 ' (ban# '. $ban->bannum. ')';
1292 } elsif ( $self->payby eq 'LECB' ) {
1294 my $payinfo = $self->payinfo;
1295 $payinfo =~ s/\D//g;
1296 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1298 $self->payinfo($payinfo);
1299 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1301 } elsif ( $self->payby eq 'BILL' ) {
1303 $error = $self->ut_textn('payinfo');
1304 return "Illegal P.O. number: ". $self->payinfo if $error;
1305 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1307 } elsif ( $self->payby eq 'COMP' ) {
1309 my $curuser = $FS::CurrentUser::CurrentUser;
1310 if ( ! $self->custnum
1311 && ! $curuser->access_right('Complimentary customer')
1314 return "You are not permitted to create complimentary accounts."
1317 $error = $self->ut_textn('payinfo');
1318 return "Illegal comp account issuer: ". $self->payinfo if $error;
1319 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1321 } elsif ( $self->payby eq 'PREPAY' ) {
1323 my $payinfo = $self->payinfo;
1324 $payinfo =~ s/\W//g; #anything else would just confuse things
1325 $self->payinfo($payinfo);
1326 $error = $self->ut_alpha('payinfo');
1327 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1328 return "Unknown prepayment identifier"
1329 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1330 $self->paycvv('') if $self->dbdef_table->column('paycvv');
1334 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1335 return "Expiration date required"
1336 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1340 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1341 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1342 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1343 ( $m, $y ) = ( $3, "20$2" );
1345 return "Illegal expiration date: ". $self->paydate;
1347 $self->paydate("$y-$m-01");
1348 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1349 return gettext('expired_card')
1351 && !$ignore_expired_card
1352 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1355 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1356 ( ! $conf->exists('require_cardname')
1357 || $self->payby !~ /^(CARD|DCRD)$/ )
1359 $self->payname( $self->first. " ". $self->getfield('last') );
1361 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1362 or return gettext('illegal_name'). " payname: ". $self->payname;
1366 foreach my $flag (qw( tax spool_cdr )) {
1367 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1371 $self->otaker(getotaker) unless $self->otaker;
1373 warn "$me check AFTER: \n". $self->_dump
1376 $self->SUPER::check;
1381 Returns all packages (see L<FS::cust_pkg>) for this customer.
1387 if ( $self->{'_pkgnum'} ) {
1388 values %{ $self->{'_pkgnum'}->cache };
1390 qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1394 =item ncancelled_pkgs
1396 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1400 sub ncancelled_pkgs {
1402 if ( $self->{'_pkgnum'} ) {
1403 grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1405 @{ [ # force list context
1406 qsearch( 'cust_pkg', {
1407 'custnum' => $self->custnum,
1410 qsearch( 'cust_pkg', {
1411 'custnum' => $self->custnum,
1418 =item suspended_pkgs
1420 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1424 sub suspended_pkgs {
1426 grep { $_->susp } $self->ncancelled_pkgs;
1429 =item unflagged_suspended_pkgs
1431 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1432 customer (thouse packages without the `manual_flag' set).
1436 sub unflagged_suspended_pkgs {
1438 return $self->suspended_pkgs
1439 unless dbdef->table('cust_pkg')->column('manual_flag');
1440 grep { ! $_->manual_flag } $self->suspended_pkgs;
1443 =item unsuspended_pkgs
1445 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1450 sub unsuspended_pkgs {
1452 grep { ! $_->susp } $self->ncancelled_pkgs;
1455 =item num_cancelled_pkgs
1457 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1462 sub num_cancelled_pkgs {
1464 $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1468 my( $self, $sql ) = @_;
1469 my $sth = dbh->prepare(
1470 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1471 ) or die dbh->errstr;
1472 $sth->execute($self->custnum) or die $sth->errstr;
1473 $sth->fetchrow_arrayref->[0];
1478 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1479 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1480 on success or a list of errors.
1486 grep { $_->unsuspend } $self->suspended_pkgs;
1491 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1493 Returns a list: an empty list on success or a list of errors.
1499 grep { $_->suspend } $self->unsuspended_pkgs;
1502 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1504 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1505 PKGPARTs (see L<FS::part_pkg>).
1507 Returns a list: an empty list on success or a list of errors.
1511 sub suspend_if_pkgpart {
1514 grep { $_->suspend }
1515 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1516 $self->unsuspended_pkgs;
1519 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1521 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1522 listed PKGPARTs (see L<FS::part_pkg>).
1524 Returns a list: an empty list on success or a list of errors.
1528 sub suspend_unless_pkgpart {
1531 grep { $_->suspend }
1532 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1533 $self->unsuspended_pkgs;
1536 =item cancel [ OPTION => VALUE ... ]
1538 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1540 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1542 I<quiet> can be set true to supress email cancellation notices.
1544 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1546 I<ban> can be set true to ban this customer's credit card or ACH information,
1549 Always returns a list: an empty list on success or a list of errors.
1557 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1559 #should try decryption (we might have the private key)
1560 # and if not maybe queue a job for the server that does?
1561 return ( "Can't (yet) ban encrypted credit cards" )
1562 if $self->is_encrypted($self->payinfo);
1564 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1565 my $error = $ban->insert;
1566 return ( $error ) if $error;
1570 grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1573 sub _banned_pay_hashref {
1584 'payby' => $payby2ban{$self->payby},
1585 'payinfo' => md5_base64($self->payinfo),
1592 Returns the agent (see L<FS::agent>) for this customer.
1598 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1603 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
1604 conjunction with the collect method.
1606 Options are passed as name-value pairs.
1608 Currently available options are:
1610 resetup - if set true, re-charges setup fees.
1612 time - bills the customer as if it were that time. Specified as a UNIX
1613 timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
1614 L<Date::Parse> for conversion functions. For example:
1618 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1621 If there is an error, returns the error, otherwise returns false.
1626 my( $self, %options ) = @_;
1627 return '' if $self->payby eq 'COMP';
1628 warn "$me bill customer ". $self->custnum. "\n"
1631 my $time = $options{'time'} || time;
1636 local $SIG{HUP} = 'IGNORE';
1637 local $SIG{INT} = 'IGNORE';
1638 local $SIG{QUIT} = 'IGNORE';
1639 local $SIG{TERM} = 'IGNORE';
1640 local $SIG{TSTP} = 'IGNORE';
1641 local $SIG{PIPE} = 'IGNORE';
1643 my $oldAutoCommit = $FS::UID::AutoCommit;
1644 local $FS::UID::AutoCommit = 0;
1647 $self->select_for_update; #mutex
1649 #create a new invoice
1650 #(we'll remove it later if it doesn't actually need to be generated [contains
1651 # no line items] and we're inside a transaciton so nothing else will see it)
1652 my $cust_bill = new FS::cust_bill ( {
1653 'custnum' => $self->custnum,
1655 #'charged' => $charged,
1658 $error = $cust_bill->insert;
1660 $dbh->rollback if $oldAutoCommit;
1661 return "can't create invoice for customer #". $self->custnum. ": $error";
1663 my $invnum = $cust_bill->invnum;
1666 # find the packages which are due for billing, find out how much they are
1667 # & generate invoice database.
1670 my( $total_setup, $total_recur ) = ( 0, 0 );
1672 my @precommit_hooks = ();
1674 foreach my $cust_pkg (
1675 qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1678 #NO!! next if $cust_pkg->cancel;
1679 next if $cust_pkg->getfield('cancel');
1681 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1683 #? to avoid use of uninitialized value errors... ?
1684 $cust_pkg->setfield('bill', '')
1685 unless defined($cust_pkg->bill);
1687 my $part_pkg = $cust_pkg->part_pkg;
1689 my %hash = $cust_pkg->hash;
1690 my $old_cust_pkg = new FS::cust_pkg \%hash;
1699 if ( !$cust_pkg->setup || $options{'resetup'} ) {
1701 warn " bill setup\n" if $DEBUG > 1;
1703 $setup = eval { $cust_pkg->calc_setup( $time ) };
1705 $dbh->rollback if $oldAutoCommit;
1706 return "$@ running calc_setup for $cust_pkg\n";
1709 $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1713 # bill recurring fee
1718 if ( $part_pkg->getfield('freq') ne '0' &&
1719 ! $cust_pkg->getfield('susp') &&
1720 ( $cust_pkg->getfield('bill') || 0 ) <= $time
1723 warn " bill recur\n" if $DEBUG > 1;
1725 # XXX shared with $recur_prog
1726 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1728 #over two params! lets at least switch to a hashref for the rest...
1729 my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1731 $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1733 $dbh->rollback if $oldAutoCommit;
1734 return "$@ running calc_recur for $cust_pkg\n";
1737 #change this bit to use Date::Manip? CAREFUL with timezones (see
1738 # mailing list archive)
1739 my ($sec,$min,$hour,$mday,$mon,$year) =
1740 (localtime($sdate) )[0,1,2,3,4,5];
1742 #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1743 # only for figuring next bill date, nothing else, so, reset $sdate again
1745 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1746 $cust_pkg->last_bill($sdate)
1747 if $cust_pkg->dbdef_table->column('last_bill');
1749 if ( $part_pkg->freq =~ /^\d+$/ ) {
1750 $mon += $part_pkg->freq;
1751 until ( $mon < 12 ) { $mon -= 12; $year++; }
1752 } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1754 $mday += $weeks * 7;
1755 } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1758 } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1762 $dbh->rollback if $oldAutoCommit;
1763 return "unparsable frequency: ". $part_pkg->freq;
1765 $cust_pkg->setfield('bill',
1766 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1769 warn "\$setup is undefined" unless defined($setup);
1770 warn "\$recur is undefined" unless defined($recur);
1771 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1774 # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1777 if ( $cust_pkg->modified ) {
1779 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1782 $error=$cust_pkg->replace($old_cust_pkg);
1783 if ( $error ) { #just in case
1784 $dbh->rollback if $oldAutoCommit;
1785 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1788 $setup = sprintf( "%.2f", $setup );
1789 $recur = sprintf( "%.2f", $recur );
1790 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1791 $dbh->rollback if $oldAutoCommit;
1792 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1794 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1795 $dbh->rollback if $oldAutoCommit;
1796 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1799 if ( $setup != 0 || $recur != 0 ) {
1801 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1803 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1804 'invnum' => $invnum,
1805 'pkgnum' => $cust_pkg->pkgnum,
1809 'edate' => $cust_pkg->bill,
1810 'details' => \@details,
1812 $error = $cust_bill_pkg->insert;
1814 $dbh->rollback if $oldAutoCommit;
1815 return "can't create invoice line item for invoice #$invnum: $error";
1817 $total_setup += $setup;
1818 $total_recur += $recur;
1824 unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1827 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1830 my %taxhash = map { $_ => $self->get("$prefix$_") }
1831 qw( state county country );
1833 $taxhash{'taxclass'} = $part_pkg->taxclass;
1835 my @taxes = qsearch( 'cust_main_county', \%taxhash );
1838 $taxhash{'taxclass'} = '';
1839 @taxes = qsearch( 'cust_main_county', \%taxhash );
1842 #one more try at a whole-country tax rate
1844 $taxhash{$_} = '' foreach qw( state county );
1845 @taxes = qsearch( 'cust_main_county', \%taxhash );
1848 # maybe eliminate this entirely, along with all the 0% records
1850 $dbh->rollback if $oldAutoCommit;
1852 "fatal: can't find tax rate for state/county/country/taxclass ".
1853 join('/', ( map $self->get("$prefix$_"),
1854 qw(state county country)
1856 $part_pkg->taxclass ). "\n";
1859 foreach my $tax ( @taxes ) {
1861 my $taxable_charged = 0;
1862 $taxable_charged += $setup
1863 unless $part_pkg->setuptax =~ /^Y$/i
1864 || $tax->setuptax =~ /^Y$/i;
1865 $taxable_charged += $recur
1866 unless $part_pkg->recurtax =~ /^Y$/i
1867 || $tax->recurtax =~ /^Y$/i;
1868 next unless $taxable_charged;
1870 if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1871 #my ($mon,$year) = (localtime($sdate) )[4,5];
1872 my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1874 my $freq = $part_pkg->freq || 1;
1875 if ( $freq !~ /(\d+)$/ ) {
1876 $dbh->rollback if $oldAutoCommit;
1877 return "daily/weekly package definitions not (yet?)".
1878 " compatible with monthly tax exemptions";
1880 my $taxable_per_month =
1881 sprintf("%.2f", $taxable_charged / $freq );
1883 #call the whole thing off if this customer has any old
1884 #exemption records...
1885 my @cust_tax_exempt =
1886 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1887 if ( @cust_tax_exempt ) {
1888 $dbh->rollback if $oldAutoCommit;
1890 'this customer still has old-style tax exemption records; '.
1891 'run bin/fs-migrate-cust_tax_exempt?';
1894 foreach my $which_month ( 1 .. $freq ) {
1896 #maintain the new exemption table now
1899 FROM cust_tax_exempt_pkg
1900 LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1901 LEFT JOIN cust_bill USING ( invnum )
1907 my $sth = dbh->prepare($sql) or do {
1908 $dbh->rollback if $oldAutoCommit;
1909 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1917 $dbh->rollback if $oldAutoCommit;
1918 return "fatal: can't lookup exising exemption: ". dbh->errstr;
1920 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1922 my $remaining_exemption =
1923 $tax->exempt_amount - $existing_exemption;
1924 if ( $remaining_exemption > 0 ) {
1925 my $addl = $remaining_exemption > $taxable_per_month
1926 ? $taxable_per_month
1927 : $remaining_exemption;
1928 $taxable_charged -= $addl;
1930 my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1931 'billpkgnum' => $cust_bill_pkg->billpkgnum,
1932 'taxnum' => $tax->taxnum,
1933 'year' => 1900+$year,
1935 'amount' => sprintf("%.2f", $addl ),
1937 $error = $cust_tax_exempt_pkg->insert;
1939 $dbh->rollback if $oldAutoCommit;
1940 return "fatal: can't insert cust_tax_exempt_pkg: $error";
1942 } # if $remaining_exemption > 0
1946 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1947 until ( $mon < 13 ) { $mon -= 12; $year++; }
1949 } #foreach $which_month
1951 } #if $tax->exempt_amount
1953 $taxable_charged = sprintf( "%.2f", $taxable_charged);
1955 #$tax += $taxable_charged * $cust_main_county->tax / 100
1956 $tax{ $tax->taxname || 'Tax' } +=
1957 $taxable_charged * $tax->tax / 100
1959 } #foreach my $tax ( @taxes )
1961 } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1963 } #if $setup != 0 || $recur != 0
1965 } #if $cust_pkg->modified
1967 } #foreach my $cust_pkg
1969 unless ( $cust_bill->cust_bill_pkg ) {
1970 $cust_bill->delete; #don't create an invoice w/o line items
1971 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1975 my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1977 foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1978 my $tax = sprintf("%.2f", $tax{$taxname} );
1979 $charged = sprintf( "%.2f", $charged+$tax );
1981 my $cust_bill_pkg = new FS::cust_bill_pkg ({
1982 'invnum' => $invnum,
1988 'itemdesc' => $taxname,
1990 $error = $cust_bill_pkg->insert;
1992 $dbh->rollback if $oldAutoCommit;
1993 return "can't create invoice line item for invoice #$invnum: $error";
1995 $total_setup += $tax;
1999 $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
2000 $error = $cust_bill->replace;
2002 $dbh->rollback if $oldAutoCommit;
2003 return "can't update charged for invoice #$invnum: $error";
2006 foreach my $hook ( @precommit_hooks ) {
2008 &{$hook}; #($self) ?
2011 $dbh->rollback if $oldAutoCommit;
2012 return "$@ running precommit hook $hook\n";
2016 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2020 =item collect OPTIONS
2022 (Attempt to) collect money for this customer's outstanding invoices (see
2023 L<FS::cust_bill>). Usually used after the bill method.
2025 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2026 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2027 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2029 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2030 and the invoice events web interface.
2032 If there is an error, returns the error, otherwise returns false.
2034 Options are passed as name-value pairs.
2036 Currently available options are:
2038 invoice_time - Use this time when deciding when to print invoices and
2039 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>
2040 for conversion functions.
2042 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2045 quiet - set true to surpress email card/ACH decline notices.
2047 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2050 payby - allows for one time override of normal customer billing method
2055 my( $self, %options ) = @_;
2056 my $invoice_time = $options{'invoice_time'} || time;
2059 local $SIG{HUP} = 'IGNORE';
2060 local $SIG{INT} = 'IGNORE';
2061 local $SIG{QUIT} = 'IGNORE';
2062 local $SIG{TERM} = 'IGNORE';
2063 local $SIG{TSTP} = 'IGNORE';
2064 local $SIG{PIPE} = 'IGNORE';
2066 my $oldAutoCommit = $FS::UID::AutoCommit;
2067 local $FS::UID::AutoCommit = 0;
2070 $self->select_for_update; #mutex
2072 my $balance = $self->balance;
2073 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2075 unless ( $balance > 0 ) { #redundant?????
2076 $dbh->rollback if $oldAutoCommit; #hmm
2080 if ( exists($options{'retry_card'}) ) {
2081 carp 'retry_card option passed to collect is deprecated; use retry';
2082 $options{'retry'} ||= $options{'retry_card'};
2084 if ( exists($options{'retry'}) && $options{'retry'} ) {
2085 my $error = $self->retry_realtime;
2087 $dbh->rollback if $oldAutoCommit;
2093 if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2094 $extra_sql = " AND freq = '1m' ";
2096 $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2099 foreach my $cust_bill ( $self->open_cust_bill ) {
2101 # don't try to charge for the same invoice if it's already in a batch
2102 #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2104 last if $self->balance <= 0;
2106 warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2109 foreach my $part_bill_event (
2110 sort { $a->seconds <=> $b->seconds
2111 || $a->weight <=> $b->weight
2112 || $a->eventpart <=> $b->eventpart }
2113 grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2114 && ! qsearch( 'cust_bill_event', {
2115 'invnum' => $cust_bill->invnum,
2116 'eventpart' => $_->eventpart,
2121 'table' => 'part_bill_event',
2122 'hashref' => { 'payby' => (exists($options{'payby'})
2126 'disabled' => '', },
2127 'extra_sql' => $extra_sql,
2131 last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
2132 || $self->balance <= 0; # or if balance<=0
2134 warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
2136 my $cust_main = $self; #for callback
2140 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2141 local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2142 $error = eval $part_bill_event->eventcode;
2146 my $statustext = '';
2150 } elsif ( $error ) {
2152 $statustext = $error;
2157 #add cust_bill_event
2158 my $cust_bill_event = new FS::cust_bill_event {
2159 'invnum' => $cust_bill->invnum,
2160 'eventpart' => $part_bill_event->eventpart,
2161 #'_date' => $invoice_time,
2163 'status' => $status,
2164 'statustext' => $statustext,
2166 $error = $cust_bill_event->insert;
2168 #$dbh->rollback if $oldAutoCommit;
2169 #return "error: $error";
2171 # gah, even with transactions.
2172 $dbh->commit if $oldAutoCommit; #well.
2173 my $e = 'WARNING: Event run but database not updated - '.
2174 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2175 ', eventpart '. $part_bill_event->eventpart.
2186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2191 =item retry_realtime
2193 Schedules realtime credit card / electronic check / LEC billing events for
2194 for retry. Useful if card information has changed or manual retry is desired.
2195 The 'collect' method must be called to actually retry the transaction.
2197 Implementation details: For each of this customer's open invoices, changes
2198 the status of the first "done" (with statustext error) realtime processing
2203 sub retry_realtime {
2206 local $SIG{HUP} = 'IGNORE';
2207 local $SIG{INT} = 'IGNORE';
2208 local $SIG{QUIT} = 'IGNORE';
2209 local $SIG{TERM} = 'IGNORE';
2210 local $SIG{TSTP} = 'IGNORE';
2211 local $SIG{PIPE} = 'IGNORE';
2213 my $oldAutoCommit = $FS::UID::AutoCommit;
2214 local $FS::UID::AutoCommit = 0;
2217 foreach my $cust_bill (
2218 grep { $_->cust_bill_event }
2219 $self->open_cust_bill
2221 my @cust_bill_event =
2222 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2224 #$_->part_bill_event->plan eq 'realtime-card'
2225 $_->part_bill_event->eventcode =~
2226 /\$cust_bill\->realtime_(card|ach|lec)/
2227 && $_->status eq 'done'
2230 $cust_bill->cust_bill_event;
2231 next unless @cust_bill_event;
2232 my $error = $cust_bill_event[0]->retry;
2234 $dbh->rollback if $oldAutoCommit;
2235 return "error scheduling invoice event for retry: $error";
2240 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2245 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2247 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2248 via a Business::OnlinePayment realtime gateway. See
2249 L<http://420.am/business-onlinepayment> for supported gateways.
2251 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2253 Available options are: I<description>, I<invnum>, I<quiet>
2255 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2256 I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2257 if set, will override the value from the customer record.
2259 I<description> is a free-text field passed to the gateway. It defaults to
2260 "Internet services".
2262 If an I<invnum> is specified, this payment (if successful) is applied to the
2263 specified invoice. If you don't specify an I<invnum> you might want to
2264 call the B<apply_payments> method.
2266 I<quiet> can be set true to surpress email decline notices.
2268 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2273 my( $self, $method, $amount, %options ) = @_;
2275 warn "$me realtime_bop: $method $amount\n";
2276 warn " $_ => $options{$_}\n" foreach keys %options;
2279 $options{'description'} ||= 'Internet services';
2281 eval "use Business::OnlinePayment";
2284 my $payinfo = exists($options{'payinfo'})
2285 ? $options{'payinfo'}
2293 if ( $options{'invnum'} ) {
2294 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2295 die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2297 map { $_->part_pkg->taxclass }
2299 map { $_->cust_pkg }
2300 $cust_bill->cust_bill_pkg;
2301 unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2302 #different taxclasses
2303 $taxclass = $taxclasses[0];
2307 #look for an agent gateway override first
2309 if ( $method eq 'CC' ) {
2310 $cardtype = cardtype($payinfo);
2311 } elsif ( $method eq 'ECHECK' ) {
2314 $cardtype = $method;
2318 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2319 cardtype => $cardtype,
2320 taxclass => $taxclass, } )
2321 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2323 taxclass => $taxclass, } )
2324 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2325 cardtype => $cardtype,
2327 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2329 taxclass => '', } );
2331 my $payment_gateway = '';
2332 my( $processor, $login, $password, $action, @bop_options );
2333 if ( $override ) { #use a payment gateway override
2335 $payment_gateway = $override->payment_gateway;
2337 $processor = $payment_gateway->gateway_module;
2338 $login = $payment_gateway->gateway_username;
2339 $password = $payment_gateway->gateway_password;
2340 $action = $payment_gateway->gateway_action;
2341 @bop_options = $payment_gateway->options;
2343 } else { #use the standard settings from the config
2345 ( $processor, $login, $password, $action, @bop_options ) =
2346 $self->default_payment_gateway($method);
2354 my $address = exists($options{'address1'})
2355 ? $options{'address1'}
2357 my $address2 = exists($options{'address2'})
2358 ? $options{'address2'}
2360 $address .= ", ". $address2 if length($address2);
2362 my $o_payname = exists($options{'payname'})
2363 ? $options{'payname'}
2365 my($payname, $payfirst, $paylast);
2366 if ( $o_payname && $method ne 'ECHECK' ) {
2367 ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2368 or return "Illegal payname $payname";
2369 ($payfirst, $paylast) = ($1, $2);
2371 $payfirst = $self->getfield('first');
2372 $paylast = $self->getfield('last');
2373 $payname = "$payfirst $paylast";
2376 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2377 if ( $conf->exists('emailinvoiceauto')
2378 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2379 push @invoicing_list, $self->all_emails;
2382 my $email = ($conf->exists('business-onlinepayment-email-override'))
2383 ? $conf->config('business-onlinepayment-email-override')
2384 : $invoicing_list[0];
2388 my $payip = exists($options{'payip'})
2391 $content{customer_ip} = $payip
2394 if ( $method eq 'CC' ) {
2396 $content{card_number} = $payinfo;
2397 my $paydate = exists($options{'paydate'})
2398 ? $options{'paydate'}
2400 $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2401 $content{expiration} = "$2/$1";
2403 my $paycvv = exists($options{'paycvv'})
2404 ? $options{'paycvv'}
2406 $content{cvv2} = $self->paycvv
2409 my $paystart_month = exists($options{'paystart_month'})
2410 ? $options{'paystart_month'}
2411 : $self->paystart_month;
2413 my $paystart_year = exists($options{'paystart_year'})
2414 ? $options{'paystart_year'}
2415 : $self->paystart_year;
2417 $content{card_start} = "$paystart_month/$paystart_year"
2418 if $paystart_month && $paystart_year;
2420 my $payissue = exists($options{'payissue'})
2421 ? $options{'payissue'}
2423 $content{issue_number} = $payissue if $payissue;
2425 $content{recurring_billing} = 'YES'
2426 if qsearch('cust_pay', { 'custnum' => $self->custnum,
2428 'payinfo' => $payinfo,
2431 } elsif ( $method eq 'ECHECK' ) {
2432 ( $content{account_number}, $content{routing_code} ) =
2433 split('@', $payinfo);
2434 $content{bank_name} = $o_payname;
2435 $content{account_type} = 'CHECKING';
2436 $content{account_name} = $payname;
2437 $content{customer_org} = $self->company ? 'B' : 'I';
2438 $content{customer_ssn} = exists($options{'ss'})
2441 } elsif ( $method eq 'LEC' ) {
2442 $content{phone} = $payinfo;
2446 # run transaction(s)
2449 my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2451 my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2452 $transaction->content(
2455 'password' => $password,
2456 'action' => $action1,
2457 'description' => $options{'description'},
2458 'amount' => $amount,
2459 'invoice_number' => $options{'invnum'},
2460 'customer_id' => $self->custnum,
2461 'last_name' => $paylast,
2462 'first_name' => $payfirst,
2464 'address' => $address,
2465 'city' => ( exists($options{'city'})
2468 'state' => ( exists($options{'state'})
2471 'zip' => ( exists($options{'zip'})
2474 'country' => ( exists($options{'country'})
2475 ? $options{'country'}
2477 'referer' => 'http://cleanwhisker.420.am/',
2479 'phone' => $self->daytime || $self->night,
2482 $transaction->submit();
2484 if ( $transaction->is_success() && $action2 ) {
2485 my $auth = $transaction->authorization;
2486 my $ordernum = $transaction->can('order_number')
2487 ? $transaction->order_number
2491 new Business::OnlinePayment( $processor, @bop_options );
2498 password => $password,
2499 order_number => $ordernum,
2501 authorization => $auth,
2502 description => $options{'description'},
2505 foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
2506 transaction_sequence_num local_transaction_date
2507 local_transaction_time AVS_result_code )) {
2508 $capture{$field} = $transaction->$field() if $transaction->can($field);
2511 $capture->content( %capture );
2515 unless ( $capture->is_success ) {
2516 my $e = "Authorization successful but capture failed, custnum #".
2517 $self->custnum. ': '. $capture->result_code.
2518 ": ". $capture->error_message;
2526 # remove paycvv after initial transaction
2529 #false laziness w/misc/process/payment.cgi - check both to make sure working
2531 if ( defined $self->dbdef_table->column('paycvv')
2532 && length($self->paycvv)
2533 && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2535 my $error = $self->remove_cvv;
2537 warn "WARNING: error removing cvv: $error\n";
2545 if ( $transaction->is_success() ) {
2547 my %method2payby = (
2554 if ( $payment_gateway ) { # agent override
2555 $paybatch = $payment_gateway->gatewaynum. '-';
2558 $paybatch .= "$processor:". $transaction->authorization;
2560 $paybatch .= ':'. $transaction->order_number
2561 if $transaction->can('order_number')
2562 && length($transaction->order_number);
2564 my $cust_pay = new FS::cust_pay ( {
2565 'custnum' => $self->custnum,
2566 'invnum' => $options{'invnum'},
2569 'payby' => $method2payby{$method},
2570 'payinfo' => $payinfo,
2571 'paybatch' => $paybatch,
2573 my $error = $cust_pay->insert;
2575 $cust_pay->invnum(''); #try again with no specific invnum
2576 my $error2 = $cust_pay->insert;
2578 # gah, even with transactions.
2579 my $e = 'WARNING: Card/ACH debited but database not updated - '.
2580 "error inserting payment ($processor): $error2".
2581 " (previously tried insert with invnum #$options{'invnum'}" .
2587 return ''; #no error
2591 my $perror = "$processor error: ". $transaction->error_message;
2593 if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2594 && $conf->exists('emaildecline')
2595 && grep { $_ ne 'POST' } $self->invoicing_list
2596 && ! grep { $transaction->error_message =~ /$_/ }
2597 $conf->config('emaildecline-exclude')
2599 my @templ = $conf->config('declinetemplate');
2600 my $template = new Text::Template (
2602 SOURCE => [ map "$_\n", @templ ],
2603 ) or return "($perror) can't create template: $Text::Template::ERROR";
2604 $template->compile()
2605 or return "($perror) can't compile template: $Text::Template::ERROR";
2607 my $templ_hash = { error => $transaction->error_message };
2609 my $error = send_email(
2610 'from' => $conf->config('invoice_from'),
2611 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2612 'subject' => 'Your payment could not be processed',
2613 'body' => [ $template->fill_in(HASH => $templ_hash) ],
2616 $perror .= " (also received error sending decline notification: $error)"
2626 =item default_payment_gateway
2630 sub default_payment_gateway {
2631 my( $self, $method ) = @_;
2633 die "Real-time processing not enabled\n"
2634 unless $conf->exists('business-onlinepayment');
2637 my $bop_config = 'business-onlinepayment';
2638 $bop_config .= '-ach'
2639 if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2640 my ( $processor, $login, $password, $action, @bop_options ) =
2641 $conf->config($bop_config);
2642 $action ||= 'normal authorization';
2643 pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2644 die "No real-time processor is enabled - ".
2645 "did you set the business-onlinepayment configuration value?\n"
2648 ( $processor, $login, $password, $action, @bop_options )
2653 Removes the I<paycvv> field from the database directly.
2655 If there is an error, returns the error, otherwise returns false.
2661 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2662 or return dbh->errstr;
2663 $sth->execute($self->custnum)
2664 or return $sth->errstr;
2669 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2671 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2672 via a Business::OnlinePayment realtime gateway. See
2673 L<http://420.am/business-onlinepayment> for supported gateways.
2675 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2677 Available options are: I<amount>, I<reason>, I<paynum>
2679 Most gateways require a reference to an original payment transaction to refund,
2680 so you probably need to specify a I<paynum>.
2682 I<amount> defaults to the original amount of the payment if not specified.
2684 I<reason> specifies a reason for the refund.
2686 Implementation note: If I<amount> is unspecified or equal to the amount of the
2687 orignal payment, first an attempt is made to "void" the transaction via
2688 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2689 the normal attempt is made to "refund" ("credit") the transaction via the
2690 gateway is attempted.
2692 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2693 #I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
2694 #if set, will override the value from the customer record.
2696 #If an I<invnum> is specified, this payment (if successful) is applied to the
2697 #specified invoice. If you don't specify an I<invnum> you might want to
2698 #call the B<apply_payments> method.
2702 #some false laziness w/realtime_bop, not enough to make it worth merging
2703 #but some useful small subs should be pulled out
2704 sub realtime_refund_bop {
2705 my( $self, $method, %options ) = @_;
2707 warn "$me realtime_refund_bop: $method refund\n";
2708 warn " $_ => $options{$_}\n" foreach keys %options;
2711 eval "use Business::OnlinePayment";
2715 # look up the original payment and optionally a gateway for that payment
2719 my $amount = $options{'amount'};
2721 my( $processor, $login, $password, @bop_options ) ;
2722 my( $auth, $order_number ) = ( '', '', '' );
2724 if ( $options{'paynum'} ) {
2726 warn " paynum: $options{paynum}\n" if $DEBUG > 1;
2727 $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2728 or return "Unknown paynum $options{'paynum'}";
2729 $amount ||= $cust_pay->paid;
2731 $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2732 or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2733 $cust_pay->paybatch;
2734 my $gatewaynum = '';
2735 ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2737 if ( $gatewaynum ) { #gateway for the payment to be refunded
2739 my $payment_gateway =
2740 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2741 die "payment gateway $gatewaynum not found"
2742 unless $payment_gateway;
2744 $processor = $payment_gateway->gateway_module;
2745 $login = $payment_gateway->gateway_username;
2746 $password = $payment_gateway->gateway_password;
2747 @bop_options = $payment_gateway->options;
2749 } else { #try the default gateway
2751 my( $conf_processor, $unused_action );
2752 ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2753 $self->default_payment_gateway($method);
2755 return "processor of payment $options{'paynum'} $processor does not".
2756 " match default processor $conf_processor"
2757 unless $processor eq $conf_processor;
2762 } else { # didn't specify a paynum, so look for agent gateway overrides
2763 # like a normal transaction
2766 if ( $method eq 'CC' ) {
2767 $cardtype = cardtype($self->payinfo);
2768 } elsif ( $method eq 'ECHECK' ) {
2771 $cardtype = $method;
2774 qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2775 cardtype => $cardtype,
2777 || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2779 taxclass => '', } );
2781 if ( $override ) { #use a payment gateway override
2783 my $payment_gateway = $override->payment_gateway;
2785 $processor = $payment_gateway->gateway_module;
2786 $login = $payment_gateway->gateway_username;
2787 $password = $payment_gateway->gateway_password;
2788 #$action = $payment_gateway->gateway_action;
2789 @bop_options = $payment_gateway->options;
2791 } else { #use the standard settings from the config
2794 ( $processor, $login, $password, $unused_action, @bop_options ) =
2795 $self->default_payment_gateway($method);
2800 return "neither amount nor paynum specified" unless $amount;
2805 'password' => $password,
2806 'order_number' => $order_number,
2807 'amount' => $amount,
2808 'referer' => 'http://cleanwhisker.420.am/',
2810 $content{authorization} = $auth
2811 if length($auth); #echeck/ACH transactions have an order # but no auth
2812 #(at least with authorize.net)
2814 #first try void if applicable
2815 if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2816 warn " attempting void\n" if $DEBUG > 1;
2817 my $void = new Business::OnlinePayment( $processor, @bop_options );
2818 $void->content( 'action' => 'void', %content );
2820 if ( $void->is_success ) {
2821 my $error = $cust_pay->void($options{'reason'});
2823 # gah, even with transactions.
2824 my $e = 'WARNING: Card/ACH voided but database not updated - '.
2825 "error voiding payment: $error";
2829 warn " void successful\n" if $DEBUG > 1;
2834 warn " void unsuccessful, trying refund\n"
2838 my $address = $self->address1;
2839 $address .= ", ". $self->address2 if $self->address2;
2841 my($payname, $payfirst, $paylast);
2842 if ( $self->payname && $method ne 'ECHECK' ) {
2843 $payname = $self->payname;
2844 $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2845 or return "Illegal payname $payname";
2846 ($payfirst, $paylast) = ($1, $2);
2848 $payfirst = $self->getfield('first');
2849 $paylast = $self->getfield('last');
2850 $payname = "$payfirst $paylast";
2853 my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2854 if ( $conf->exists('emailinvoiceauto')
2855 || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2856 push @invoicing_list, $self->all_emails;
2859 my $email = ($conf->exists('business-onlinepayment-email-override'))
2860 ? $conf->config('business-onlinepayment-email-override')
2861 : $invoicing_list[0];
2863 my $payip = exists($options{'payip'})
2866 $content{customer_ip} = $payip
2870 if ( $method eq 'CC' ) {
2873 $content{card_number} = $payinfo = $cust_pay->payinfo;
2874 #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2875 #$content{expiration} = "$2/$1";
2877 $content{card_number} = $payinfo = $self->payinfo;
2878 $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2879 $content{expiration} = "$2/$1";
2882 } elsif ( $method eq 'ECHECK' ) {
2883 ( $content{account_number}, $content{routing_code} ) =
2884 split('@', $payinfo = $self->payinfo);
2885 $content{bank_name} = $self->payname;
2886 $content{account_type} = 'CHECKING';
2887 $content{account_name} = $payname;
2888 $content{customer_org} = $self->company ? 'B' : 'I';
2889 $content{customer_ssn} = $self->ss;
2890 } elsif ( $method eq 'LEC' ) {
2891 $content{phone} = $payinfo = $self->payinfo;
2895 my $refund = new Business::OnlinePayment( $processor, @bop_options );
2896 my %sub_content = $refund->content(
2897 'action' => 'credit',
2898 'customer_id' => $self->custnum,
2899 'last_name' => $paylast,
2900 'first_name' => $payfirst,
2902 'address' => $address,
2903 'city' => $self->city,
2904 'state' => $self->state,
2905 'zip' => $self->zip,
2906 'country' => $self->country,
2908 'phone' => $self->daytime || $self->night,
2911 warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
2915 return "$processor error: ". $refund->error_message
2916 unless $refund->is_success();
2918 my %method2payby = (
2924 my $paybatch = "$processor:". $refund->authorization;
2925 $paybatch .= ':'. $refund->order_number
2926 if $refund->can('order_number') && $refund->order_number;
2928 while ( $cust_pay && $cust_pay->unappled < $amount ) {
2929 my @cust_bill_pay = $cust_pay->cust_bill_pay;
2930 last unless @cust_bill_pay;
2931 my $cust_bill_pay = pop @cust_bill_pay;
2932 my $error = $cust_bill_pay->delete;
2936 my $cust_refund = new FS::cust_refund ( {
2937 'custnum' => $self->custnum,
2938 'paynum' => $options{'paynum'},
2939 'refund' => $amount,
2941 'payby' => $method2payby{$method},
2942 'payinfo' => $payinfo,
2943 'paybatch' => $paybatch,
2944 'reason' => $options{'reason'} || 'card or ACH refund',
2946 my $error = $cust_refund->insert;
2948 $cust_refund->paynum(''); #try again with no specific paynum
2949 my $error2 = $cust_refund->insert;
2951 # gah, even with transactions.
2952 my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2953 "error inserting refund ($processor): $error2".
2954 " (previously tried insert with paynum #$options{'paynum'}" .
2967 Returns the total owed for this customer on all invoices
2968 (see L<FS::cust_bill/owed>).
2974 $self->total_owed_date(2145859200); #12/31/2037
2977 =item total_owed_date TIME
2979 Returns the total owed for this customer on all invoices with date earlier than
2980 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2981 see L<Time::Local> and L<Date::Parse> for conversion functions.
2985 sub total_owed_date {
2989 foreach my $cust_bill (
2990 grep { $_->_date <= $time }
2991 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2993 $total_bill += $cust_bill->owed;
2995 sprintf( "%.2f", $total_bill );
2998 =item apply_credits OPTION => VALUE ...
3000 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3001 to outstanding invoice balances in chronological order (or reverse
3002 chronological order if the I<order> option is set to B<newest>) and returns the
3003 value of any remaining unapplied credits available for refund (see
3004 L<FS::cust_refund>).
3012 return 0 unless $self->total_credited;
3014 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3015 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3017 my @invoices = $self->open_cust_bill;
3018 @invoices = sort { $b->_date <=> $a->_date } @invoices
3019 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3022 foreach my $cust_bill ( @invoices ) {
3025 if ( !defined($credit) || $credit->credited == 0) {
3026 $credit = pop @credits or last;
3029 if ($cust_bill->owed >= $credit->credited) {
3030 $amount=$credit->credited;
3032 $amount=$cust_bill->owed;
3035 my $cust_credit_bill = new FS::cust_credit_bill ( {
3036 'crednum' => $credit->crednum,
3037 'invnum' => $cust_bill->invnum,
3038 'amount' => $amount,
3040 my $error = $cust_credit_bill->insert;
3041 die $error if $error;
3043 redo if ($cust_bill->owed > 0);
3047 return $self->total_credited;
3050 =item apply_payments
3052 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3053 to outstanding invoice balances in chronological order.
3055 #and returns the value of any remaining unapplied payments.
3059 sub apply_payments {
3064 my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3065 qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3067 my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3068 qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3072 foreach my $cust_bill ( @invoices ) {
3075 if ( !defined($payment) || $payment->unapplied == 0 ) {
3076 $payment = pop @payments or last;
3079 if ( $cust_bill->owed >= $payment->unapplied ) {
3080 $amount = $payment->unapplied;
3082 $amount = $cust_bill->owed;
3085 my $cust_bill_pay = new FS::cust_bill_pay ( {
3086 'paynum' => $payment->paynum,
3087 'invnum' => $cust_bill->invnum,
3088 'amount' => $amount,
3090 my $error = $cust_bill_pay->insert;
3091 die $error if $error;
3093 redo if ( $cust_bill->owed > 0);
3097 return $self->total_unapplied_payments;
3100 =item total_credited
3102 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3103 customer. See L<FS::cust_credit/credited>.
3107 sub total_credited {
3109 my $total_credit = 0;
3110 foreach my $cust_credit ( qsearch('cust_credit', {
3111 'custnum' => $self->custnum,
3113 $total_credit += $cust_credit->credited;
3115 sprintf( "%.2f", $total_credit );
3118 =item total_unapplied_payments
3120 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3121 See L<FS::cust_pay/unapplied>.
3125 sub total_unapplied_payments {
3127 my $total_unapplied = 0;
3128 foreach my $cust_pay ( qsearch('cust_pay', {
3129 'custnum' => $self->custnum,
3131 $total_unapplied += $cust_pay->unapplied;
3133 sprintf( "%.2f", $total_unapplied );
3138 Returns the balance for this customer (total_owed minus total_credited
3139 minus total_unapplied_payments).
3146 $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3150 =item balance_date TIME
3152 Returns the balance for this customer, only considering invoices with date
3153 earlier than TIME (total_owed_date minus total_credited minus
3154 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3155 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3164 $self->total_owed_date($time)
3165 - $self->total_credited
3166 - $self->total_unapplied_payments
3170 =item in_transit_payments
3172 Returns the total of requests for payments for this customer pending in
3173 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3177 sub in_transit_payments {
3179 my $in_transit_payments = 0;
3180 foreach my $pay_batch ( qsearch('pay_batch', {
3183 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3184 'batchnum' => $pay_batch->batchnum,
3185 'custnum' => $self->custnum,
3187 $in_transit_payments += $cust_pay_batch->amount;
3190 sprintf( "%.2f", $in_transit_payments );
3193 =item paydate_monthyear
3195 Returns a two-element list consisting of the month and year of this customer's
3196 paydate (credit card expiration date for CARD customers)
3200 sub paydate_monthyear {
3202 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3204 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3211 =item payinfo_masked
3213 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.
3215 Credit Cards - Mask all but the last four characters.
3216 Checks - Mask all but last 2 of account number and bank routing number.
3217 Others - Do nothing, return the unmasked string.
3221 sub payinfo_masked {
3223 return $self->paymask;
3226 =item invoicing_list [ ARRAYREF ]
3228 If an arguement is given, sets these email addresses as invoice recipients
3229 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3230 (except as warnings), so use check_invoicing_list first.
3232 Returns a list of email addresses (with svcnum entries expanded).
3234 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3235 check it without disturbing anything by passing nothing.
3237 This interface may change in the future.
3241 sub invoicing_list {
3242 my( $self, $arrayref ) = @_;
3245 my @cust_main_invoice;
3246 if ( $self->custnum ) {
3247 @cust_main_invoice =
3248 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3250 @cust_main_invoice = ();
3252 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3253 #warn $cust_main_invoice->destnum;
3254 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3255 #warn $cust_main_invoice->destnum;
3256 my $error = $cust_main_invoice->delete;
3257 warn $error if $error;
3260 if ( $self->custnum ) {
3261 @cust_main_invoice =
3262 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3264 @cust_main_invoice = ();
3266 my %seen = map { $_->address => 1 } @cust_main_invoice;
3267 foreach my $address ( @{$arrayref} ) {
3268 next if exists $seen{$address} && $seen{$address};
3269 $seen{$address} = 1;
3270 my $cust_main_invoice = new FS::cust_main_invoice ( {
3271 'custnum' => $self->custnum,
3274 my $error = $cust_main_invoice->insert;
3275 warn $error if $error;
3279 if ( $self->custnum ) {
3281 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3288 =item check_invoicing_list ARRAYREF
3290 Checks these arguements as valid input for the invoicing_list method. If there
3291 is an error, returns the error, otherwise returns false.
3295 sub check_invoicing_list {
3296 my( $self, $arrayref ) = @_;
3297 foreach my $address ( @{$arrayref} ) {
3299 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3300 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3303 my $cust_main_invoice = new FS::cust_main_invoice ( {
3304 'custnum' => $self->custnum,
3307 my $error = $self->custnum
3308 ? $cust_main_invoice->check
3309 : $cust_main_invoice->checkdest
3311 return $error if $error;
3316 =item set_default_invoicing_list
3318 Sets the invoicing list to all accounts associated with this customer,
3319 overwriting any previous invoicing list.
3323 sub set_default_invoicing_list {
3325 $self->invoicing_list($self->all_emails);
3330 Returns the email addresses of all accounts provisioned for this customer.
3337 foreach my $cust_pkg ( $self->all_pkgs ) {
3338 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3340 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3341 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3343 $list{$_}=1 foreach map { $_->email } @svc_acct;
3348 =item invoicing_list_addpost
3350 Adds postal invoicing to this customer. If this customer is already configured
3351 to receive postal invoices, does nothing.
3355 sub invoicing_list_addpost {
3357 return if grep { $_ eq 'POST' } $self->invoicing_list;
3358 my @invoicing_list = $self->invoicing_list;
3359 push @invoicing_list, 'POST';
3360 $self->invoicing_list(\@invoicing_list);
3363 =item invoicing_list_emailonly
3365 Returns the list of email invoice recipients (invoicing_list without non-email
3366 destinations such as POST and FAX).
3370 sub invoicing_list_emailonly {
3372 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3375 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3377 Returns an array of customers referred by this customer (referral_custnum set
3378 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3379 customers referred by customers referred by this customer and so on, inclusive.
3380 The default behavior is DEPTH 1 (no recursion).
3384 sub referral_cust_main {
3386 my $depth = @_ ? shift : 1;
3387 my $exclude = @_ ? shift : {};
3390 map { $exclude->{$_->custnum}++; $_; }
3391 grep { ! $exclude->{ $_->custnum } }
3392 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3396 map { $_->referral_cust_main($depth-1, $exclude) }
3403 =item referral_cust_main_ncancelled
3405 Same as referral_cust_main, except only returns customers with uncancelled
3410 sub referral_cust_main_ncancelled {
3412 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3415 =item referral_cust_pkg [ DEPTH ]
3417 Like referral_cust_main, except returns a flat list of all unsuspended (and
3418 uncancelled) packages for each customer. The number of items in this list may
3419 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3423 sub referral_cust_pkg {
3425 my $depth = @_ ? shift : 1;
3427 map { $_->unsuspended_pkgs }
3428 grep { $_->unsuspended_pkgs }
3429 $self->referral_cust_main($depth);
3432 =item referring_cust_main
3434 Returns the single cust_main record for the customer who referred this customer
3435 (referral_custnum), or false.
3439 sub referring_cust_main {
3441 return '' unless $self->referral_custnum;
3442 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3445 =item credit AMOUNT, REASON
3447 Applies a credit to this customer. If there is an error, returns the error,
3448 otherwise returns false.
3453 my( $self, $amount, $reason ) = @_;
3454 my $cust_credit = new FS::cust_credit {
3455 'custnum' => $self->custnum,
3456 'amount' => $amount,
3457 'reason' => $reason,
3459 $cust_credit->insert;
3462 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3464 Creates a one-time charge for this customer. If there is an error, returns
3465 the error, otherwise returns false.
3470 my ( $self, $amount ) = ( shift, shift );
3471 my $pkg = @_ ? shift : 'One-time charge';
3472 my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3473 my $taxclass = @_ ? shift : '';
3475 local $SIG{HUP} = 'IGNORE';
3476 local $SIG{INT} = 'IGNORE';
3477 local $SIG{QUIT} = 'IGNORE';
3478 local $SIG{TERM} = 'IGNORE';
3479 local $SIG{TSTP} = 'IGNORE';
3480 local $SIG{PIPE} = 'IGNORE';
3482 my $oldAutoCommit = $FS::UID::AutoCommit;
3483 local $FS::UID::AutoCommit = 0;
3486 my $part_pkg = new FS::part_pkg ( {
3488 'comment' => $comment,
3489 #'setup' => $amount,
3492 'plandata' => "setup_fee=$amount",
3495 'taxclass' => $taxclass,
3498 my $error = $part_pkg->insert;
3500 $dbh->rollback if $oldAutoCommit;
3504 my $pkgpart = $part_pkg->pkgpart;
3505 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3506 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3507 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3508 $error = $type_pkgs->insert;
3510 $dbh->rollback if $oldAutoCommit;
3515 my $cust_pkg = new FS::cust_pkg ( {
3516 'custnum' => $self->custnum,
3517 'pkgpart' => $pkgpart,
3520 $error = $cust_pkg->insert;
3522 $dbh->rollback if $oldAutoCommit;
3526 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3533 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3539 sort { $a->_date <=> $b->_date }
3540 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3543 =item open_cust_bill
3545 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3550 sub open_cust_bill {
3552 grep { $_->owed > 0 } $self->cust_bill;
3557 Returns all the credits (see L<FS::cust_credit>) for this customer.
3563 sort { $a->_date <=> $b->_date }
3564 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3569 Returns all the payments (see L<FS::cust_pay>) for this customer.
3575 sort { $a->_date <=> $b->_date }
3576 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3581 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3587 sort { $a->_date <=> $b->_date }
3588 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3594 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3600 sort { $a->_date <=> $b->_date }
3601 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3604 =item select_for_update
3606 Selects this record with the SQL "FOR UPDATE" command. This can be useful as
3611 sub select_for_update {
3613 qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3618 Returns a name string for this customer, either "Company (Last, First)" or
3625 my $name = $self->contact;
3626 $name = $self->company. " ($name)" if $self->company;
3632 Returns a name string for this (service/shipping) contact, either
3633 "Company (Last, First)" or "Last, First".
3639 if ( $self->get('ship_last') ) {
3640 my $name = $self->ship_contact;
3641 $name = $self->ship_company. " ($name)" if $self->ship_company;
3650 Returns this customer's full (billing) contact name only, "Last, First"
3656 $self->get('last'). ', '. $self->first;
3661 Returns this customer's full (shipping) contact name only, "Last, First"
3667 $self->get('ship_last')
3668 ? $self->get('ship_last'). ', '. $self->ship_first
3674 Returns this customer's full country name
3680 code2country($self->country);
3685 Returns a status string for this customer, currently:
3689 =item prospect - No packages have ever been ordered
3691 =item active - One or more recurring packages is active
3693 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3695 =item suspended - All non-cancelled recurring packages are suspended
3697 =item cancelled - All recurring packages are cancelled
3705 for my $status (qw( prospect active inactive suspended cancelled )) {
3706 my $method = $status.'_sql';
3707 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3708 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3709 $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3710 return $status if $sth->fetchrow_arrayref->[0];
3716 Returns a hex triplet color string for this customer's status.
3720 use vars qw(%statuscolor);
3722 'prospect' => '7e0079', #'000000', #black? naw, purple
3723 'active' => '00CC00', #green
3724 'inactive' => '0000CC', #blue
3725 'suspended' => 'FF9900', #yellow
3726 'cancelled' => 'FF0000', #red
3731 $statuscolor{$self->status};
3736 =head1 CLASS METHODS
3742 Returns an SQL expression identifying prospective cust_main records (customers
3743 with no packages ever ordered)
3747 use vars qw($select_count_pkgs);
3748 $select_count_pkgs =
3749 "SELECT COUNT(*) FROM cust_pkg
3750 WHERE cust_pkg.custnum = cust_main.custnum";
3752 sub select_count_pkgs_sql {
3756 sub prospect_sql { "
3757 0 = ( $select_count_pkgs )
3762 Returns an SQL expression identifying active cust_main records (customers with
3763 no active recurring packages, but otherwise unsuspended/uncancelled).
3768 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3774 Returns an SQL expression identifying inactive cust_main records (customers with
3775 active recurring packages).
3779 sub inactive_sql { "
3780 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3782 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3788 Returns an SQL expression identifying suspended cust_main records.
3793 sub suspended_sql { susp_sql(@_); }
3795 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3797 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3803 Returns an SQL expression identifying cancelled cust_main records.
3807 sub cancelled_sql { cancel_sql(@_); }
3810 my $recurring_sql = FS::cust_pkg->recurring_sql;
3811 #my $recurring_sql = "
3812 # '0' != ( select freq from part_pkg
3813 # where cust_pkg.pkgpart = part_pkg.pkgpart )
3817 0 < ( $select_count_pkgs )
3818 AND 0 = ( $select_count_pkgs AND $recurring_sql
3819 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3825 =item uncancelled_sql
3827 Returns an SQL expression identifying un-cancelled cust_main records.
3831 sub uncancelled_sql { uncancel_sql(@_); }
3832 sub uncancel_sql { "
3833 ( 0 < ( $select_count_pkgs
3834 AND ( cust_pkg.cancel IS NULL
3835 OR cust_pkg.cancel = 0
3838 OR 0 = ( $select_count_pkgs )
3842 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3844 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3845 records. Currently, I<first>, I<last> and/or I<company> may be specified (the
3846 appropriate ship_ field is also searched).
3848 Additional options are the same as FS::Record::qsearch
3853 my( $self, $fuzzy, $hash, @opt) = @_;
3858 check_and_rebuild_fuzzyfiles();
3859 foreach my $field ( keys %$fuzzy ) {
3861 $match{$_}=1 foreach ( amatch( $fuzzy->{$field},
3863 @{ $self->all_X($field) }
3868 foreach ( keys %match ) {
3869 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3870 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
3873 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
3876 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
3878 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
3890 =item smart_search OPTION => VALUE ...
3892 Accepts the following options: I<search>, the string to search for. The string
3893 will be searched for as a customer number, phone number, name or company name,
3894 first searching for an exact match then fuzzy and substring matches (in some
3895 cases - see the source code for the exact heuristics used).
3897 Any additional options treated as an additional qualifier on the search
3900 Returns a (possibly empty) array of FS::cust_main objects.
3907 #here is the agent virtualization
3908 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
3912 my $search = delete $options{'search'};
3913 ( my $alphanum_search = $search ) =~ s/\W//g;
3915 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
3917 #false laziness w/Record::ut_phone
3918 my $phonen = "$1-$2-$3";
3919 $phonen .= " x$4" if $4;
3921 push @cust_main, qsearch( {
3922 'table' => 'cust_main',
3923 'hashref' => { %options },
3924 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
3926 join(' OR ', map "$_ = '$phonen'",
3927 qw( daytime night fax
3928 ship_daytime ship_night ship_fax )
3931 " AND $agentnums_sql", #agent virtualization
3934 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
3935 #try looking for matches with extensions unless one was specified
3937 push @cust_main, qsearch( {
3938 'table' => 'cust_main',
3939 'hashref' => { %options },
3940 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
3942 join(' OR ', map "$_ LIKE '$phonen\%'",
3944 ship_daytime ship_night )
3947 " AND $agentnums_sql", #agent virtualization
3952 } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3954 push @cust_main, qsearch( {
3955 'table' => 'cust_main',
3956 'hashref' => { 'custnum' => $1, %options },
3957 'extra_sql' => " AND $agentnums_sql", #agent virtualization
3960 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
3962 my($company, $last, $first) = ( $1, $2, $3 );
3964 # "Company (Last, First)"
3965 #this is probably something a browser remembered,
3966 #so just do an exact search
3968 foreach my $prefix ( '', 'ship_' ) {
3969 push @cust_main, qsearch( {
3970 'table' => 'cust_main',
3971 'hashref' => { $prefix.'first' => $first,
3972 $prefix.'last' => $last,
3973 $prefix.'company' => $company,
3976 'extra_sql' => " AND $agentnums_sql",
3980 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
3981 # try (ship_){last,company}
3985 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
3986 # # full strings the browser remembers won't work
3987 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
3989 use Lingua::EN::NameParse;
3990 my $NameParse = new Lingua::EN::NameParse(
3992 allow_reversed => 1,
3995 my($last, $first) = ( '', '' );
3996 #maybe disable this too and just rely on NameParse?
3997 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
3999 ($last, $first) = ( $1, $2 );
4001 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
4002 } elsif ( ! $NameParse->parse($value) ) {
4004 my %name = $NameParse->components;
4005 $first = $name{'given_name_1'};
4006 $last = $name{'surname_1'};
4010 if ( $first && $last ) {
4012 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4015 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4017 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4018 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4021 push @cust_main, qsearch( {
4022 'table' => 'cust_main',
4023 'hashref' => \%options,
4024 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4027 # or it just be something that was typed in... (try that in a sec)
4031 my $q_value = dbh->quote($value);
4034 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4035 $sql .= " ( LOWER(last) = $q_value
4036 OR LOWER(company) = $q_value
4037 OR LOWER(ship_last) = $q_value
4038 OR LOWER(ship_company) = $q_value
4041 push @cust_main, qsearch( {
4042 'table' => 'cust_main',
4043 'hashref' => \%options,
4044 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4047 unless ( @cust_main ) { #no exact match, trying substring/fuzzy
4049 #still some false laziness w/ search/cust_main.cgi
4054 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
4055 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4058 if ( $first && $last ) {
4061 { 'first' => { op=>'ILIKE', value=>"%$first%" },
4062 'last' => { op=>'ILIKE', value=>"%$last%" },
4064 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
4065 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
4072 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
4073 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
4077 foreach my $hashref ( @hashrefs ) {
4079 push @cust_main, qsearch( {
4080 'table' => 'cust_main',
4081 'hashref' => { %$hashref,
4084 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4093 " AND $agentnums_sql", #extra_sql #agent virtualization
4096 if ( $first && $last ) {
4097 push @cust_main, FS::cust_main->fuzzy_search(
4098 { 'last' => $last, #fuzzy hashref
4099 'first' => $first }, #
4103 foreach my $field ( 'last', 'company' ) {
4105 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4110 #eliminate duplicates
4112 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4120 =item check_and_rebuild_fuzzyfiles
4124 use vars qw(@fuzzyfields);
4125 @fuzzyfields = ( 'last', 'first', 'company' );
4127 sub check_and_rebuild_fuzzyfiles {
4128 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4129 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4132 =item rebuild_fuzzyfiles
4136 sub rebuild_fuzzyfiles {
4138 use Fcntl qw(:flock);
4140 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4141 mkdir $dir, 0700 unless -d $dir;
4143 foreach my $fuzzy ( @fuzzyfields ) {
4145 open(LOCK,">>$dir/cust_main.$fuzzy")
4146 or die "can't open $dir/cust_main.$fuzzy: $!";
4148 or die "can't lock $dir/cust_main.$fuzzy: $!";
4150 my @all = map $_->getfield($fuzzy), qsearch('cust_main', {});
4152 grep $_, map $_->getfield("ship_$fuzzy"), qsearch('cust_main',{});
4154 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4155 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4156 print CACHE join("\n", @all), "\n";
4157 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4159 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4170 my( $self, $field ) = @_;
4171 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4172 open(CACHE,"<$dir/cust_main.$field")
4173 or die "can't open $dir/cust_main.$field: $!";
4174 my @array = map { chomp; $_; } <CACHE>;
4179 =item append_fuzzyfiles LASTNAME COMPANY
4183 sub append_fuzzyfiles {
4184 my( $last, $company ) = @_;
4186 &check_and_rebuild_fuzzyfiles;
4188 use Fcntl qw(:flock);
4190 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4194 open(LAST,">>$dir/cust_main.last")
4195 or die "can't open $dir/cust_main.last: $!";
4197 or die "can't lock $dir/cust_main.last: $!";
4199 print LAST "$last\n";
4202 or die "can't unlock $dir/cust_main.last: $!";
4208 open(COMPANY,">>$dir/cust_main.company")
4209 or die "can't open $dir/cust_main.company: $!";
4210 flock(COMPANY,LOCK_EX)
4211 or die "can't lock $dir/cust_main.company: $!";
4213 print COMPANY "$company\n";
4215 flock(COMPANY,LOCK_UN)
4216 or die "can't unlock $dir/cust_main.company: $!";
4230 #warn join('-',keys %$param);
4231 my $fh = $param->{filehandle};
4232 my $agentnum = $param->{agentnum};
4234 my $refnum = $param->{refnum};
4235 my $pkgpart = $param->{pkgpart};
4237 #my @fields = @{$param->{fields}};
4238 my $format = $param->{'format'};
4241 if ( $format eq 'simple' ) {
4242 @fields = qw( cust_pkg.setup dayphone first last
4243 address1 address2 city state zip comments );
4245 } elsif ( $format eq 'extended' ) {
4246 @fields = qw( agent_custid refnum
4247 last first address1 address2 city state zip country
4249 ship_last ship_first ship_address1 ship_address2
4250 ship_city ship_state ship_zip ship_country
4251 payinfo paycvv paydate
4254 svc_acct.username svc_acct._password
4258 die "unknown format $format";
4261 eval "use Text::CSV_XS;";
4264 my $csv = new Text::CSV_XS;
4271 local $SIG{HUP} = 'IGNORE';
4272 local $SIG{INT} = 'IGNORE';
4273 local $SIG{QUIT} = 'IGNORE';
4274 local $SIG{TERM} = 'IGNORE';
4275 local $SIG{TSTP} = 'IGNORE';
4276 local $SIG{PIPE} = 'IGNORE';
4278 my $oldAutoCommit = $FS::UID::AutoCommit;
4279 local $FS::UID::AutoCommit = 0;
4282 #while ( $columns = $csv->getline($fh) ) {
4284 while ( defined($line=<$fh>) ) {
4286 $csv->parse($line) or do {
4287 $dbh->rollback if $oldAutoCommit;
4288 return "can't parse: ". $csv->error_input();
4291 my @columns = $csv->fields();
4292 #warn join('-',@columns);
4295 agentnum => $agentnum,
4297 country => $conf->config('countrydefault') || 'US',
4298 payby => $payby, #default
4299 paydate => '12/2037', #default
4301 my $billtime = time;
4302 my %cust_pkg = ( pkgpart => $pkgpart );
4304 foreach my $field ( @fields ) {
4306 if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) {
4308 #$cust_pkg{$1} = str2time( shift @$columns );
4309 if ( $1 eq 'pkgpart' ) {
4310 $cust_pkg{$1} = shift @columns;
4311 } elsif ( $1 eq 'setup' ) {
4312 $billtime = str2time(shift @columns);
4314 $cust_pkg{$1} = str2time( shift @columns );
4317 } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
4319 $svc_acct{$1} = shift @columns;
4323 #refnum interception
4324 if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
4326 my $referral = $columns[0];
4327 my $part_referral = new FS::part_referral {
4328 'referral' => $referral,
4329 'agentnum' => $agentnum,
4332 my $error = $part_referral->insert;
4334 $dbh->rollback if $oldAutoCommit;
4335 return "can't auto-insert advertising source: $referral: $error";
4337 $columns[0] = $part_referral->refnum;
4340 #$cust_main{$field} = shift @$columns;
4341 $cust_main{$field} = shift @columns;
4345 my $invoicing_list = $cust_main{'invoicing_list'}
4346 ? [ delete $cust_main{'invoicing_list'} ]
4349 my $cust_main = new FS::cust_main ( \%cust_main );
4352 tie my %hash, 'Tie::RefHash'; #this part is important
4354 if ( $cust_pkg{'pkgpart'} ) {
4355 my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
4358 if ( $svc_acct{'username'} ) {
4359 $svc_acct{svcpart} = $cust_pkg->part_pkg->svcpart( 'svc_acct' );
4360 push @svc_acct, new FS::svc_acct ( \%svc_acct )
4363 $hash{$cust_pkg} = \@svc_acct;
4366 my $error = $cust_main->insert( \%hash, $invoicing_list );
4369 $dbh->rollback if $oldAutoCommit;
4370 return "can't insert customer for $line: $error";
4373 if ( $format eq 'simple' ) {
4375 #false laziness w/bill.cgi
4376 $error = $cust_main->bill( 'time' => $billtime );
4378 $dbh->rollback if $oldAutoCommit;
4379 return "can't bill customer for $line: $error";
4382 $cust_main->apply_payments;
4383 $cust_main->apply_credits;
4385 $error = $cust_main->collect();
4387 $dbh->rollback if $oldAutoCommit;
4388 return "can't collect customer for $line: $error";
4396 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4398 return "Empty file!" unless $imported;
4410 #warn join('-',keys %$param);
4411 my $fh = $param->{filehandle};
4412 my @fields = @{$param->{fields}};
4414 eval "use Text::CSV_XS;";
4417 my $csv = new Text::CSV_XS;
4424 local $SIG{HUP} = 'IGNORE';
4425 local $SIG{INT} = 'IGNORE';
4426 local $SIG{QUIT} = 'IGNORE';
4427 local $SIG{TERM} = 'IGNORE';
4428 local $SIG{TSTP} = 'IGNORE';
4429 local $SIG{PIPE} = 'IGNORE';
4431 my $oldAutoCommit = $FS::UID::AutoCommit;
4432 local $FS::UID::AutoCommit = 0;
4435 #while ( $columns = $csv->getline($fh) ) {
4437 while ( defined($line=<$fh>) ) {
4439 $csv->parse($line) or do {
4440 $dbh->rollback if $oldAutoCommit;
4441 return "can't parse: ". $csv->error_input();
4444 my @columns = $csv->fields();
4445 #warn join('-',@columns);
4448 foreach my $field ( @fields ) {
4449 $row{$field} = shift @columns;
4452 my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4453 unless ( $cust_main ) {
4454 $dbh->rollback if $oldAutoCommit;
4455 return "unknown custnum $row{'custnum'}";
4458 if ( $row{'amount'} > 0 ) {
4459 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4461 $dbh->rollback if $oldAutoCommit;
4465 } elsif ( $row{'amount'} < 0 ) {
4466 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4469 $dbh->rollback if $oldAutoCommit;
4479 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4481 return "Empty file!" unless $imported;
4493 The delete method should possibly take an FS::cust_main object reference
4494 instead of a scalar customer number.
4496 Bill and collect options should probably be passed as references instead of a
4499 There should probably be a configuration file with a list of allowed credit
4502 No multiple currency support (probably a larger project than just this module).
4504 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4508 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4509 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4510 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.