X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=a4a7935b39c9ec624e89810990990b3c12e69350;hp=9ed3f2cabc66b671128f37eeafc7de21cf018ff6;hb=b3e85cf7a5a514f185c7d9c5ba50550c759c9ab5;hpb=6d295788b1c6bfb1c96c8917043a1b209c8491e1 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 9ed3f2cab..a4a7935b3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,20 +1,30 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $Debug $import ); +use vars qw( @ISA $conf $DEBUG $import ); +use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; -use Time::Local; +BEGIN { + eval "use Time::Local;"; + die "Time::Local minimum version 1.05 required with Perl versions before 5.6" + if $] < 5.006 && !defined($Time::Local::VERSION); + eval "use Time::Local qw(timelocal timelocal_nocheck);"; +} use Date::Format; #use Date::Manip; +use String::Approx qw(amatch); use Business::CreditCard; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); +use FS::Misc qw( send_email ); use FS::cust_pkg; use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; +use FS::cust_pay_void; use FS::cust_credit; +use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::agent; @@ -32,13 +42,16 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); -$Debug = 0; -#$Debug = 1; +$realtime_bop_decline_quiet = 0; + +$DEBUG = 0; +#$DEBUG = 1; $import = 0; #ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_main'} = sub { +#$FS::UID::callback{'FS::cust_main'} = sub { +install_callback FS::UID sub { $conf = new FS::Conf; #yes, need it for stuff below (prolly should be cached) }; @@ -158,10 +171,12 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) +=item payby - I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +=item paycvv - 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 + =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy =item payname - name on card or billing name @@ -172,6 +187,8 @@ FS::Record. The following fields are currently supported: =item comments - comments (optional) +=item referral_custnum - referring customer number + =back =head1 METHODS @@ -189,7 +206,7 @@ points to. You can ask the object for a copy with the I method. sub table { 'cust_main'; } -=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ] +=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] Adds this customer to the database. If there is an error, returns the error, otherwise returns false. @@ -217,12 +234,27 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); +Currently available options are: I and I. + +If I is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). + +The I option is deprecated. If I is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B method.) + =cut sub insert { my $self = shift; my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; + my %options = @_; + warn "FS::cust_main::insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -274,26 +306,10 @@ sub insert { } # packages - foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - $error = $cust_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $seconds ); - $seconds = 0; - } - $error = $svc_something->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } - } + $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } if ( $seconds ) { @@ -313,23 +329,133 @@ sub insert { } } - #false laziness with sub replace - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return "updating fuzzy search cache: $error"; } - if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] + +Like the insert method on an existing record, this method orders a package +and included services atomicaly. Pass a Tie::RefHash data structure to this +method containing FS::cust_pkg and FS::svc_I objects. There should +be a better explanation of this, but until then, here's an example: + + use Tie::RefHash; + tie %hash, 'Tie::RefHash'; #this part is important + %hash = ( + $cust_pkg => [ $svc_acct ], + ... + ); + $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + +Currently available options are: I and I. + +If I is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). + +The I option is deprecated. If I is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B method for each cust_pkg object. Using the B method +on the cust_main object is not recommended, as existing services will also be +reexported.) + +=cut + +sub order_pkgs { + my $self = shift; + my $cust_pkgs = shift; + my $seconds = shift; + my %options = @_; + my %svc_options = (); + $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} + if exists $options{'depend_jobnum'}; + warn "FS::cust_main::order_pkgs called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; + + foreach my $cust_pkg ( keys %$cust_pkgs ) { + $cust_pkg->custnum( $self->custnum ); + my $error = $cust_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return "inserting cust_pkg (transaction rolled back): $error"; + } + foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { + $svc_something->seconds( $svc_something->seconds + $$seconds ); + $$seconds = 0; + } + $error = $svc_something->insert(%svc_options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + #return "inserting svc_ (transaction rolled back): $error"; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error +} + +=item reexport + +This method is deprecated. See the I option to the insert and +order_pkgs methods for a better way to defer provisioning. + +Re-schedules all exports by calling the B method of all associated +packages (see L). If there is an error, returns the error; +otherwise returns false. + +=cut + +sub reexport { + my $self = shift; + + carp "warning: FS::cust_main::reexport is deprectated; ". + "use the depend_jobnum option to insert or order_pkgs to delay export"; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_pkg ( $self->ncancelled_pkgs ) { + my $error = $cust_pkg->reexport; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } } - #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -343,7 +469,7 @@ returns false. This will completely remove all traces of the customer record. This is not what you want when a customer cancels service; for that, cancel all of the -customer's packages (see L). +customer's packages (see L). If the customer has any uncancelled packages, you need to pass a new (valid) customer number for those packages to be transferred to. Cancelled packages @@ -370,19 +496,19 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_bill ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with invoices"; } - if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_credit ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with credits"; } - if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_pay ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with payments"; } - if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_refund ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with refunds"; } @@ -461,6 +587,12 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + if ( $self->payby eq 'COMP' && $self->payby ne $old->payby + && $conf->config('users-allow_comp') ) { + return "You are not permitted to create complimentary accounts." + unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); + } + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -482,35 +614,49 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->payby eq 'CARD' && + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { - # card info has changed, want to retry realtime_card invoice events - #false laziness w/collect - foreach my $cust_bill_event ( - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' - && $_->status eq 'done' - && $_->statustext - } - map { $_->cust_bill_event } - grep { $_->cust_bill_event } - $self->open_cust_bill - - ) { - my $error = $cust_bill_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice events for retry: $error"; - } + # card/check/lec info has changed, want to retry realtime_ invoice events + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - #eslaf + } + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; } - #false laziness with sub insert + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item queue_fuzzyfiles_update + +Used by insert & replace to update the fuzzy search cache + +=cut + +sub queue_fuzzyfiles_update { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + my $error = $queue->insert($self->getfield('last'), $self->company); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -518,13 +664,12 @@ sub replace { if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $error = $queue->insert($self->getfield('ship_last'), $self->ship_company); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } } - #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -561,7 +706,7 @@ sub check { || $self->ut_numbern('referral_custnum') ; #barf. need message catalogs. i18n. etc. - $error .= "Please select a advertising source." + $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; @@ -588,13 +733,13 @@ sub check { # bad idea to disable, causes billing to fail because of no tax rates later # unless ( $import ) { - unless ( qsearchs('cust_main_county', { + unless ( qsearch('cust_main_county', { 'country' => $self->country, 'state' => '', } ) ) { return "Unknown state/county/country: ". $self->state. "/". $self->county. "/". $self->country - unless qsearchs('cust_main_county',{ + unless qsearch('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, @@ -664,11 +809,11 @@ sub check { } } - $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; $self->payby($1); - if ( $self->payby eq 'CARD' ) { + if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -680,16 +825,56 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; + if ( defined $self->dbdef_table->column('paycvv') ) { + if ( length($self->paycvv) ) { + if ( cardtype($self->payinfo) eq 'American Express card' ) { + $self->paycvv =~ /^(\d{4})$/ + or return "CVV2 (CID) for American Express cards is four digits."; + $self->paycvv($1); + } else { + $self->paycvv =~ /^(\d{3})$/ + or return "CVV2 (CVC2/CID) is three digits."; + $self->paycvv($1); + } + } else { + $self->paycvv(''); + } + } + + } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) { + + my $payinfo = $self->payinfo; + $payinfo =~ s/[^\d\@]//g; + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; + $self->payinfo($payinfo); + $self->paycvv('') if $self->dbdef_table->column('paycvv'); + + } elsif ( $self->payby eq 'LECB' ) { + + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; + $payinfo = $1; + $self->payinfo($payinfo); + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); return "Illegal P.O. number: ". $self->payinfo if $error; + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'COMP' ) { + if ( !$self->custnum && $conf->config('users-allow_comp') ) { + return "You are not permitted to create complimentary accounts." + unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); + } + $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'PREPAY' ) { @@ -700,24 +885,33 @@ sub check { return "Illegal prepayment identifier: ". $self->payinfo if $error; return "Unknown prepayment identifier" unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" - unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY'; + unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; $self->paydate(''); } else { - $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ - or return "Illegal expiration date: ". $self->paydate; - my $y = length($2) == 4 ? $2 : "20$2"; - $self->paydate("$y-$1-01"); + my( $m, $y ); + if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { + ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); + } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { + ( $m, $y ) = ( $3, "20$2" ); + } else { + return "Illegal expiration date: ". $self->paydate; + } + $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; - return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm ); + return gettext('expired_card') + if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } - if ( $self->payname eq '' && - ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) { + if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && + ( ! $conf->exists('require_cardname') + || $self->payby !~ /^(CARD|DCRD)$/ ) + ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\']+)$/ @@ -728,11 +922,11 @@ sub check { $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; $self->tax($1); - $self->otaker(getotaker); + $self->otaker(getotaker) unless $self->otaker; #warn "AFTER: \n". $self->_dump; - ''; #no error + $self->SUPER::check; } =item all_pkgs @@ -836,16 +1030,53 @@ sub suspend { grep { $_->suspend } $self->unsuspended_pkgs; } -=item cancel +=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] + +Suspends all unsuspended packages (see L) matching the listed +PKGPARTs (see L). Always returns a list: an empty list on +success or a list of errors. + +=cut + +sub suspend_if_pkgpart { + my $self = shift; + my @pkgparts = @_; + grep { $_->suspend } + grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} + +=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] + +Suspends all unsuspended packages (see L) unless they match the +listed PKGPARTs (see L). Always returns a list: an empty list +on success or a list of errors. + +=cut + +sub suspend_unless_pkgpart { + my $self = shift; + my @pkgparts = @_; + grep { $_->suspend } + grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} + +=item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L) for this customer. + +Available options are: I + +I can be set true to supress email cancellation notices. + Always returns a list: an empty list on success or a list of errors. =cut sub cancel { my $self = shift; - grep { $_->cancel } $self->ncancelled_pkgs; + grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; } =item agent @@ -866,15 +1097,19 @@ conjunction with the collect method. Options are passed as name-value pairs. -The only currently available option is `time', which bills the customer as if -it were that time. It is specified as a UNIX timestamp; see -L). Also see L and L for conversion -functions. For example: +Currently available options are: + +resetup - if set true, re-charges setup fees. + +time - bills the customer as if it were that time. Specified as a UNIX +timestamp; see L). Also see L and +L for conversion functions. For example: use Date::Parse; ... $cust_main->bill( 'time' => str2time('April 20th, 2001') ); + If there is an error, returns the error, otherwise returns false. =cut @@ -897,16 +1132,20 @@ sub bill { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + $self->select_for_update; #mutex + # find the packages which are due for billing, find out how much they are # & generate invoice database. my( $total_setup, $total_recur ) = ( 0, 0 ); #my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); my @cust_bill_pkg = (); - my $tax = 0;## + #my $tax = 0;## #my $taxable_charged = 0;## #my $charged = 0;## + my %tax; + foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) ) { @@ -925,9 +1164,11 @@ sub bill { my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; + my @details = (); + # bill setup my $setup = 0; - unless ( $cust_pkg->setup ) { + if ( !$cust_pkg->setup || $options{'resetup'} ) { my $setup_prog = $part_pkg->getfield('setup'); $setup_prog =~ /^(.*)$/ or do { $dbh->rollback if $oldAutoCommit; @@ -935,6 +1176,7 @@ sub bill { ": $setup_prog"; }; $setup_prog = $1; + $setup_prog = '0' if $setup_prog =~ /^\s*$/; #my $cpt = new Safe; ##$cpt->permit(); #what is necessary? @@ -946,16 +1188,16 @@ sub bill { return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. "(expression $setup_prog): $@"; } - $cust_pkg->setfield('setup',$time); + $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; $cust_pkg_mod_flag=1; } #bill recurring fee my $recur = 0; my $sdate; - if ( $part_pkg->getfield('freq') > 0 && + if ( $part_pkg->getfield('freq') ne '0' && ! $cust_pkg->getfield('susp') && - ( $cust_pkg->getfield('bill') || 0 ) < $time + ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { my $recur_prog = $part_pkg->getfield('recur'); $recur_prog =~ /^(.*)$/ or do { @@ -964,6 +1206,7 @@ sub bill { ": $recur_prog"; }; $recur_prog = $1; + $recur_prog = '0' if $recur_prog =~ /^\s*$/; # shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -987,11 +1230,24 @@ sub bill { # only for figuring next bill date, nothing else, so, reset $sdate again # here $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - - $mon += $part_pkg->freq; - until ( $mon < 12 ) { $mon -= 12; $year++; } + $cust_pkg->last_bill($sdate) + if $cust_pkg->dbdef_table->column('last_bill'); + + if ( $part_pkg->freq =~ /^\d+$/ ) { + $mon += $part_pkg->freq; + until ( $mon < 12 ) { $mon -= 12; $year++; } + } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) { + my $weeks = $1; + $mday += $weeks * 7; + } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { + my $days = $1; + $mday += $days; + } else { + $dbh->rollback if $oldAutoCommit; + return "unparsable frequency: ". $part_pkg->freq; + } $cust_pkg->setfield('bill', - timelocal($sec,$min,$hour,$mday,$mon,$year)); + timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); $cust_pkg_mod_flag = 1; } @@ -999,7 +1255,6 @@ sub bill { warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); - my $taxable_charged = 0; if ( $cust_pkg_mod_flag ) { $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case @@ -1008,105 +1263,133 @@ sub bill { } $setup = sprintf( "%.2f", $setup ); $recur = sprintf( "%.2f", $recur ); - if ( $setup < 0 ) { + if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { $dbh->rollback if $oldAutoCommit; return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; } - if ( $recur < 0 ) { + if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { $dbh->rollback if $oldAutoCommit; return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } - if ( $setup > 0 || $recur > 0 ) { + if ( $setup != 0 || $recur != 0 ) { my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'recur' => $recur, - 'sdate' => $sdate, - 'edate' => $cust_pkg->bill, + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'recur' => $recur, + 'sdate' => $sdate, + 'edate' => $cust_pkg->bill, + 'details' => \@details, }); push @cust_bill_pkg, $cust_bill_pkg; $total_setup += $setup; $total_recur += $recur; - $taxable_charged += $setup - unless $part_pkg->setuptax =~ /^Y$/i; - $taxable_charged += $recur - unless $part_pkg->recurtax =~ /^Y$/i; - - unless ( $self->tax =~ /Y/i - || $self->payby eq 'COMP' - || $taxable_charged == 0 ) { - - my $cust_main_county = - qsearchs('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => $part_pkg->taxclass, - } ) - or qsearchs('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => '', - } ) - or do { - $dbh->rollback if $oldAutoCommit; - return - "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->$_(), qw(state county country) ), - $part_pkg->taxclass ). "\n"; - }; - - if ( $cust_main_county->exempt_amount ) { - my ($mon,$year) = (localtime($sdate) )[4,5]; - $mon++; - my $freq = $part_pkg->freq || 1; - my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); - foreach my $which_month ( 1 .. $freq ) { - my %hash = ( - 'custnum' => $self->custnum, - 'taxnum' => $cust_main_county->taxnum, - 'year' => 1900+$year, - 'month' => $mon++, - ); - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } - my $cust_tax_exempt = - qsearchs('cust_tax_exempt', \%hash) - || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } ); - my $remaining_exemption = sprintf("%.2f", - $cust_main_county->exempt_amount - $cust_tax_exempt->amount ); - if ( $remaining_exemption > 0 ) { - my $addl = $remaining_exemption > $taxable_per_month - ? $taxable_per_month - : $remaining_exemption; - $taxable_charged -= $addl; - my $new_cust_tax_exempt = new FS::cust_tax_exempt ( { - $cust_tax_exempt->hash, - 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl), - } ); - $error = $new_cust_tax_exempt->exemptnum - ? $new_cust_tax_exempt->replace($cust_tax_exempt) - : $new_cust_tax_exempt->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't update cust_tax_exempt: $error"; - } - - } # if $remaining_exemption > 0 - - } #foreach $which_month - - } #if $cust_main_county->exempt_amount - - $taxable_charged = sprintf( "%.2f", $taxable_charged); - $tax += $taxable_charged * $cust_main_county->tax / 100 - - } #unless $self->tax =~ /Y/i - # || $self->payby eq 'COMP' - # || $taxable_charged == 0 - - } #if $setup > 0 || $recur > 0 + + unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { + + my @taxes = qsearch( 'cust_main_county', { + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + 'taxclass' => $part_pkg->taxclass, + } ); + unless ( @taxes ) { + @taxes = qsearch( 'cust_main_county', { + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + 'taxclass' => '', + } ); + } + + #one more try at a whole-country tax rate + unless ( @taxes ) { + @taxes = qsearch( 'cust_main_county', { + 'state' => '', + 'county' => '', + 'country' => $self->country, + 'taxclass' => '', + } ); + } + + # maybe eliminate this entirely, along with all the 0% records + unless ( @taxes ) { + $dbh->rollback if $oldAutoCommit; + return + "fatal: can't find tax rate for state/county/country/taxclass ". + join('/', ( map $self->$_(), qw(state county country) ), + $part_pkg->taxclass ). "\n"; + } + + foreach my $tax ( @taxes ) { + + my $taxable_charged = 0; + $taxable_charged += $setup + unless $part_pkg->setuptax =~ /^Y$/i + || $tax->setuptax =~ /^Y$/i; + $taxable_charged += $recur + unless $part_pkg->recurtax =~ /^Y$/i + || $tax->recurtax =~ /^Y$/i; + next unless $taxable_charged; + + if ( $tax->exempt_amount > 0 ) { + my ($mon,$year) = (localtime($sdate) )[4,5]; + $mon++; + my $freq = $part_pkg->freq || 1; + if ( $freq !~ /(\d+)$/ ) { + $dbh->rollback if $oldAutoCommit; + return "daily/weekly package definitions not (yet?)". + " compatible with monthly tax exemptions"; + } + my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); + foreach my $which_month ( 1 .. $freq ) { + my %hash = ( + 'custnum' => $self->custnum, + 'taxnum' => $tax->taxnum, + 'year' => 1900+$year, + 'month' => $mon++, + ); + #until ( $mon < 12 ) { $mon -= 12; $year++; } + until ( $mon < 13 ) { $mon -= 12; $year++; } + my $cust_tax_exempt = + qsearchs('cust_tax_exempt', \%hash) + || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } ); + my $remaining_exemption = sprintf("%.2f", + $tax->exempt_amount - $cust_tax_exempt->amount ); + if ( $remaining_exemption > 0 ) { + my $addl = $remaining_exemption > $taxable_per_month + ? $taxable_per_month + : $remaining_exemption; + $taxable_charged -= $addl; + my $new_cust_tax_exempt = new FS::cust_tax_exempt ( { + $cust_tax_exempt->hash, + 'amount' => + sprintf("%.2f", $cust_tax_exempt->amount + $addl), + } ); + $error = $new_cust_tax_exempt->exemptnum + ? $new_cust_tax_exempt->replace($cust_tax_exempt) + : $new_cust_tax_exempt->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't update cust_tax_exempt: $error"; + } + + } # if $remaining_exemption > 0 + + } #foreach $which_month + + } #if $tax->exempt_amount + + $taxable_charged = sprintf( "%.2f", $taxable_charged); + + #$tax += $taxable_charged * $cust_main_county->tax / 100 + $tax{ $tax->taxname || 'Tax' } += + $taxable_charged * $tax->tax / 100 + + } #foreach my $tax ( @taxes ) + + } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP' + + } #if $setup != 0 || $recur != 0 } #if $cust_pkg_mod_flag @@ -1133,20 +1416,42 @@ sub bill { # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) # ); - $tax = sprintf("%.2f", $tax); - if ( $tax > 0 ) { - $charged = sprintf( "%.2f", $charged+$tax ); + if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema + + foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { + my $tax = sprintf("%.2f", $tax{$taxname} ); + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + }); + push @cust_bill_pkg, $cust_bill_pkg; + } + + } else { #1.4 schema + + my $tax = 0; + foreach ( values %tax ) { $tax += $_ }; + $tax = sprintf("%.2f", $tax); + if ( $tax > 0 ) { + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + }); + push @cust_bill_pkg, $cust_bill_pkg; + } - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; } -# } my $cust_bill = new FS::cust_bill ( { 'custnum' => $self->custnum, @@ -1181,8 +1486,9 @@ sub bill { (Attempt to) collect money for this customer's outstanding invoices (see L). Usually used after the bill method. -Depending on the value of `payby', this may print an invoice (`BILL'), charge -a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP'). +Depending on the value of `payby', this may print or email an invoice (I, +I, or I), charge a credit card (I), charge via electronic +check/ACH (I), or just add any necessary (pseudo-)payment (I). Most actions are now triggered by invoice events; see L and the invoice events web interface. @@ -1197,7 +1503,10 @@ invoice_time - Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L). Also see L and L for conversion functions. -retry_card - Retry cards even when not scheduled by invoice events. +retry - Retry card/echeck/LEC transactions even when not scheduled by invoice +events. + +retry_card - Deprecated alias for 'retry' batch_card - This option is deprecated. See the invoice events web interface to control whether cards are batched or run against a realtime gateway. @@ -1206,6 +1515,8 @@ report_badcard - This option is deprecated. force_print - This option is deprecated; see the invoice events web interface. +quiet - set true to surpress email card/ACH decline notices. + =cut sub collect { @@ -1224,60 +1535,43 @@ sub collect { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + $self->select_for_update; #mutex + my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $Debug; + warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; } - if ( exists($options{'retry_card'}) && $options{'retry_card'} ) { - #false laziness w/replace - foreach my $cust_bill_event ( - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' - && $_->status eq 'done' - && $_->statustext - } - map { $_->cust_bill_event } - grep { $_->cust_bill_event } - $self->open_cust_bill - ) { - my $error = $cust_bill_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice events for retry: $error"; - } + if ( exists($options{'retry_card'}) ) { + carp 'retry_card option passed to collect is deprecated; use retry'; + $options{'retry'} ||= $options{'retry_card'}; + } + if ( exists($options{'retry'}) && $options{'retry'} ) { + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - #eslaf } - foreach my $cust_bill ( $self->cust_bill ) { - - #this has to be before next's - my $amount = sprintf( "%.2f", $balance < $cust_bill->owed - ? $balance - : $cust_bill->owed - ); - $balance = sprintf( "%.2f", $balance - $amount ); - - next unless $cust_bill->owed > 0; + foreach my $cust_bill ( $self->open_cust_bill ) { # don't try to charge for the same invoice if it's already in a batch #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug; - - next unless $amount > 0; + last if $self->balance <= 0; + warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" + if $DEBUG; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds || $a->weight <=> $b->weight || $a->eventpart <=> $b->eventpart } grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) - && ! qsearchs( 'cust_bill_event', { + && ! qsearch( 'cust_bill_event', { 'invnum' => $cust_bill->invnum, 'eventpart' => $_->eventpart, 'status' => 'done', @@ -1287,12 +1581,18 @@ sub collect { 'disabled' => '', } ) ) { - last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0 + last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 + || $self->balance <= 0; # or if balance<=0 warn "calling invoice event (". $part_bill_event->eventcode. ")\n" - if $Debug; + if $DEBUG; my $cust_main = $self; #for callback - my $error = eval $part_bill_event->eventcode; + + my $error; + { + local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; + $error = eval $part_bill_event->eventcode; + } my $status = ''; my $statustext = ''; @@ -1310,7 +1610,8 @@ sub collect { my $cust_bill_event = new FS::cust_bill_event { 'invnum' => $cust_bill->invnum, 'eventpart' => $part_bill_event->eventpart, - '_date' => $invoice_time, + #'_date' => $invoice_time, + '_date' => time, 'status' => $status, 'statustext' => $statustext, }; @@ -1339,61 +1640,652 @@ sub collect { } -=item total_owed +=item retry_realtime -Returns the total owed for this customer on all invoices -(see L). +Schedules realtime credit card / electronic check / LEC billing events for +for retry. Useful if card information has changed or manual retry is desired. +The 'collect' method must be called to actually retry the transaction. + +Implementation details: For each of this customer's open invoices, changes +the status of the first "done" (with statustext error) realtime processing +event to "failed". =cut -sub total_owed { +sub retry_realtime { my $self = shift; - $self->total_owed_date(2145859200); #12/31/2037 -} - -=item total_owed_date TIME -Returns the total owed for this customer on all invoices with date earlier than -TIME. TIME is specified as a UNIX timestamp; see L). Also -see L and L for conversion functions. + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; -=cut + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; -sub total_owed_date { - my $self = shift; - my $time = shift; - my $total_bill = 0; foreach my $cust_bill ( - grep { $_->_date <= $time } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + grep { $_->cust_bill_event } + $self->open_cust_bill ) { - $total_bill += $cust_bill->owed; + my @cust_bill_event = + sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds } + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode =~ + /\$cust_bill\->realtime_(card|ach|lec)/ + && $_->status eq 'done' + && $_->statustext + } + $cust_bill->cust_bill_event; + next unless @cust_bill_event; + my $error = $cust_bill_event[0]->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice event for retry: $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] + +Runs a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L for supported gateways. + +Available methods are: I, I and I + +Available options are: I, I, I + +The additional options I, I, I, I, I, +I, I and I are also available. Any of these options, +if set, will override the value from the customer record. + +I is a free-text field passed to the gateway. It defaults to +"Internet services". + +If an I is specified, this payment (if sucessful) is applied to the +specified invoice. If you don't specify an I you might want to +call the B method. + +I can be set true to surpress email decline notices. + +(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) + +=cut + +sub realtime_bop { + my( $self, $method, $amount, %options ) = @_; + if ( $DEBUG ) { + warn "$self $method $amount\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + $options{'description'} ||= 'Internet services'; + + #pre-requisites + die "Real-time processing not enabled\n" + unless $conf->exists('business-onlinepayment'); + eval "use Business::OnlinePayment"; + die $@ if $@; + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); + my ( $processor, $login, $password, $action, @bop_options ) = + $conf->config($bop_config); + $action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + #massage data + + my $address = exists($options{'address1'}) + ? $options{'address1'} + : $self->address1; + my $address2 = exists($options{'address2'}) + ? $options{'address2'} + : $self->address2; + $address .= ", ". $address2 if length($address2); + + my $o_payname = exists($options{'payname'}) + ? $options{'payname'} + : $self->payname; + my($payname, $payfirst, $paylast); + if ( $o_payname && $method ne 'ECHECK' ) { + ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $payname = "$payfirst $paylast"; + } + + my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + my $email = $invoicing_list[0]; + + my $payinfo = exists($options{'payinfo'}) + ? $options{'payinfo'} + : $self->payinfo; + + my %content = (); + if ( $method eq 'CC' ) { + + $content{card_number} = $payinfo; + my $paydate = exists($options{'paydate'}) + ? $options{'paydate'} + : $self->paydate; + $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + + if ( defined $self->dbdef_table->column('paycvv') ) { + my $paycvv = exists($options{'paycvv'}) + ? $options{'paycvv'} + : $self->paycvv; + $content{cvv2} = $self->paycvv + if length($paycvv); + } + + $content{recurring_billing} = 'YES' + if qsearch('cust_pay', { 'custnum' => $self->custnum, + 'payby' => 'CARD', + 'payinfo' => $payinfo, + } ); + + } elsif ( $method eq 'ECHECK' ) { + ( $content{account_number}, $content{routing_code} ) = + split('@', $payinfo); + $content{bank_name} = $o_payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = exists($options{'ss'}) + ? $options{'ss'} + : $self->ss; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $payinfo; + } + + #transaction(s) + + my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); + + my $transaction = new Business::OnlinePayment( $processor, @bop_options ); + $transaction->content( + 'type' => $method, + 'login' => $login, + 'password' => $password, + 'action' => $action1, + 'description' => $options{'description'}, + 'amount' => $amount, + 'invoice_number' => $options{'invnum'}, + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => ( exists($options{'city'}) + ? $options{'city'} + : $self->city ), + 'state' => ( exists($options{'state'}) + ? $options{'state'} + : $self->state ), + 'zip' => ( exists($options{'zip'}) + ? $options{'zip'} + : $self->zip ), + 'country' => ( exists($options{'country'}) + ? $options{'country'} + : $self->country ), + 'referer' => 'http://cleanwhisker.420.am/', + 'email' => $email, + 'phone' => $self->daytime || $self->night, + %content, #after + ); + $transaction->submit(); + + if ( $transaction->is_success() && $action2 ) { + my $auth = $transaction->authorization; + my $ordernum = $transaction->can('order_number') + ? $transaction->order_number + : ''; + + my $capture = + new Business::OnlinePayment( $processor, @bop_options ); + + my %capture = ( + %content, + type => $method, + action => $action2, + login => $login, + password => $password, + order_number => $ordernum, + amount => $amount, + authorization => $auth, + description => $options{'description'}, + ); + + foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code + transaction_sequence_num local_transaction_date + local_transaction_time AVS_result_code )) { + $capture{$field} = $transaction->$field() if $transaction->can($field); + } + + $capture->content( %capture ); + + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization sucessful but capture failed, custnum #". + $self->custnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + #remove paycvv after initial transaction + #false laziness w/misc/process/payment.cgi - check both to make sure working + # correctly + if ( defined $self->dbdef_table->column('paycvv') + && length($self->paycvv) + && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save') + ) { + my $error = $self->remove_cvv; + if ( $error ) { + warn "error removing cvv: $error\n"; + } + } + + #result handling + if ( $transaction->is_success() ) { + + my %method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', + ); + + my $paybatch = "$processor:". $transaction->authorization; + $paybatch .= ':'. $transaction->order_number + if $transaction->can('order_number') + && length($transaction->order_number); + + my $cust_pay = new FS::cust_pay ( { + 'custnum' => $self->custnum, + 'invnum' => $options{'invnum'}, + 'paid' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $payinfo, + 'paybatch' => $paybatch, + } ); + my $error = $cust_pay->insert; + if ( $error ) { + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + "error inserting payment ($processor): $error2". + " (previously tried insert with invnum #$options{'invnum'}" . + ": $error )"; + warn $e; + return $e; + } + } + return ''; #no error + + } else { + + my $perror = "$processor error: ". $transaction->error_message; + + if ( !$options{'quiet'} && !$realtime_bop_decline_quiet + && $conf->exists('emaildecline') + && grep { $_ ne 'POST' } $self->invoicing_list + && ! grep { $transaction->error_message =~ /$_/ } + $conf->config('emaildecline-exclude') + ) { + my @templ = $conf->config('declinetemplate'); + my $template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @templ ], + ) or return "($perror) can't create template: $Text::Template::ERROR"; + $template->compile() + or return "($perror) can't compile template: $Text::Template::ERROR"; + + my $templ_hash = { error => $transaction->error_message }; + + my $error = send_email( + 'from' => $conf->config('invoice_from'), + 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], + 'subject' => 'Your payment could not be processed', + 'body' => [ $template->fill_in(HASH => $templ_hash) ], + ); + + $perror .= " (also received error sending decline notification: $error)" + if $error; + + } + + return $perror; + } + +} + +=item remove_cvv + +Removes the I field from the database directly. + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub remove_cvv { + my $self = shift; + my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") + or return dbh->errstr; + $sth->execute($self->custnum) + or return $sth->errstr; + $self->paycvv(''); + ''; +} + +=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] + +Refunds a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L for supported gateways. + +Available methods are: I, I and I + +Available options are: I, I, I + +Most gateways require a reference to an original payment transaction to refund, +so you probably need to specify a I. + +I defaults to the original amount of the payment if not specified. + +I specifies a reason for the refund. + +Implementation note: If I is unspecified or equal to the amount of the +orignal payment, first an attempt is made to "void" the transaction via +the gateway (to cancel a not-yet settled transaction) and then if that fails, +the normal attempt is made to "refund" ("credit") the transaction via the +gateway is attempted. + +#The additional options I, I, I, I, I, +#I, I and I are also available. Any of these options, +#if set, will override the value from the customer record. + +#If an I is specified, this payment (if sucessful) is applied to the +#specified invoice. If you don't specify an I you might want to +#call the B method. + +=cut + +#some false laziness w/realtime_bop, not enough to make it worth merging +#but some useful small subs should be pulled out +sub realtime_refund_bop { + my( $self, $method, %options ) = @_; + if ( $DEBUG ) { + warn "$self $method refund\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + #pre-requisites + die "Real-time processing not enabled\n" + unless $conf->exists('business-onlinepayment'); + eval "use Business::OnlinePayment"; + die $@ if $@; + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); + my ( $processor, $login, $password, $unused_action, @bop_options ) = + $conf->config($bop_config); + #$action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + my $cust_pay = ''; + my $amount = $options{'amount'}; + my( $pay_processor, $auth, $order_number ); + if ( $options{'paynum'} ) { + warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG; + $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) + or return "Unknown paynum $options{'paynum'}"; + $amount ||= $cust_pay->paid; + $cust_pay->paybatch =~ /^(\w+):(\w+)(:(\w+))?$/ + or return "Can't parse paybatch for paynum $options{'paynum'}: ". + $cust_pay->paybatch; + ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 ); + return "processor of payment $options{'paynum'} $pay_processor does not". + " match current processor $processor" + unless $pay_processor eq $processor; + } + return "neither amount nor paynum specified" unless $amount; + + #first try void if applicable + if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? + my $void = new Business::OnlinePayment( $processor, @bop_options ); + $void->content( + 'type' => $method, + 'action' => 'void', + 'login' => $login, + 'password' => $password, + 'order_number' => $order_number, + 'amount' => $amount, + 'authorization' => $auth, + 'referer' => 'http://cleanwhisker.420.am/', + ); + $void->submit(); + if ( $void->is_success ) { + my $error = $cust_pay->void($options{'reason'}); + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH voided but database not updated - '. + "error voiding payment: $error"; + warn $e; + return $e; + } + return ''; + } + } + + #massage data + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + my($payname, $payfirst, $paylast); + if ( $self->payname && $method ne 'ECHECK' ) { + $payname = $self->payname; + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $payname = "$payfirst $paylast"; + } + + my %content = (); + if ( $method eq 'CC' ) { + + $content{card_number} = $self->payinfo; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + + #$content{cvv2} = $self->paycvv + # if defined $self->dbdef_table->column('paycvv') + # && length($self->paycvv); + + #$content{recurring_billing} = 'YES' + # if qsearch('cust_pay', { 'custnum' => $self->custnum, + # 'payby' => 'CARD', + # 'payinfo' => $self->payinfo, } ); + + } elsif ( $method eq 'ECHECK' ) { + ( $content{account_number}, $content{routing_code} ) = + split('@', $self->payinfo); + $content{bank_name} = $self->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $self->payinfo; + } + + #then try refund + my $refund = new Business::OnlinePayment( $processor, @bop_options ); + $refund->content( + 'type' => $method, + 'action' => 'credit', + 'login' => $login, + 'password' => $password, + 'order_number' => $order_number, + 'amount' => $amount, + 'authorization' => $auth, + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $self->city, + 'state' => $self->state, + 'zip' => $self->zip, + 'country' => $self->country, + 'referer' => 'http://cleanwhisker.420.am/', + %content, #after + ); + $refund->submit(); + + return "$processor error: ". $refund->error_message + unless $refund->is_success(); + + my %method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', + ); + + my $paybatch = "$processor:". $refund->authorization; + $paybatch .= ':'. $refund->order_number + if $refund->can('order_number') && $refund->order_number; + + while ( $cust_pay && $cust_pay->unappled < $amount ) { + my @cust_bill_pay = $cust_pay->cust_bill_pay; + last unless @cust_bill_pay; + my $cust_bill_pay = pop @cust_bill_pay; + my $error = $cust_bill_pay->delete; + last if $error; + } + + my $cust_refund = new FS::cust_refund ( { + 'custnum' => $self->custnum, + 'paynum' => $options{'paynum'}, + 'refund' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $self->payinfo, + 'paybatch' => $paybatch, + 'reason' => $options{'reason'} || 'card or ACH refund', + } ); + my $error = $cust_refund->insert; + if ( $error ) { + $cust_refund->paynum(''); #try again with no specific paynum + my $error2 = $cust_refund->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH refunded but database not updated - '. + "error inserting refund ($processor): $error2". + " (previously tried insert with paynum #$options{'paynum'}" . + ": $error )"; + warn $e; + return $e; + } + } + + ''; #no error + +} + +=item total_owed + +Returns the total owed for this customer on all invoices +(see L). + +=cut + +sub total_owed { + my $self = shift; + $self->total_owed_date(2145859200); #12/31/2037 +} + +=item total_owed_date TIME + +Returns the total owed for this customer on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. + +=cut + +sub total_owed_date { + my $self = shift; + my $time = shift; + my $total_bill = 0; + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { + $total_bill += $cust_bill->owed; } sprintf( "%.2f", $total_bill ); } -=item apply_credits +=item apply_credits OPTION => VALUE ... Applies (see L) unapplied credits (see L) -to outstanding invoice balances in chronological order and returns the value -of any remaining unapplied credits available for refund -(see L). +to outstanding invoice balances in chronological order (or reverse +chronological order if the I option is set to B) and returns the +value of any remaining unapplied credits available for refund (see +L). =cut sub apply_credits { my $self = shift; + my %opt = @_; return 0 unless $self->total_credited; my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); - my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } - qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); + my @invoices = $self->open_cust_bill; + @invoices = sort { $b->_date <=> $a->_date } @invoices + if defined($opt{'order'}) && $opt{'order'} eq 'newest'; my $credit; - foreach my $cust_bill ( @invoices ) { my $amount; @@ -1542,6 +2434,37 @@ sub balance_date { ); } +=item paydate_monthyear + +Returns a two-element list consisting of the month and year of this customer's +paydate (credit card expiration date for CARD customers) + +=cut + +sub paydate_monthyear { + my $self = shift; + if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format + ( $2, $1 ); + } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $1, $3 ); + } else { + ('', ''); + } +} + +=item payinfo_masked + +Returns a "masked" payinfo field with all but the last four characters replaced +by 'x'es. Useful for displaying credit cards. + +=cut + +sub payinfo_masked { + my $self = shift; + my $payinfo = $self->payinfo; + 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); +} + =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -1583,7 +2506,6 @@ sub invoicing_list { } my %seen = map { $_->address => 1 } @cust_main_invoice; foreach my $address ( @{$arrayref} ) { - #unless ( grep { $address eq $_->address } @cust_main_invoice ) { next if exists $seen{$address} && $seen{$address}; $seen{$address} = 1; my $cust_main_invoice = new FS::cust_main_invoice ( { @@ -1625,24 +2547,36 @@ sub check_invoicing_list { ''; } -=item default_invoicing_list +=item set_default_invoicing_list + +Sets the invoicing list to all accounts associated with this customer, +overwriting any previous invoicing list. + +=cut + +sub set_default_invoicing_list { + my $self = shift; + $self->invoicing_list($self->all_emails); +} + +=item all_emails -Sets the invoicing list to all accounts associated with this customer. +Returns the email addresses of all accounts provisioned for this customer. =cut -sub default_invoicing_list { +sub all_emails { my $self = shift; - my @list = (); + my %list; foreach my $cust_pkg ( $self->all_pkgs ) { my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); my @svc_acct = map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } @cust_svc; - push @list, map { $_->email } @svc_acct; + $list{$_}=1 foreach map { $_->email } @svc_acct; } - $self->invoicing_list(\@list); + keys %list; } =item invoicing_list_addpost @@ -1734,7 +2668,7 @@ sub credit { $cust_credit->insert; } -=item charge AMOUNT PKG COMMENT +=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] Creates a one-time charge for this customer. If there is an error, returns the error, otherwise returns false. @@ -1742,7 +2676,10 @@ the error, otherwise returns false. =cut sub charge { - my ( $self, $amount, $pkg, $comment ) = @_; + my ( $self, $amount ) = ( shift, shift ); + my $pkg = @_ ? shift : 'One-time charge'; + my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); + my $taxclass = @_ ? shift : ''; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -1756,12 +2693,13 @@ sub charge { my $dbh = dbh; my $part_pkg = new FS::part_pkg ( { - 'pkg' => $pkg || 'One-time charge', - 'comment' => $comment || '$'. sprintf("%.2f",$amount), + 'pkg' => $pkg, + 'comment' => $comment, 'setup' => $amount, 'freq' => 0, 'recur' => '0', 'disabled' => 'Y', + 'taxclass' => $taxclass, } ); my $error = $part_pkg->insert; @@ -1805,7 +2743,8 @@ Returns all the invoices (see L) for this customer. sub cust_bill { my $self = shift; - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + sort { $a->_date <=> $b->_date } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) } =item open_cust_bill @@ -1820,6 +2759,233 @@ sub open_cust_bill { grep { $_->owed > 0 } $self->cust_bill; } +=item cust_credit + +Returns all the credits (see L) for this customer. + +=cut + +sub cust_credit { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) +} + +=item cust_pay + +Returns all the payments (see L) for this customer. + +=cut + +sub cust_pay { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) +} + +=item cust_pay_void + +Returns all voided payments (see L) for this customer. + +=cut + +sub cust_pay_void { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) +} + + +=item cust_refund + +Returns all the refunds (see L) for this customer. + +=cut + +sub cust_refund { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) +} + +=item select_for_update + +Selects this record with the SQL "FOR UPDATE" command. This can be useful as +a mutex. + +=cut + +sub select_for_update { + my $self = shift; + qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' ); +} + +=item name + +Returns a name string for this customer, either "Company (Last, First)" or +"Last, First". + +=cut + +sub name { + my $self = shift; + my $name = $self->get('last'). ', '. $self->first; + $name = $self->company. " ($name)" if $self->company; + $name; +} + +=item status + +Returns a status string for this customer, currently: + +=over 4 + +=item prospect - No packages have ever been ordered + +=item active - One or more recurring packages is active + +=item suspended - All non-cancelled recurring packages are suspended + +=item cancelled - All recurring packages are cancelled + +=back + +=cut + +sub status { + my $self = shift; + for my $status (qw( prospect active suspended cancelled )) { + my $method = $status.'_sql'; + my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; + my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; + $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr; + return $status if $sth->fetchrow_arrayref->[0]; + } +} + +=item statuscolor + +Returns a hex triplet color string for this customer's status. + +=cut + +my %statuscolor = ( + 'prospect' => '000000', + 'active' => '00CC00', + 'suspended' => 'FF9900', + 'cancelled' => 'FF0000', +); +sub statuscolor { + my $self = shift; + $statuscolor{$self->status}; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item prospect_sql + +Returns an SQL expression identifying prospective cust_main records (customers +with no packages ever ordered) + +=cut + +sub prospect_sql { " + 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + ) +"; } + +=item active_sql + +Returns an SQL expression identifying active cust_main records. + +=cut + +sub active_sql { " + 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) + ) +"; } + +=item susp_sql +=item suspended_sql + +Returns an SQL expression identifying suspended cust_main records. + +=cut + +sub suspended_sql { susp_sql(@_); } +sub susp_sql { " + 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) + AND 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) + ) +"; } + +=item cancel_sql +=item cancelled_sql + +Returns an SQL expression identifying cancelled cust_main records. + +=cut + +sub cancelled_sql { cancel_sql(@_); } +sub cancel_sql { " + 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + ) + AND 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) +"; } + +=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] + +Performs a fuzzy (approximate) search and returns the matching FS::cust_main +records. Currently, only I or I may be specified (the +appropriate ship_ field is also searched if applicable). + +Additional options are the same as FS::Record::qsearch + +=cut + +sub fuzzy_search { + my( $self, $fuzzy, $hash, @opt) = @_; + #$self + $hash ||= {}; + my @cust_main = (); + + check_and_rebuild_fuzzyfiles(); + foreach my $field ( keys %$fuzzy ) { + my $sub = \&{"all_$field"}; + my %match = (); + $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) ); + + foreach ( keys %match ) { + push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt); + push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt) + if defined dbdef->table('cust_main')->column('ship_last'); + } + } + + my %saw = (); + @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; + + @cust_main; + +} + =back =head1 SUBROUTINES @@ -1959,6 +3125,201 @@ sub append_fuzzyfiles { 1; } +=item batch_import + +=cut + +sub batch_import { + my $param = shift; + #warn join('-',keys %$param); + my $fh = $param->{filehandle}; + my $agentnum = $param->{agentnum}; + my $refnum = $param->{refnum}; + my $pkgpart = $param->{pkgpart}; + my @fields = @{$param->{fields}}; + + eval "use Date::Parse;"; + die $@ if $@; + eval "use Text::CSV_XS;"; + die $@ if $@; + + my $csv = new Text::CSV_XS; + #warn $csv; + #warn $fh; + + my $imported = 0; + #my $columns; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #while ( $columns = $csv->getline($fh) ) { + my $line; + while ( defined($line=<$fh>) ) { + + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + + my @columns = $csv->fields(); + #warn join('-',@columns); + + my %cust_main = ( + agentnum => $agentnum, + refnum => $refnum, + country => $conf->config('countrydefault') || 'US', + payby => 'BILL', #default + paydate => '12/2037', #default + ); + my $billtime = time; + my %cust_pkg = ( pkgpart => $pkgpart ); + foreach my $field ( @fields ) { + if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) { + #$cust_pkg{$1} = str2time( shift @$columns ); + if ( $1 eq 'setup' ) { + $billtime = str2time(shift @columns); + } else { + $cust_pkg{$1} = str2time( shift @columns ); + } + } else { + #$cust_main{$field} = shift @$columns; + $cust_main{$field} = shift @columns; + } + } + + my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart; + my $cust_main = new FS::cust_main ( \%cust_main ); + use Tie::RefHash; + tie my %hash, 'Tie::RefHash'; #this part is important + $hash{$cust_pkg} = [] if $pkgpart; + my $error = $cust_main->insert( \%hash ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert customer for $line: $error"; + } + + #false laziness w/bill.cgi + $error = $cust_main->bill( 'time' => $billtime ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't bill customer for $line: $error"; + } + + $cust_main->apply_payments; + $cust_main->apply_credits; + + $error = $cust_main->collect(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't collect customer for $line: $error"; + } + + $imported++; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return "Empty file!" unless $imported; + + ''; #no error + +} + +=item batch_charge + +=cut + +sub batch_charge { + my $param = shift; + #warn join('-',keys %$param); + my $fh = $param->{filehandle}; + my @fields = @{$param->{fields}}; + + eval "use Date::Parse;"; + die $@ if $@; + eval "use Text::CSV_XS;"; + die $@ if $@; + + my $csv = new Text::CSV_XS; + #warn $csv; + #warn $fh; + + my $imported = 0; + #my $columns; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #while ( $columns = $csv->getline($fh) ) { + my $line; + while ( defined($line=<$fh>) ) { + + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + + my @columns = $csv->fields(); + #warn join('-',@columns); + + my %row = (); + foreach my $field ( @fields ) { + $row{$field} = shift @columns; + } + + my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } ); + unless ( $cust_main ) { + $dbh->rollback if $oldAutoCommit; + return "unknown custnum $row{'custnum'}"; + } + + if ( $row{'amount'} > 0 ) { + my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $imported++; + } elsif ( $row{'amount'} < 0 ) { + my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), + $row{'pkg'} ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $imported++; + } else { + #hmm? + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return "Empty file!" unless $imported; + + ''; #no error + +} + =back =head1 BUGS @@ -1976,6 +3337,8 @@ card types. No multiple currency support (probably a larger project than just this module). +payinfo_masked false laziness with cust_pay.pm and cust_refund.pm + =head1 SEE ALSO L, L, L, L @@ -1986,4 +3349,3 @@ L, L, schema.html from the base documentation. 1; -