X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_bill_ApplicationCommon.pm;h=cadb8a796673873f7e83b5692e997c0e21a7ec8d;hp=30243e2109544a55b3773cae9c171293e43721a9;hb=aed8ec35ccb9cdeb7ea0cb6ff2946f9d83d582f6;hpb=8fccb0da9d9b2213cc1409d7d7bf94ecc68a66f6 diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index 30243e210..cadb8a796 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 ) { @@ -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'; - } + } 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; - 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; - #$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,8 +409,43 @@ 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 + } + # unset promised payment date if there is one + my $cust_bill = $self->cust_bill; + if ( $cust_bill->promised_date and $cust_bill->owed <= 0 ) { + $cust_bill->set('promised_date', ''); + my $error = $cust_bill->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #everything should always be applied to line items in full now... sanity check $applied = sprintf('%.2f', $applied); unless ( $applied == $self->amount ) {