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 );
$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 ) {
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 {
# - 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 ) {
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;
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;
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;
#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;
return '' if $skip_apply_to_lineitems_hack;
-
-
my $conf = new FS::Conf;
local $SIG{HUP} = 'IGNORE';
$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 ) {