X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_bill_ApplicationCommon.pm;h=afb90f40e8389913853ff7cfa84bd6b448dc3f3b;hb=dafdfc24616b04a5ff594da31e2cdd03f58634b6;hp=7f564cd1e78b1af74736c1d9a5463309f482289f;hpb=64fcb43c61c196766260319cd9219eb70ea27767;p=freeside.git diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index 7f564cd1e..afb90f40e 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -5,6 +5,11 @@ 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 ); @@ -154,7 +159,10 @@ sub calculate_applications { $self->cust_bill->invnum. ": ". join(', ', @open). "\n" if $DEBUG; my $total = 0; - $total += $_->owed_setup + $_->owed_recur foreach @open; + foreach (@open) { + $total += $_->owed_setup if $_->setup; + $total += $_->owed_recur if $_->recur; + } $total = sprintf('%.2f', $total); if ( $self->amount > $total ) { @@ -172,7 +180,8 @@ sub calculate_applications { if $DEBUG; #@apply = map { [ $_, $_->amount ]; } @open; - @apply = map { [ $_, $_->owed_setup + 0 || $_->owed_recur + 0 ]; } @open; + #@apply = map { [ $_, $_->owed_setup + 0 || $_->owed_recur + 0 ]; } @open; + @apply = map { [ $_, $_->setup ? $_->owed_setup : $_->owed_recur ]; } @open; } else { @@ -180,8 +189,8 @@ sub calculate_applications { # - amount exactly and uniquely matches a single open lineitem # (you must be trying to pay or credit that item, then) - my @same = grep { $_->owed_setup == $self->amount - || $_->owed_recur == $self->amount + my @same = grep { ( $_->setup && $_->owed_setup == $self->amount ) + || ( $_->recur && $_->owed_recur == $self->amount ) } @open; if ( scalar(@same) == 1 ) { @@ -208,7 +217,7 @@ sub calculate_applications { my $weight = $cust_pkg ? ( $cust_pkg->part_pkg->$weight_col() || 0 ) - : 0; #default or per-tax weight? + : -1; #default or per-tax weight? [ $open, $weight ] } @open; @@ -216,7 +225,7 @@ sub calculate_applications { 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; @@ -226,7 +235,10 @@ sub calculate_applications { my @items = map { $_->[0] } grep { $weight == $_->[1] } @openweight; my $itemtotal = 0; - foreach my $item (@items) { $itemtotal += $item->owed_setup + 0 || $item->owed_recur + 0; } + foreach my $item (@items) { + $itemtotal += $item->owed_setup if $item->setup; + $itemtotal += $item->owed_recur if $item->recur; + } my $applytotal = min( $itemtotal, $remaining_amount ); $remaining_amount -= $applytotal; @@ -237,81 +249,83 @@ sub calculate_applications { #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->owed_setup + 0 || $item->owed_recur + 0; + my @newitems = (); + foreach my $item ( @items ) { + my $itemamount = $item->setup ? $item->owed_setup : $item->owed_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 - 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 ) ) { - return "couldn't futz with pennies enough: still $diff left"; - } + } 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 + 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 ) ) { + 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; - 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; @@ -353,8 +367,6 @@ sub apply_to_lineitems { return '' if $skip_apply_to_lineitems_hack; - - my $conf = new FS::Conf; local $SIG{HUP} = 'IGNORE'; @@ -397,6 +409,30 @@ sub apply_to_lineitems { $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 ( @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