1 package FS::cust_bill_ApplicationCommon;
4 use vars qw( @ISA $DEBUG $me );
5 use List::Util qw(min);
6 use FS::Schema qw( dbdef );
7 use FS::Record qw( qsearch qsearchs dbh );
9 @ISA = qw( FS::Record );
12 $me = '[FS::cust_bill_ApplicationCommon]';
16 FS::cust_bill_ApplicationCommon - Base class for bill application classes
20 use FS::cust_bill_ApplicationCommon;
22 @ISA = qw( FS::cust_bill_ApplicationCommon );
24 sub _app_source_name { 'payment'; }
25 sub _app_source_table { 'cust_pay'; }
26 sub _app_lineitem_breakdown_table { 'cust_bill_pay_pkg'; }
30 FS::cust_bill_ApplicationCommon is intended as a base class for classes which
31 represent application of things to invoices, currently payments
32 (see L<FS::cust_bill_pay>) or credits (see L<FS::cust_credit_bill>).
45 local $SIG{HUP} = 'IGNORE';
46 local $SIG{INT} = 'IGNORE';
47 local $SIG{QUIT} = 'IGNORE';
48 local $SIG{TERM} = 'IGNORE';
49 local $SIG{TSTP} = 'IGNORE';
50 local $SIG{PIPE} = 'IGNORE';
52 my $oldAutoCommit = $FS::UID::AutoCommit;
53 local $FS::UID::AutoCommit = 0;
56 my $error = $self->SUPER::insert(@_)
57 || $self->apply_to_lineitems;
59 $dbh->rollback if $oldAutoCommit;
63 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
76 local $SIG{HUP} = 'IGNORE';
77 local $SIG{INT} = 'IGNORE';
78 local $SIG{QUIT} = 'IGNORE';
79 local $SIG{TERM} = 'IGNORE';
80 local $SIG{TSTP} = 'IGNORE';
81 local $SIG{PIPE} = 'IGNORE';
83 my $oldAutoCommit = $FS::UID::AutoCommit;
84 local $FS::UID::AutoCommit = 0;
87 foreach my $app ( $self->lineitem_applications ) {
88 my $error = $app->delete;
90 $dbh->rollback if $oldAutoCommit;
95 my $error = $self->SUPER::delete(@_);
97 $dbh->rollback if $oldAutoCommit;
101 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
107 =item apply_to_lineitems
109 Auto-applies this invoice application to specific line items, if possible.
113 sub apply_to_lineitems {
118 local $SIG{HUP} = 'IGNORE';
119 local $SIG{INT} = 'IGNORE';
120 local $SIG{QUIT} = 'IGNORE';
121 local $SIG{TERM} = 'IGNORE';
122 local $SIG{TSTP} = 'IGNORE';
123 local $SIG{PIPE} = 'IGNORE';
125 my $oldAutoCommit = $FS::UID::AutoCommit;
126 local $FS::UID::AutoCommit = 0;
129 my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...?
130 warn "$me ". scalar(@open). " open line items for invoice ".
131 $self->cust_bill->invnum. ": ". join(', ', @open). "\n"
134 $total += $_->setup + $_->recur foreach @open;
135 $total = sprintf('%.2f', $total);
137 if ( $self->amount > $total ) {
138 $dbh->rollback if $oldAutoCommit;
139 return "Can't apply a ". $self->_app_source_name. ' of $'. $self->amount.
140 " greater than the remaining owed on line items (\$$total)";
144 # - one lineitem (a simple special case of:)
145 # - amount is for whole invoice (well, all of remaining lineitem links)
146 if ( $self->amount == $total ) {
148 warn "$me application amount covers remaining balance of invoice in full;".
149 "applying to those lineitems\n"
152 #@apply = map { [ $_, $_->amount ]; } @open;
153 @apply = map { [ $_, $_->setup || $_->recur ]; } @open;
157 #slightly magic case:
158 # - amount exactly and uniquely matches a single open lineitem
159 # (you must be trying to pay or credit that item, then)
161 my @same = grep { $_->setup == $self->amount
162 || $_->recur == $self->amount
165 if ( scalar(@same) == 1 ) {
166 warn "$me application amount exactly and uniquely matches one lineitem;".
167 " applying to that lineitem\n"
169 @apply = map { [ $_, $self->amount ]; } @same
176 warn "$me applying amount based on package weights\n"
180 # - apply based on weights...
182 my $weight_col = $self->_app_part_pkg_weight_column;
183 my @openweight = map {
185 my $cust_pkg = $open->cust_pkg;
188 ? ( $cust_pkg->part_pkg->$weight_col() || 0 )
189 : 0; #default or per-tax weight?
195 my @weights = sort { $b <=> $a } # highest weight first
196 grep { ! $saw{$_}++ } # want a list of unique weights
200 my $remaining_amount = $self->amount;
201 foreach my $weight ( @weights ) {
203 #i hate it when my schwartz gets tangled
204 my @items = map { $_->[0] } grep { $weight == $_->[1] } @openweight;
207 foreach my $item (@items) { $itemtotal += $item->setup || $item->recur; }
208 my $applytotal = min( $itemtotal, $remaining_amount );
209 $remaining_amount -= $applytotal;
211 warn "$me applying $applytotal ($remaining_amount remaining)".
212 " to ". scalar(@items). " lineitems with weight $weight\n"
215 #if some items are less than applytotal/num_items, then apply then in full
220 #no, not sprintf("%.2f",
221 # we want this rounded DOWN for purposes of checking for line items
222 # less than it, we don't want .66666 becoming .67 and causing this
223 # to trigger when it shouldn't
224 my $applyeach = int( 100 * $applytotal / scalar(@items) ) / 100;
227 foreach my $item ( @items ) {
228 my $itemamount = $item->setup || $item->recur;
229 if ( $itemamount < $applyeach ) {
230 warn "$me applying full $itemamount".
231 " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n"
233 push @apply, [ $item, $itemamount ];
234 $applytotal -= $itemamount;
237 push @newitems, $item;
242 } while ( $lessflag );
244 #and now that we've fallen out of the loop, distribute the rest equally...
246 # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns
247 # become real instead of numeric(10,2) ??? no..
248 my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) );
250 my @equi_apply = map { [ $_, $applyeach ] } @items;
252 # or should we futz with pennies instead? yes, bah!
254 sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) );
255 $diff = 0 if $diff eq '-0'; #yay ieee fp
256 if ( abs($diff) > scalar(@items) ) {
257 #we must have done something really wrong, the difference is more than
259 $dbh->rollback if $oldAutoCommit;
260 return 'Error distributing pennies applying '. $self->_app_source_name.
261 " - can't distribute difference of $diff pennies".
262 ' among '. scalar(@items). ' line items';
265 warn "$me futzing with $diff pennies difference\n"
269 while ( $diff != 0 && $futz < scalar(@equi_apply) ) {
271 $equi_apply[$futz++]->[1] += .01;
273 } elsif ( $diff < 0 ) {
274 $equi_apply[$futz++]->[1] -= .01;
277 die "guru exception #5 (in fortran tongue the answer)";
281 if ( sprintf('%.0f', $diff ) ) {
282 $dbh->rollback if $oldAutoCommit;
283 return "couldn't futz with pennies enough: still $diff left";
287 warn "$me applying ". $_->[1].
288 " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n"
293 push @apply, @equi_apply;
295 #$remaining_amount -= $applytotal;
296 last unless $remaining_amount;
302 # do the applicaiton(s)
303 my $table = $self->lineitem_breakdown_table;
304 my $source_key = dbdef->table($self->table)->primary_key;
306 foreach my $apply ( @apply ) {
307 my ( $cust_bill_pkg, $amount ) = @$apply;
309 my $application = "FS::$table"->new( {
310 $source_key => $self->$source_key(),
311 'billpkgnum' => $cust_bill_pkg->billpkgnum,
312 'amount' => sprintf('%.2f', $amount),
313 'setuprecur' => ( $cust_bill_pkg->setup > 0 ? 'setup' : 'recur' ),
314 'sdate' => $cust_bill_pkg->sdate,
315 'edate' => $cust_bill_pkg->edate,
317 my $error = $application->insert;
319 $dbh->rollback if $oldAutoCommit;
324 #everything should always be applied to line items in full now... sanity check
325 $applied = sprintf('%.2f', $applied);
326 unless ( $applied == $self->amount ) {
327 $dbh->rollback if $oldAutoCommit;
328 return 'Error applying '. $self->_app_source_name. ' of $'. $self->amount.
329 ' to line items - only $'. $applied. ' was applied.';
332 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
337 =item lineitem_applications
339 Returns all the specific line item applications for this invoice application.
343 sub lineitem_applications {
345 my $primary_key = dbdef->table($self->table)->primary_key;
347 'table' => $self->lineitem_breakdown_table,
348 'hashref' => { $primary_key => $self->$primary_key() },
355 Returns the invoice (see L<FS::cust_bill>)
361 qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
364 =item applied_to_invoice
366 Returns a string representing the invoice (see L<FS::cust_bill>), for example:
367 "applied to Invoice #54 (3/20/2008)"
371 sub applied_to_invoice {
373 'applied to '. $self->cust_bill->invnum_date_pretty;
376 =item lineitem_breakdown_table
380 sub lineitem_breakdown_table {
382 $self->_load_table($self->_app_lineitem_breakdown_table);
386 my( $self, $table ) = @_;
387 eval "use FS::$table";
398 L<FS::cust_bill_pay> and L<FS::cust_bill_pay_pkg>,
399 L<FS::cust_credit_bill> and L<FS::cust_credit_bill_pkg>