X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_bill_ApplicationCommon.pm;h=fd6fb9e73a56785c60205758d79ed8acda186fa3;hb=740a284c94d57bd755baa58dae36eae5bc581e44;hp=195fa8d0f1fe56831ea3b591076c7905cffd4e2e;hpb=05686487551e26418c9b2d6b92ea0d89bb100082;p=freeside.git diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index 195fa8d0f..fd6fb9e73 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -1,16 +1,23 @@ package FS::cust_bill_ApplicationCommon; use strict; -use vars qw( @ISA $DEBUG $me ); +use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack ); use List::Util qw(min); use FS::Schema qw( dbdef ); use FS::Record qw( qsearch qsearchs dbh ); +use FS::cust_pkg; +use FS::cust_svc; +use FS::cust_bill_pkg; +use FS::part_svc; +use FS::part_export; @ISA = qw( FS::Record ); $DEBUG = 0; $me = '[FS::cust_bill_ApplicationCommon]'; +$skip_apply_to_lineitems_hack = 0; + =head1 NAME FS::cust_bill_ApplicationCommon - Base class for bill application classes @@ -33,6 +40,8 @@ represent application of things to invoices, currently payments =head1 METHODS +=over 4 + =item insert =cut @@ -52,7 +61,7 @@ sub insert { my $dbh = dbh; my $error = $self->SUPER::insert(@_) - || $self->apply_to_lineitems; + || $self->apply_to_lineitems(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -109,10 +118,15 @@ Auto-applies this invoice application to specific line items, if possible. =cut sub apply_to_lineitems { - my $self = shift; + #my $self = shift; + my( $self, %options ) = @_; + + return '' if $skip_apply_to_lineitems_hack; my @apply = (); + my $conf = new FS::Conf; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -125,8 +139,10 @@ sub apply_to_lineitems { my $dbh = dbh; my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...? + @open = grep { $_->pkgnum == $self->pkgnum } @open + if $conf->exists('pkg-balances') && $self->pkgnum; warn "$me ". scalar(@open). " open line items for invoice ". - $self->cust_bill->invnum. "\n" + $self->cust_bill->invnum. ": ". join(', ', @open). "\n" if $DEBUG; my $total = 0; $total += $_->setup + $_->recur foreach @open; @@ -178,13 +194,21 @@ sub apply_to_lineitems { # - apply based on weights... my $weight_col = $self->_app_part_pkg_weight_column; - my @openweight = map { [ $_, ($_->cust_pkg->part_pkg->$weight_col()||0) ] } + my @openweight = map { + my $open = $_; + my $cust_pkg = $open->cust_pkg; + my $weight = + $cust_pkg + ? ( $cust_pkg->part_pkg->$weight_col() || 0 ) + : 0; #default or per-tax weight? + [ $open, $weight ] + } @open; my %saw = (); my @weights = sort { $b <=> $a } # highest weight first grep { ! $saw{$_}++ } # want a list of unique weights - map { $_->[1] } + map { $_->[1] } @openweight; my $remaining_amount = $self->amount; @@ -205,83 +229,85 @@ sub apply_to_lineitems { #if some items are less than applytotal/num_items, then apply then in full my $lessflag; do { - $lessflag = 0; + $lessflag = 0; - #no, not sprintf("%.2f", - # we want this rounded DOWN for purposes of checking for line items - # less than it, we don't want .66666 becoming .67 and causing this - # to trigger when it shouldn't + #no, not sprintf("%.2f", + # we want this rounded DOWN for purposes of checking for line items + # less than it, we don't want .66666 becoming .67 and causing this + # to trigger when it shouldn't my $applyeach = int( 100 * $applytotal / scalar(@items) ) / 100; - my @newitems = (); - foreach my $item ( @items ) { - my $itemamount = $item->setup || $item->recur; + my @newitems = (); + foreach my $item ( @items ) { + my $itemamount = $item->setup || $item->recur; if ( $itemamount < $applyeach ) { - warn "$me applying full $itemamount". - " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n" - if $DEBUG; - push @apply, [ $item, $itemamount ]; - $applytotal -= $itemamount; + warn "$me applying full $itemamount". + " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n" + if $DEBUG; + push @apply, [ $item, $itemamount ]; + $applytotal -= $itemamount; $lessflag=1; - } else { - push @newitems, $item; - } - } - @items = @newitems; - - } while ( $lessflag ); - - #and now that we've fallen out of the loop, distribute the rest equally... - - # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns - # become real instead of numeric(10,2) ??? no.. - my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) ); - - my @equi_apply = map { [ $_, $applyeach ] } @items; - - # or should we futz with pennies instead? yes, bah! - my $diff = - sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) ); - $diff = 0 if $diff eq '-0'; #yay ieee fp - if ( abs($diff) > scalar(@items) ) { - #we must have done something really wrong, the difference is more than - #a penny an item - $dbh->rollback if $oldAutoCommit; - return 'Error distributing pennies applying '. $self->_app_source_name. - " - can't distribute difference of $diff pennies". - ' among '. scalar(@items). ' line items'; - } + } else { + push @newitems, $item; + } + } + @items = @newitems; + + } while ( $lessflag && @items ); + + if ( @items ) { + + #and now that we've fallen out of the loop, distribute the rest equally + + # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns + # become real instead of numeric(10,2) ??? no.. + my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) ); + + my @equi_apply = map { [ $_, $applyeach ] } @items; + + # or should we futz with pennies instead? yes, bah! + my $diff = + sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) ); + $diff = 0 if $diff eq '-0'; #yay ieee fp + if ( abs($diff) > scalar(@items) ) { + #we must have done something really wrong, the difference is more than + #a penny an item + $dbh->rollback if $oldAutoCommit; + return 'Error distributing pennies applying '.$self->_app_source_name. + " - can't distribute difference of $diff pennies". + ' among '. scalar(@items). ' line items'; + } + + warn "$me futzing with $diff pennies difference\n" + if $DEBUG && $diff; + + my $futz = 0; + while ( $diff != 0 && $futz < scalar(@equi_apply) ) { + if ( $diff > 0 ) { + $equi_apply[$futz++]->[1] += .01; + $diff -= 1; + } elsif ( $diff < 0 ) { + $equi_apply[$futz++]->[1] -= .01; + $diff += 1; + } else { + die "guru exception #5 (in fortran tongue the answer)"; + } + } + + if ( sprintf('%.0f', $diff ) ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't futz with pennies enough: still $diff left"; + } + + if ( $DEBUG ) { + warn "$me applying ". $_->[1]. + " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n" + foreach @equi_apply; + } + push @apply, @equi_apply; - warn "$me futzing with $diff pennies difference\n" - if $DEBUG && $diff; - - my $futz = 0; - while ( $diff != 0 && $futz < scalar(@equi_apply) ) { - if ( $diff > 0 ) { - $equi_apply[$futz++]->[1] += .01; - $diff -= 1; - } elsif ( $diff < 0 ) { - $equi_apply[$futz++]->[1] -= .01; - $diff += 1; - } else { - die "guru exception #5 (in fortran tongue the answer)"; - } } - if ( sprintf('%.0f', $diff ) ) { - $dbh->rollback if $oldAutoCommit; - return "couldn't futz with pennies enough: still $diff left"; - } - - if ( $DEBUG ) { - warn "$me applying ". $_->[1]. - " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n" - foreach @equi_apply; - } - - - push @apply, @equi_apply; - #$remaining_amount -= $applytotal; last unless $remaining_amount; @@ -304,11 +330,35 @@ sub apply_to_lineitems { 'sdate' => $cust_bill_pkg->sdate, 'edate' => $cust_bill_pkg->edate, }); - my $error = $application->insert; + my $error = $application->insert(%options); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + + # trigger export_insert_on_payment + if ( $conf->exists('trigger_export_insert_on_payment') + && $cust_bill_pkg->pkgnum > 0 ) + { + if ( my $cust_pkg = $cust_bill_pkg->cust_pkg ) { + + foreach my $cust_svc ( $cust_pkg->cust_svc ) { + my $svc_x = $cust_svc->svc_x; + my @part_export = grep { $_->can('export_insert_on_payment') } + $cust_svc->part_svc->part_export; + + foreach my $part_export ( $cust_svc->part_svc->part_export ) { + $error = $part_export->_export_insert_on_payment($svc_x); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + } + } + # done trigger export_insert_on_payment + } #everything should always be applied to line items in full now... sanity check @@ -351,6 +401,18 @@ sub cust_bill { qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); } +=item applied_to_invoice + +Returns a string representing the invoice (see L), for example: +"applied to Invoice #54 (3/20/2008)" + +=cut + +sub applied_to_invoice { + my $self = shift; + 'applied to '. $self->cust_bill->invnum_date_pretty; +} + =item lineitem_breakdown_table =cut