X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=50faeb42255faad1bd77d3b32e807081b7d78c71;hb=fadaa67e77ad8d5d966e252aba7f193e9e3840e3;hp=2a8eb1ddc6d9cbb274046e14f756e39448da52a5;hpb=6c6b3fe527d046ec3ca83ba1fa67ee414f702bca;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 2a8eb1ddc..50faeb422 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,7 +2,7 @@ package FS::cust_main; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles ); + $import $skip_fuzzyfiles $ignore_expired_card ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -16,6 +16,7 @@ BEGIN { } use Digest::MD5 qw(md5_base64); use Date::Format; +use Date::Parse; #use Date::Manip; use String::Approx qw(amatch); use Business::CreditCard 0.28; @@ -43,6 +44,7 @@ use FS::part_pkg; use FS::part_bill_event; use FS::cust_bill_event; use FS::cust_tax_exempt; +use FS::cust_tax_exempt_pkg; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; @@ -54,11 +56,15 @@ use FS::banned_pay; $realtime_bop_decline_quiet = 0; +# 1 is mostly method/subroutine entry and options +# 2 traces progress of some operations +# 3 is even more information including possibly sensitive data $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; $skip_fuzzyfiles = 0; +$ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); @@ -113,8 +119,6 @@ FS::cust_main - Object methods for cust_main records $error = $record->collect; $error = $record->collect %options; $error = $record->collect 'invoice_time' => $time, - 'batch_card' => 'yes', - 'report_badcard' => 'yes', ; =head1 DESCRIPTION @@ -244,7 +248,7 @@ sub paymask { if ( defined($value) && !$self->is_encrypted($value)) { my $payinfo = $value; my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCARD') { # Credit Cards (Show last four) + if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); } elsif ($payby eq 'CHEK' || $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) @@ -343,7 +347,7 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; - warn "FS::cust_main::insert called with options ". + warn "$me insert called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -360,12 +364,16 @@ sub insert { my $prepay_identifier = ''; my( $amount, $seconds ) = ( 0, 0 ); + my $payby = ''; if ( $self->payby eq 'PREPAY' ) { $self->payby('BILL'); $prepay_identifier = $self->payinfo; $self->payinfo(''); + warn " looking up prepaid card $prepay_identifier\n" + if $DEBUG > 1; + my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -373,8 +381,19 @@ sub insert { return $error; } + $payby = 'PREP' if $amount; + + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + + $payby = $1; + $self->payby('BILL'); + $amount = $self->paid; + } + warn " inserting $self\n" + if $DEBUG > 1; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -382,7 +401,9 @@ sub insert { return $error; } - # invoicing list + warn " setting invoicing list\n" + if $DEBUG > 1; + if ( $invoicing_list ) { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -392,7 +413,9 @@ sub insert { $self->invoicing_list( $invoicing_list ); } - # packages + warn " ordering packages\n" + if $DEBUG > 1; + $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -405,14 +428,18 @@ sub insert { } if ( $amount ) { - $error = $self->insert_cust_pay_prepay($amount, $prepay_identifier); + warn " inserting initial $payby payment of $amount\n" + if $DEBUG > 1; + $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting prepayment (transaction rolled back): $error"; + return "inserting payment (transaction rolled back): $error"; } } unless ( $import || $skip_fuzzyfiles ) { + warn " queueing fuzzyfiles update\n" + if $DEBUG > 1; $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -420,6 +447,9 @@ sub insert { } } + warn " insert complete; committing transaction\n" + if $DEBUG > 1; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -466,7 +496,7 @@ sub order_pkgs { my %svc_options = (); $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} if exists $options{'depend_jobnum'}; - warn "FS::cust_main::order_pkgs called with options ". + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -662,7 +692,7 @@ sub increment_seconds { my $cust_pkg = $cust_pkg[0]; warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" - if $DEBUG; + if $DEBUG > 1; my @cust_svc = $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); @@ -676,7 +706,7 @@ sub increment_seconds { my $svc_acct = $cust_svc[0]->svc_x; warn " found service svcnum ". $svc_acct->pkgnum. ' ('. $svc_acct->email. ")\n" - if $DEBUG; + if $DEBUG > 1; $svc_acct->increment_seconds($seconds); @@ -691,14 +721,42 @@ If there is an error, returns the error, otherwise returns false. =cut sub insert_cust_pay_prepay { - my( $self, $amount ) = splice(@_, 0, 2); + shift->insert_cust_pay('PREP', @_); +} + +=item insert_cust_pay_cash AMOUNT [ PAYINFO ] + +Inserts a cash payment in the specified amount for this customer. An optional +second argument can specify the payment identifier for tracking purposes. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_cash { + shift->insert_cust_pay('CASH', @_); +} + +=item insert_cust_pay_west AMOUNT [ PAYINFO ] + +Inserts a Western Union payment in the specified amount for this customer. An +optional second argument can specify the prepayment identifier for tracking +purposes. If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_west { + shift->insert_cust_pay('WEST', @_); +} + +sub insert_cust_pay { + my( $self, $payby, $amount ) = splice(@_, 0, 3); my $payinfo = scalar(@_) ? shift : ''; my $cust_pay = new FS::cust_pay { 'custnum' => $self->custnum, 'paid' => sprintf('%.2f', $amount), #'_date' => #date the prepaid card was purchased??? - 'payby' => 'PREP', + 'payby' => $payby, 'payinfo' => $payinfo, }; $cust_pay->insert; @@ -719,7 +777,7 @@ otherwise returns false. sub reexport { my $self = shift; - carp "warning: FS::cust_main::reexport is deprectated; ". + 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'; @@ -887,6 +945,11 @@ sub replace { unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } + local($ignore_expired_card) = 1 + if $old->payby =~ /^(CARD|DCRD)$/ + && $self->payby =~ /^(CARD|DCRD)$/ + && $old->payinfo eq $self->payinfo; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -983,7 +1046,8 @@ and replace methods. sub check { my $self = shift; - #warn "BEFORE: \n". $self->_dump; + warn "$me check BEFORE: \n". $self->_dump + if $DEBUG > 2; my $error = $self->ut_numbern('custnum') @@ -1105,7 +1169,7 @@ sub check { } } - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ or return "Illegal payby: ". $self->payby; $error = $self->ut_numbern('paystart_month') @@ -1242,7 +1306,7 @@ sub check { if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; + unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; $self->paydate(''); } else { my( $m, $y ); @@ -1256,7 +1320,9 @@ sub check { $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') - if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); + if !$import + && !$ignore_expired_card + && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && @@ -1275,7 +1341,8 @@ sub check { $self->otaker(getotaker) unless $self->otaker; - #warn "AFTER: \n". $self->_dump; + warn "$me check AFTER: \n". $self->_dump + if $DEBUG > 2; $self->SUPER::check; } @@ -1393,7 +1460,8 @@ sub unsuspend { =item suspend Suspends all unsuspended packages (see L) for this customer. -Always returns a list: an empty list on success or a list of errors. + +Returns a list: an empty list on success or a list of errors. =cut @@ -1405,8 +1473,9 @@ sub suspend { =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. +PKGPARTs (see L). + +Returns a list: an empty list on success or a list of errors. =cut @@ -1421,8 +1490,9 @@ sub suspend_if_pkgpart { =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. +listed PKGPARTs (see L). + +Returns a list: an empty list on success or a list of errors. =cut @@ -1526,7 +1596,8 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; return '' if $self->payby eq 'COMP'; - warn "bill customer ". $self->custnum. "\n" if $DEBUG; + warn "$me bill customer ". $self->custnum. "\n" + if $DEBUG; my $time = $options{'time'} || time; @@ -1546,16 +1617,28 @@ sub bill { $self->select_for_update; #mutex + #create a new invoice + #(we'll remove it later if it doesn't actually need to be generated [contains + # no line items] and we're inside a transaciton so nothing else will see it) + my $cust_bill = new FS::cust_bill ( { + 'custnum' => $self->custnum, + '_date' => $time, + #'charged' => $charged, + 'charged' => 0, + } ); + $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice for customer #". $self->custnum. ": $error"; + } + my $invnum = $cust_bill->invnum; + + ### # 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 $taxable_charged = 0;## - #my $charged = 0;## + ### + my( $total_setup, $total_recur ) = ( 0, 0 ); my %tax; foreach my $cust_pkg ( @@ -1565,7 +1648,7 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG; + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') @@ -1578,11 +1661,14 @@ sub bill { my @details = (); + ### # bill setup + ### + my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - warn " bill setup\n" if $DEBUG; + warn " bill setup\n" if $DEBUG > 1; $setup = eval { $cust_pkg->calc_setup( $time ) }; if ( $@ ) { @@ -1593,7 +1679,10 @@ sub bill { $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; } - #bill recurring fee + ### + # bill recurring fee + ### + my $recur = 0; my $sdate; if ( $part_pkg->getfield('freq') ne '0' && @@ -1601,7 +1690,7 @@ sub bill { ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { - warn " bill recur\n" if $DEBUG; + warn " bill recur\n" if $DEBUG > 1; # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -1633,6 +1722,9 @@ sub bill { } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { my $days = $1; $mday += $days; + } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) { + my $hours = $1; + $hour += $hours; } else { $dbh->rollback if $oldAutoCommit; return "unparsable frequency: ". $part_pkg->freq; @@ -1645,9 +1737,14 @@ sub bill { warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); + ### + # If $cust_pkg has been modified, update it and create cust_bill_pkg records + ### + if ( $cust_pkg->modified ) { - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG; + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" + if $DEBUG >1; $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case @@ -1665,10 +1762,13 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } + if ( $setup != 0 || $recur != 0 ) { - warn " charges (setup=$setup, recur=$recur); queueing line items\n" - if $DEBUG; + + warn " charges (setup=$setup, recur=$recur); adding line items\n" + if $DEBUG > 1; my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'invnum' => $invnum, 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, 'recur' => $recur, @@ -1676,10 +1776,18 @@ sub bill { 'edate' => $cust_pkg->bill, 'details' => \@details, }); - push @cust_bill_pkg, $cust_bill_pkg; + $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item for invoice #$invnum: $error"; + } $total_setup += $setup; $total_recur += $recur; + ### + # handle taxes + ### + unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { my @taxes = qsearch( 'cust_main_county', { @@ -1728,7 +1836,8 @@ sub bill { next unless $taxable_charged; if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { - my ($mon,$year) = (localtime($sdate) )[4,5]; + #my ($mon,$year) = (localtime($sdate) )[4,5]; + my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5]; $mon++; my $freq = $part_pkg->freq || 1; if ( $freq !~ /(\d+)$/ ) { @@ -1736,40 +1845,74 @@ sub bill { return "daily/weekly package definitions not (yet?)". " compatible with monthly tax exemptions"; } - my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); + my $taxable_per_month = + sprintf("%.2f", $taxable_charged / $freq ); + + #call the whole thing off if this customer has any old + #exemption records... + my @cust_tax_exempt = + qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } ); + if ( @cust_tax_exempt ) { + $dbh->rollback if $oldAutoCommit; + return + 'this customer still has old-style tax exemption records; '. + 'run bin/fs-migrate-cust_tax_exempt?'; + } + 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 ); + + #maintain the new exemption table now + my $sql = " + SELECT SUM(amount) + FROM cust_tax_exempt_pkg + LEFT JOIN cust_bill_pkg USING ( billpkgnum ) + LEFT JOIN cust_bill USING ( invnum ) + WHERE custnum = ? + AND taxnum = ? + AND year = ? + AND month = ? + "; + my $sth = dbh->prepare($sql) or do { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't lookup exising exemption: ". dbh->errstr; + }; + $sth->execute( + $self->custnum, + $tax->taxnum, + 1900+$year, + $mon, + ) or do { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't lookup exising exemption: ". dbh->errstr; + }; + my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0; + + my $remaining_exemption = + $tax->exempt_amount - $existing_exemption; 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), + + my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $tax->taxnum, + 'year' => 1900+$year, + 'month' => $mon, + 'amount' => sprintf("%.2f", $addl ), } ); - $error = $new_cust_tax_exempt->exemptnum - ? $new_cust_tax_exempt->replace($cust_tax_exempt) - : $new_cust_tax_exempt->insert; + $error = $cust_tax_exempt_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "fatal: can't update cust_tax_exempt: $error"; + return "fatal: can't insert cust_tax_exempt_pkg: $error"; } - } # if $remaining_exemption > 0 + + #++ + $mon++; + #until ( $mon < 12 ) { $mon -= 12; $year++; } + until ( $mon < 13 ) { $mon -= 12; $year++; } } #foreach $which_month @@ -1791,86 +1934,41 @@ sub bill { } #foreach my $cust_pkg - my $charged = sprintf( "%.2f", $total_setup + $total_recur ); -# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); - - unless ( @cust_bill_pkg ) { #don't create invoices with no line items + unless ( $cust_bill->cust_bill_pkg ) { + $cust_bill->delete; #don't create an invoice w/o line items $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; - } - -# 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, -# } ) or die "fatal: can't find tax rate for state/county/country ". -# $self->state. "/". $self->county. "/". $self->country. "\n"; -# my $tax = sprintf( "%.2f", -# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) -# ); - - 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 = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => $time, - 'charged' => $charged, - } ); - $error = $cust_bill->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; - } + my $charged = sprintf( "%.2f", $total_setup + $total_recur ); - my $invnum = $cust_bill->invnum; - my $cust_bill_pkg; - foreach $cust_bill_pkg ( @cust_bill_pkg ) { - #warn $invnum; - $cust_bill_pkg->invnum($invnum); + 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 ({ + 'invnum' => $invnum, + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + }); $error = $cust_bill_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for customer #". $self->custnum. - ": $error"; + return "can't create invoice line item for invoice #$invnum: $error"; } + $total_setup += $tax; + + } + + $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) ); + $error = $cust_bill->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't update charged for invoice #$invnum: $error"; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -1902,17 +2000,11 @@ for conversion functions. 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. - -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. +freq - "1d" for the traditional, daily events (the default), or "1m" for the +new monthly events + =cut sub collect { @@ -1934,7 +2026,8 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG; + warn "$me collect customer ". $self->custnum. ": balance $balance\n" + if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1952,6 +2045,13 @@ sub collect { } } + my $extra_sql = ''; + if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) { + $extra_sql = " AND freq = '1m' "; + } else { + $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) "; + } + foreach my $cust_bill ( $self->open_cust_bill ) { # don't try to charge for the same invoice if it's already in a batch @@ -1959,8 +2059,8 @@ sub collect { last if $self->balance <= 0; - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" - if $DEBUG; + warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" + if $DEBUG > 1; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds @@ -1973,15 +2073,19 @@ sub collect { 'status' => 'done', } ) } - qsearch('part_bill_event', { 'payby' => $self->payby, - 'disabled' => '', } ) + qsearch( { + 'table' => 'part_bill_event', + 'hashref' => { 'payby' => $self->payby, + 'disabled' => '', }, + 'extra_sql' => $extra_sql, + } ) ) { 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; + warn " calling invoice event (". $part_bill_event->eventcode. ")\n" + if $DEBUG > 1; my $cust_main = $self; #for callback my $error; @@ -2121,7 +2225,7 @@ I can be set true to surpress email decline notices. sub realtime_bop { my( $self, $method, $amount, %options ) = @_; if ( $DEBUG ) { - warn "$self $method $amount\n"; + warn "$me realtime_bop: $method $amount\n"; warn " $_ => $options{$_}\n" foreach keys %options; } @@ -2233,6 +2337,13 @@ sub realtime_bop { : $invoicing_list[0]; my %content = (); + + my $payip = exists($options{'payip'}) + ? $options{'payip'} + : $self->payip; + $content{customer_ip} = $payip + if length($payip); + if ( $method eq 'CC' ) { $content{card_number} = $payinfo; @@ -2264,12 +2375,6 @@ sub realtime_bop { : $self->payissue; $content{issue_number} = $payissue if $payissue; - my $payip = exists($options{'payip'}) - ? $options{'payip'} - : $self->payip; - $content{customer_ip} = $payip - if length($payip); - $content{recurring_billing} = 'YES' if qsearch('cust_pay', { 'custnum' => $self->custnum, 'payby' => 'CARD', @@ -2382,7 +2487,7 @@ sub realtime_bop { ) { my $error = $self->remove_cvv; if ( $error ) { - warn "error removing cvv: $error\n"; + warn "WARNING: error removing cvv: $error\n"; } } @@ -2552,7 +2657,7 @@ gateway is attempted. sub realtime_refund_bop { my( $self, $method, %options ) = @_; if ( $DEBUG ) { - warn "$self $method refund\n"; + warn "$me realtime_refund_bop: $method refund\n"; warn " $_ => $options{$_}\n" foreach keys %options; } @@ -2571,12 +2676,12 @@ sub realtime_refund_bop { if ( $options{'paynum'} ) { - warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG; + warn " paynum: $options{paynum}\n" if $DEBUG > 1; $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) or return "Unknown paynum $options{'paynum'}"; $amount ||= $cust_pay->paid; - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):([\w-]*)(:(\w+))?$/ + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/ or return "Can't parse paybatch for paynum $options{'paynum'}: ". $cust_pay->paybatch; my $gatewaynum = ''; @@ -2661,7 +2766,7 @@ sub realtime_refund_bop { #first try void if applicable if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? - warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG; + warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); $void->content( 'action' => 'void', %content ); $void->submit(); @@ -2674,13 +2779,13 @@ sub realtime_refund_bop { warn $e; return $e; } - warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG; + warn " void successful\n" if $DEBUG > 1; return ''; } } - warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n" - if $DEBUG; + warn " void unsuccessful, trying refund\n" + if $DEBUG > 1; #massage data my $address = $self->address1; @@ -3860,8 +3965,6 @@ sub batch_import { my $pkgpart = $param->{pkgpart}; my @fields = @{$param->{fields}}; - eval "use Date::Parse;"; - die $@ if $@; eval "use Text::CSV_XS;"; die $@ if $@; @@ -3967,8 +4070,6 @@ sub batch_charge { my $fh = $param->{filehandle}; my @fields = @{$param->{fields}}; - eval "use Date::Parse;"; - die $@ if $@; eval "use Text::CSV_XS;"; die $@ if $@;