diff options
Diffstat (limited to 'FS/FS/cust_main.pm')
| -rw-r--r-- | FS/FS/cust_main.pm | 495 |
1 files changed, 362 insertions, 133 deletions
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 2af2e98..6ca3287 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,11 +2,12 @@ package FS::cust_main; use strict; use vars qw( @ISA $conf $Debug $import ); +use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; BEGIN { eval "use Time::Local;"; - die "Time::Local version 1.05 required with Perl versions before 5.6" + 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);"; } @@ -21,6 +22,7 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; use FS::cust_credit; +use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::agent; @@ -38,7 +40,9 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); -$Debug = 1; +$realtime_bop_decline_quiet = 0; + +$Debug = 0; #$Debug = 1; $import = 0; @@ -169,6 +173,8 @@ FS::Record. The following fields are currently supported: =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>) +=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 @@ -198,7 +204,7 @@ points to. You can ask the object for a copy with the I<hash> 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. @@ -226,12 +232,18 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); +Currently available options are: I<noexport> + +If I<noexport> is set true, no provisioning jobs (exports) are scheduled. +(You can schedule them later with the B<reexport> method.) + =cut sub insert { my $self = shift; my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; + my %options = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -283,7 +295,8 @@ sub insert { } # packages - $error = $self->order_pkgs($cust_pkgs, \$seconds); + #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; + $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -317,9 +330,27 @@ sub insert { } -=item order_pkgs +=item order_pkgs HASHREF, [ , 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<tablename> 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, 'noexport'=>1 ); + +Currently available options are: I<noexport> -document me. like ->insert(%cust_pkg) on an existing record +If I<noexport> is set true, no provisioning jobs (exports) are scheduled. +(You can schedule them later with the B<reexport> method for each +cust_pkg object. Using the B<reexport> method on the cust_main object is not +recommended, as existing services will also be reexported.) =cut @@ -327,6 +358,7 @@ sub order_pkgs { my $self = shift; my $cust_pkgs = shift; my $seconds = shift; + my %options = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -339,6 +371,8 @@ sub order_pkgs { 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; @@ -365,6 +399,41 @@ sub order_pkgs { ''; #no error } +=item reexport + +Re-schedules all exports by calling the B<reexport> method of all associated +packages (see L<FS::cust_pkg>). If there is an error, returns the error; +otherwise returns false. + +=cut + +sub reexport { + 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; + + foreach my $cust_pkg ( $self->ncancelled_pkgs ) { + my $error = $cust_pkg->reexport; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item delete NEW_CUSTNUM This deletes the customer. If there is an error, returns the error, otherwise @@ -372,7 +441,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<FS::cust_pkg/cancel>). +customer's packages (see L</cancel>). 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 @@ -399,19 +468,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"; } @@ -490,6 +559,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; @@ -603,7 +678,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; @@ -722,6 +797,21 @@ 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' ) { @@ -730,6 +820,7 @@ sub check { $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' ) { @@ -738,16 +829,24 @@ sub check { $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' ) { @@ -758,6 +857,7 @@ 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'); } @@ -780,7 +880,7 @@ sub check { if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } - if ( $self->payname eq '' && $self->payby ne 'CHEK' && + if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && ( ! $conf->exists('require_cardname') || $self->payby !~ /^(CARD|DCRD)$/ ) ) { @@ -794,7 +894,7 @@ 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; @@ -902,16 +1002,21 @@ sub suspend { grep { $_->suspend } $self->unsuspended_pkgs; } -=item cancel +=item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer. + +Available options are: I<quiet> + +I<quiet> 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 @@ -932,15 +1037,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<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> 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<perlfunc/"time">). Also see L<Time::Local> and +L<Date::Parse> 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 @@ -997,7 +1106,7 @@ sub bill { # 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; @@ -1017,14 +1126,14 @@ 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 ) { @@ -1062,8 +1171,19 @@ sub bill { $cust_pkg->last_bill($sdate) if $cust_pkg->dbdef_table->column('last_bill'); - $mon += $part_pkg->freq; - until ( $mon < 12 ) { $mon -= 12; $year++; } + 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_nocheck($sec,$min,$hour,$mday,$mon,$year)); $cust_pkg_mod_flag = 1; @@ -1073,7 +1193,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 @@ -1082,15 +1201,15 @@ 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, @@ -1102,88 +1221,113 @@ sub bill { 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, - } ); - $cust_main_county ||= qsearchs('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => '', - } ); - unless ( $cust_main_county ) { + + 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 ( $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 - $tax{ $cust_main_county->taxname || '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 + } #if $setup != 0 || $recur != 0 } #if $cust_pkg_mod_flag @@ -1210,21 +1354,42 @@ sub bill { # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) # ); - foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { - my $tax = sprintf("%.2f", $tax{$taxname} ); - $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' => '', - 'itemdesc' => $taxname, - }); - push @cust_bill_pkg, $cust_bill_pkg; } -# } my $cust_bill = new FS::cust_bill ( { 'custnum' => $self->custnum, @@ -1288,6 +1453,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 { @@ -1325,24 +1492,15 @@ sub collect { } } - 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 @@ -1359,12 +1517,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; 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 = ''; @@ -1548,9 +1712,20 @@ sub realtime_bop { 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' ) { my($account_number,$routing_code) = $self->payinfo; ( $content{account_number}, $content{routing_code} ) = @@ -1635,6 +1810,21 @@ sub realtime_bop { } + #remove paycvv after initial transaction + #make this disable-able via a config option if anyone insists? + # (though that probably violates cardholder agreements) + if ( defined $self->dbdef_table->column('paycvv') + && length($self->paycvv) + && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save') + ) { + my $new = new FS::cust_main { $self->hash }; + $new->paycvv(''); + my $error = $new->replace($self); + if ( $error ) { + warn "error removing cvv: $error\n"; + } + } + #result handling if ( $transaction->is_success() ) { @@ -1669,8 +1859,11 @@ sub realtime_bop { my $perror = "$processor error: ". $transaction->error_message; - if ( !$options{'quiet'} && $conf->exists('emaildecline') + if ( !$options{'quiet'} && !$realtime_bop_decline_quiet + && $conf->exists('emaildecline') && grep { $_ ne 'POST' } $self->invoicing_list + && ! grep { $_ eq $transaction->error_message } + $conf->config('emaildecline-exclude') ) { my @templ = $conf->config('declinetemplate'); my $template = new Text::Template ( @@ -2196,6 +2389,42 @@ sub open_cust_bill { grep { $_->owed > 0 } $self->cust_bill; } +=item cust_credit + +Returns all the credits (see L<FS::cust_credit>) 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<FS::cust_pay>) for this customer. + +=cut + +sub cust_pay { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) +} + +=item cust_refund + +Returns all the refunds (see L<FS::cust_refund>) for this customer. + +=cut + +sub cust_refund { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) +} + =back =head1 SUBROUTINES |