X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_credit.pm;h=58bd475b177e234fcc5d6358a58f6b3fa8b61f49;hp=df59950eac5f738fbb2d522f79d9fde60994ea13;hb=e9e0cf0989259b94d9758eceff448666a2e5a5cc;hpb=429a48b18a54917b73b3add468d930f60bcdb2fe diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index df59950ea..58bd475b1 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -1,5 +1,6 @@ package FS::cust_credit; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record ); +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin + FS::Record ); use strict; use vars qw( $conf $unsuspendauto $me $DEBUG @@ -447,57 +448,8 @@ sub credited { Returns the customer (see L) for this credit. -=item reason - -Returns the text of the associated reason (see L) for this credit. - =cut -sub reason { - my ($self, $value, %options) = @_; - my $dbh = dbh; - my $reason; - my $typenum = $options{'reason_type'}; - - my $oldAutoCommit = $FS::UID::AutoCommit; # this should already be in - local $FS::UID::AutoCommit = 0; # a transaction if it matters - - if ( defined( $value ) ) { - my $hashref = { 'reason' => $value }; - $hashref->{'reason_type'} = $typenum if $typenum; - my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) "; - my $extra_sql = " AND reason_type.class='R'"; - - $reason = qsearchs( { 'table' => 'reason', - 'hashref' => $hashref, - 'addl_from' => $addl_from, - 'extra_sql' => $extra_sql, - } ); - - if (!$reason && $typenum) { - $reason = new FS::reason( { 'reason_type' => $typenum, - 'reason' => $value, - 'disabled' => 'Y', - } ); - my $error = $reason->insert; - if ( $error ) { - warn "error inserting reason: $error\n"; - $reason = undef; - } - } - - $self->reasonnum($reason ? $reason->reasonnum : '') ; - warn "$me reason used in set mode with non-existant reason -- clearing" - unless $reason; - } - $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } ); - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ( $reason ? $reason->reason : '' ). - ( $self->addlinfo ? ' '.$self->addlinfo : '' ); -} - # _upgrade_data # # Used by FS::Upgrade to migrate to a new database. @@ -507,56 +459,9 @@ sub _upgrade_data { # class method warn "$me upgrading $class\n" if $DEBUG; - if (defined dbdef->table($class->table)->column('reason')) { - - warn "$me Checking for unmigrated reasons\n" if $DEBUG; - - my @cust_credits = qsearch({ 'table' => $class->table, - 'hashref' => {}, - 'extra_sql' => 'WHERE reason IS NOT NULL', - }); - - if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) { - warn "$me Found unmigrated reasons\n" if $DEBUG; - my $hashref = { 'class' => 'R', 'type' => 'Legacy' }; - my $reason_type = qsearchs( 'reason_type', $hashref ); - unless ($reason_type) { - $reason_type = new FS::reason_type( $hashref ); - my $error = $reason_type->insert(); - die "$class had error inserting FS::reason_type into database: $error\n" - if $error; - } - - $hashref = { 'reason_type' => $reason_type->typenum, - 'reason' => '(none)' - }; - my $noreason = qsearchs( 'reason', $hashref ); - unless ($noreason) { - $hashref->{'disabled'} = 'Y'; - $noreason = new FS::reason( $hashref ); - my $error = $noreason->insert(); - die "can't insert legacy reason '(none)' into database: $error\n" - if $error; - } - - foreach my $cust_credit ( @cust_credits ) { - my $reason = $cust_credit->getfield('reason'); - warn "Contemplating reason $reason\n" if $DEBUG > 1; - if ($reason =~ /\S/) { - $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum) - or die "can't insert legacy reason $reason into database\n"; - }else{ - $cust_credit->reasonnum($noreason->reasonnum); - } - - $cust_credit->setfield('reason', ''); - my $error = $cust_credit->replace; + $class->_upgrade_reasonnum(%opts); - warn "*** WARNING: error replacing reason in $class ". - $cust_credit->crednum. ": $error ***\n" - if $error; - } - } + if (defined dbdef->table($class->table)->column('reason')) { warn "$me Ensuring existance of auto reasons\n" if $DEBUG; @@ -910,14 +815,9 @@ sub credit_lineitems { # recalculate taxes with new amounts $taxlisthash{$invnum} ||= {}; - my $part_pkg = $cust_bill_pkg->part_pkg; - $cust_main->_handle_taxes( $part_pkg, - $taxlisthash{$invnum}, - $cust_bill_pkg, - $cust_bill_pkg->cust_pkg, - $cust_bill_pkg->cust_bill->_date, #invoice time - $cust_bill_pkg->cust_pkg->pkgpart, - ); + my $part_pkg = $cust_bill_pkg->part_pkg + if $cust_bill_pkg->pkgpart_override; + $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg ); } ### @@ -1013,12 +913,12 @@ sub credit_lineitems { # we still have to deal with the possibility that the tax links don't # cover the whole amount of tax because of an incomplete upgrade... - if ($amount > 0) { + if ($amount > 0.005) { $cust_credit_bill{$invnum} += $amount; push @{ $cust_credit_bill_pkg{$invnum} }, new FS::cust_credit_bill_pkg { 'billpkgnum' => $tax_item->billpkgnum, - 'amount' => $amount, + 'amount' => sprintf('%.2f', $amount), 'setuprecur' => 'setup', }; @@ -1103,6 +1003,58 @@ sub credit_lineitems { =back +=head1 SUBROUTINES + +=over 4 + +=item process_batch_import + +=cut + +use List::Util qw( min ); +use FS::cust_bill; +use FS::cust_credit_bill; +sub process_batch_import { + my $job = shift; + + my $opt = { 'table' => 'cust_credit', + 'params' => [ '_date', 'credbatch' ], + 'formats' => { 'simple' => + [ 'custnum', 'amount', 'reasonnum', 'invnum' ], + }, + 'default_csv' => 1, + 'postinsert_callback' => sub { + my $cust_credit = shift; #my ($cust_credit, $param ) = @_; + + if ( $cust_credit->invnum ) { + + my $cust_bill = qsearchs('cust_bill', { invnum=>$cust_credit->invnum } ); + my $amount = min( $cust_credit->credited, $cust_bill->owed ); + + my $cust_credit_bill = new FS::cust_credit_bill ( { + 'crednum' => $cust_credit->crednum, + 'invnum' => $cust_bill->invnum, + 'amount' => $amount, + } ); + my $error = $cust_credit_bill->insert; + return '' unless $error; + + } + + #apply_payments_and_credits ? + $cust_credit->cust_main->apply_credits; + + return ''; + + }, + }; + + FS::Record::process_batch_import( $job, $opt, @_ ); + +} + +=back + =head1 BUGS The delete method. The replace method.