diff options
author | jeff <jeff> | 2009-10-26 07:12:12 +0000 |
---|---|---|
committer | jeff <jeff> | 2009-10-26 07:12:12 +0000 |
commit | 64fcb43c61c196766260319cd9219eb70ea27767 (patch) | |
tree | 43a4a49ae30ebf1e8662489139604a44626f53ec /FS | |
parent | 08ab7010467cf25578acdf8d9a9a068a87f1c49f (diff) |
credits return taxes, but the magic calculation button does not yet work properly (grrr - more sleep required) RT#4729
Diffstat (limited to 'FS')
-rw-r--r-- | FS/FS/Conf.pm | 14 | ||||
-rw-r--r-- | FS/FS/Schema.pm | 10 | ||||
-rw-r--r-- | FS/FS/cust_bill_ApplicationCommon.pm | 113 | ||||
-rw-r--r-- | FS/FS/cust_bill_pay_pkg.pm | 7 | ||||
-rw-r--r-- | FS/FS/cust_bill_pkg.pm | 18 | ||||
-rw-r--r-- | FS/FS/cust_bill_pkg_tax_location.pm | 74 | ||||
-rw-r--r-- | FS/FS/cust_bill_pkg_tax_rate_location.pm | 83 | ||||
-rw-r--r-- | FS/FS/cust_credit_bill_pkg.pm | 6 |
8 files changed, 301 insertions, 24 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 56dae5801..a57c4732b 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3223,6 +3223,20 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'cust_bill_pay_pkg-manual', + 'section' => 'UI', + 'description' => 'Allow manual application of payments to line items.', + 'type' => 'checkbox', + }, + + { + 'key' => 'cust_credit_bill_pkg-manual', + 'section' => 'UI', + 'description' => 'Allow manual application of credits to line items.', + 'type' => 'checkbox', + }, + { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index dfa33288d..2b0ea90a5 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -664,6 +664,8 @@ sub tables_hashref { 'creditbillpkgnum', 'serial', '', '', '', '', 'creditbillnum', 'int', '', '', '', '', 'billpkgnum', 'int', '', '', '', '', + 'billpkgtaxlocationnum', 'int', 'NULL', '', '', '', + 'billpkgtaxratelocationnum', 'int', 'NULL', '', '', '', 'amount', @money_type, '', '', 'setuprecur', 'varchar', '', $char_d, '', '', 'sdate', @date_type, '', '', @@ -671,7 +673,11 @@ sub tables_hashref { ], 'primary_key' => 'creditbillpkgnum', 'unique' => [], - 'index' => [ [ 'creditbillnum' ], [ 'billpkgnum' ], ], + 'index' => [ [ 'creditbillnum' ], + [ 'billpkgnum' ], + [ 'billpkgtaxlocationnum' ], + [ 'billpkgtaxratelocationnum' ], + ], }, 'cust_main' => { @@ -1076,6 +1082,8 @@ sub tables_hashref { 'billpaypkgnum', 'serial', '', '', '', '', 'billpaynum', 'int', '', '', '', '', 'billpkgnum', 'int', '', '', '', '', + 'billpkgtaxlocationnum', 'int', 'NULL', '', '', '', + 'billpkgtaxratelocationnum', 'int', 'NULL', '', '', '', 'amount', @money_type, '', '', 'setuprecur', 'varchar', '', $char_d, '', '', 'sdate', @date_type, '', '', diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index 7449679a8..7f564cd1e 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -112,8 +112,7 @@ Auto-applies this invoice application to specific line items, if possible. =cut -sub apply_to_lineitems { - #my $self = shift; +sub calculate_applications { my( $self, %options ) = @_; return '' if $skip_apply_to_lineitems_hack; @@ -122,29 +121,43 @@ sub apply_to_lineitems { my $conf = new FS::Conf; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; + my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...? - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; + if ( exists($options{subitems}) ) { + my $i = 0; + my %open = (); + $open{$_->billpkgnum} = $i++ foreach @open; + + foreach my $listref ( @{$options{subitems}} ) { + my ($billpkgnum, $itemamount, $taxlocationnum) = @$listref; + return "Can't apply a ". $self->_app_source_name. ' of $'. $listref->[1]. + " to line item $billpkgnum which is not open" + unless exists($open{$billpkgnum}); + my $itemindex = $open{$billpkgnum}; + my %taxhash = (); + if ($taxlocationnum) { + %taxhash = map { ($_->primary_key => $_->get($_->primary_key)) } + grep { $_->get($_->primary_key) == $taxlocationnum } + $open[$itemindex]->cust_bill_pkg_tax_Xlocation; + + return "No tax line item with a key value of $taxlocationnum exists" + unless scalar(%taxhash); + } + push @apply, [ $open[$itemindex], $itemamount, { %taxhash } ]; + } + return \@apply; + } - 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. ": ". join(', ', @open). "\n" if $DEBUG; my $total = 0; - $total += $_->setup + $_->recur foreach @open; + $total += $_->owed_setup + $_->owed_recur foreach @open; $total = sprintf('%.2f', $total); if ( $self->amount > $total ) { - $dbh->rollback if $oldAutoCommit; return "Can't apply a ". $self->_app_source_name. ' of $'. $self->amount. " greater than the remaining owed on line items (\$$total)"; } @@ -159,7 +172,7 @@ sub apply_to_lineitems { if $DEBUG; #@apply = map { [ $_, $_->amount ]; } @open; - @apply = map { [ $_, $_->setup || $_->recur ]; } @open; + @apply = map { [ $_, $_->owed_setup + 0 || $_->owed_recur + 0 ]; } @open; } else { @@ -167,8 +180,8 @@ sub apply_to_lineitems { # - amount exactly and uniquely matches a single open lineitem # (you must be trying to pay or credit that item, then) - my @same = grep { $_->setup == $self->amount - || $_->recur == $self->amount + my @same = grep { $_->owed_setup == $self->amount + || $_->owed_recur == $self->amount } @open; if ( scalar(@same) == 1 ) { @@ -213,7 +226,7 @@ sub apply_to_lineitems { my @items = map { $_->[0] } grep { $weight == $_->[1] } @openweight; my $itemtotal = 0; - foreach my $item (@items) { $itemtotal += $item->setup || $item->recur; } + foreach my $item (@items) { $itemtotal += $item->owed_setup + 0 || $item->owed_recur + 0; } my $applytotal = min( $itemtotal, $remaining_amount ); $remaining_amount -= $applytotal; @@ -234,7 +247,7 @@ sub apply_to_lineitems { my @newitems = (); foreach my $item ( @items ) { - my $itemamount = $item->setup || $item->recur; + my $itemamount = $item->owed_setup + 0 || $item->owed_recur + 0; if ( $itemamount < $applyeach ) { warn "$me applying full $itemamount". " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n" @@ -265,7 +278,6 @@ sub apply_to_lineitems { 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'; @@ -288,7 +300,6 @@ sub apply_to_lineitems { } if ( sprintf('%.0f', $diff ) ) { - $dbh->rollback if $oldAutoCommit; return "couldn't futz with pennies enough: still $diff left"; } @@ -308,12 +319,69 @@ sub apply_to_lineitems { } + # break down lineitem amounts for tax lines + # could expand @open above, instead, for a slightly different magic effect + my @result = (); + foreach my $apply ( @apply ) { + my @sub_lines = $apply->[0]->cust_bill_pkg_tax_Xlocation; + my $amount = $apply->[1]; + warn "applying ". $apply->[1]. " to ". $apply->[0]->desc + if $DEBUG; + + foreach my $subline ( @sub_lines ) { + my $owed = $subline->owed; + push @result, [ $apply->[0], + sprintf('%.2f', min($amount, $owed) ), + { $subline->primary_key => $subline->get($subline->primary_key) }, + ]; + $amount -= $owed; + $amount = 0 if $amount < 0; + last unless $amount; + } + if ( $amount > 0 ) { + push @result, [ $apply->[0], sprintf('%.2f', $amount), {} ]; + } + } + + \@result; + +} + +sub apply_to_lineitems { + #my $self = shift; + my( $self, %options ) = @_; + + return '' if $skip_apply_to_lineitems_hack; + + + + my $conf = new FS::Conf; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $listref_or_error = $self->calculate_applications(%options); + unless (ref($listref_or_error)) { + $dbh->rollback if $oldAutoCommit; + return $listref_or_error; + } + + my @apply = @$listref_or_error; + # do the applicaiton(s) my $table = $self->lineitem_breakdown_table; my $source_key = dbdef->table($self->table)->primary_key; my $applied = 0; foreach my $apply ( @apply ) { - my ( $cust_bill_pkg, $amount ) = @$apply; + my ( $cust_bill_pkg, $amount, $taxcreditref ) = @$apply; $applied += $amount; my $application = "FS::$table"->new( { $source_key => $self->$source_key(), @@ -322,6 +390,7 @@ sub apply_to_lineitems { 'setuprecur' => ( $cust_bill_pkg->setup > 0 ? 'setup' : 'recur' ), 'sdate' => $cust_bill_pkg->sdate, 'edate' => $cust_bill_pkg->edate, + %$taxcreditref, }); my $error = $application->insert(%options); if ( $error ) { diff --git a/FS/FS/cust_bill_pay_pkg.pm b/FS/FS/cust_bill_pay_pkg.pm index 639960f7d..eb2e80c78 100644 --- a/FS/FS/cust_bill_pay_pkg.pm +++ b/FS/FS/cust_bill_pay_pkg.pm @@ -149,6 +149,13 @@ sub check { $self->ut_numbern('billpaypkgnum') || $self->ut_foreign_key('billpaynum', 'cust_bill_pay', 'billpaynum' ) || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('billpkgtaxlocationnum', + 'cust_bill_pkg_tax_location', + 'billpkgtaxlocationnum') + || $self->ut_foreign_keyn('billpkgtaxratelocationnum', + 'cust_bill_pkg_tax_rate_location', + 'billpkgtaxratelocationnum') || $self->ut_money('amount') || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] ) || $self->ut_numbern('sdate') diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 2d32d3180..4058f1f38 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -780,6 +780,24 @@ sub _cust_tax_exempt_pkg { } +=item cust_bill_pkg_tax_Xlocation + +Returns the list of associated cust_bill_pkg_tax_location and/or +cust_bill_pkg_tax_rate_location objects + +=cut + +sub cust_bill_pkg_tax_Xlocation { + my $self = shift; + + my %hash = ( 'billpkgnum' => $self->billpkgnum ); + + ( + qsearch ( 'cust_bill_pkg_tax_location', { %hash } ), + qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } ) + ); + +} =back diff --git a/FS/FS/cust_bill_pkg_tax_location.pm b/FS/FS/cust_bill_pkg_tax_location.pm index db652370b..0d3bd3a32 100644 --- a/FS/FS/cust_bill_pkg_tax_location.pm +++ b/FS/FS/cust_bill_pkg_tax_location.pm @@ -6,6 +6,8 @@ use FS::Record qw( qsearch qsearchs ); use FS::cust_bill_pkg; use FS::cust_pkg; use FS::cust_location; +use FS::cust_bill_pay_pkg; +use FS::cust_credit_bill_pkg; =head1 NAME @@ -122,6 +124,78 @@ sub check { $self->SUPER::check; } +=item cust_bill_pkg + +Returns the associated cust_bill_pkg object + +=cut + +sub cust_bill_pkg { + my $self = shift; + qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ); +} + +=item cust_location + +Returns the associated cust_location object + +=cut + +sub cust_location { + my $self = shift; + qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } ); +} + +=item desc + +Returns a description for this tax line item constituent. Currently this +is the desc of the associated line item followed by the state/county/city +for the location in parentheses. + +=cut + +sub desc { + my $self = shift; + my $cust_location = $self->cust_location; + my $location = join('/', grep { $_ } # leave in? + map { $cust_location->$_ } + qw( state county city ) # country? + ); + $self->cust_bill_pkg->desc. " ($location)"; +} + +=item owed + +Returns the amount owed (still outstanding) on this tax line item which is +the amount of this record minus all payment applications and credit +applications. + +=cut + +sub owed { + my $self = shift; + my $balance = $self->amount; + $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg('setup') ); + $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg('setup') ); + $balance = sprintf( '%.2f', $balance ); + $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp + $balance; +} + +sub cust_bill_pay_pkg { + my $self = shift; + qsearch( 'cust_bill_pay_pkg', + { map { $_ => $self->$_ } qw( billpkgtaxlocationnum billpkgnum ) } + ); +} + +sub cust_credit_bill_pkg { + my $self = shift; + qsearch( 'cust_credit_bill_pkg', + { map { $_ => $self->$_ } qw( billpkgtaxlocationnum billpkgnum ) } + ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_bill_pkg_tax_rate_location.pm b/FS/FS/cust_bill_pkg_tax_rate_location.pm index fc5734fc1..89c252978 100644 --- a/FS/FS/cust_bill_pkg_tax_rate_location.pm +++ b/FS/FS/cust_bill_pkg_tax_rate_location.pm @@ -5,7 +5,9 @@ use base qw( FS::Record ); use FS::Record qw( qsearch qsearchs ); use FS::cust_bill_pkg; use FS::cust_pkg; -use FS::cust_location; +use FS::tax_rate_location; +use FS::cust_bill_pay_pkg; +use FS::cust_credit_bill_pkg; =head1 NAME @@ -122,6 +124,85 @@ sub check { $self->SUPER::check; } +=item cust_bill_pkg + +Returns the associated cust_bill_pkg object + +=cut + +sub cust_bill_pkg { + my $self = shift; + qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ); +} + +=item tax_rate_location + +Returns the associated tax_rate_location object + +=cut + +sub tax_rate_location { + my $self = shift; + qsearchs( 'tax_rate_location', + { 'taxratelocationnum' => $self->taxratelocationnum } + ); +} + +=item desc + +Returns a description for this tax line item constituent. Currently this +is the desc of the associated line item followed by the +state,county,city,locationtaxid for the location in parentheses. + +=cut + +sub desc { + my $self = shift; + my $tax_rate_location = $self->tax_rate_location; + my $location = join(', ', grep { $_ } + map { $tax_rate_location->$_ } + qw( state county city ) + ); + $location .= ( $location && $self->locationtaxid ) ? ', ' : ''; + $location .= $self->locationtaxid; + $self->cust_bill_pkg->desc. " ($location)"; +} + + +=item owed + +Returns the amount owed (still outstanding) on this tax line item which is +the amount of this record minus all payment applications and credit +applications. + +=cut + +sub owed { + my $self = shift; + my $balance = $self->amount; + $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg('setup') ); + $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg('setup') ); + $balance = sprintf( '%.2f', $balance ); + $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp + $balance; +} + +sub cust_bill_pay_pkg { + my $self = shift; + qsearch( 'cust_bill_pay_pkg', { map { $_ => $self->$_ } + qw( billpkgtaxratelocationnum billpkgnum ) + } + ); +} + +sub cust_credit_bill_pkg { + my $self = shift; + qsearch( 'cust_credit_bill_pkg', { map { $_ => $self->$_ } + qw( billpkgtaxratelocationnum billpkgnum ) + } + ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm index 7252be537..543a71f8f 100644 --- a/FS/FS/cust_credit_bill_pkg.pm +++ b/FS/FS/cust_credit_bill_pkg.pm @@ -114,6 +114,12 @@ sub check { $self->ut_numbern('creditbillpkgnum') || $self->ut_foreign_key('creditbillnum', 'cust_credit_bill', 'creditbillnum') || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) + || $self->ut_foreign_keyn('billpkgtaxlocationnum', + 'cust_bill_pkg_tax_location', + 'billpkgtaxlocationnum') + || $self->ut_foreign_keyn('billpkgtaxratelocationnum', + 'cust_bill_pkg_tax_rate_location', + 'billpkgtaxratelocationnum') || $self->ut_money('amount') || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] ) || $self->ut_numbern('sdate') |