[freeside-commits] freeside/FS/FS Conf.pm, 1.328, 1.329 Schema.pm, 1.172, 1.173 cust_bill_ApplicationCommon.pm, 1.13, 1.14 cust_bill_pay_pkg.pm, 1.4, 1.5 cust_bill_pkg.pm, 1.43, 1.44 cust_bill_pkg_tax_location.pm, 1.2, 1.3 cust_bill_pkg_tax_rate_location.pm, 1.1, 1.2 cust_credit_bill_pkg.pm, 1.2, 1.3
Jeff Finucane,420,,
jeff at wavetail.420.am
Mon Oct 26 00:12:13 PDT 2009
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv23012/FS/FS
Modified Files:
Conf.pm Schema.pm cust_bill_ApplicationCommon.pm
cust_bill_pay_pkg.pm cust_bill_pkg.pm
cust_bill_pkg_tax_location.pm
cust_bill_pkg_tax_rate_location.pm cust_credit_bill_pkg.pm
Log Message:
credits return taxes, but the magic calculation button does not yet work properly (grrr - more sleep required) RT#4729
Index: cust_credit_bill_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit_bill_pkg.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- cust_credit_bill_pkg.pm 15 Sep 2006 05:10:36 -0000 1.2
+++ cust_credit_bill_pkg.pm 26 Oct 2009 07:12:11 -0000 1.3
@@ -114,6 +114,12 @@
$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')
Index: cust_bill_pay_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_pay_pkg.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- cust_bill_pay_pkg.pm 20 Oct 2009 23:24:03 -0000 1.4
+++ cust_bill_pay_pkg.pm 26 Oct 2009 07:12:11 -0000 1.5
@@ -149,6 +149,13 @@
$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')
Index: cust_bill_pkg_tax_rate_location.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_pkg_tax_rate_location.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- cust_bill_pkg_tax_rate_location.pm 13 May 2009 22:27:41 -0000 1.1
+++ cust_bill_pkg_tax_rate_location.pm 26 Oct 2009 07:12:11 -0000 1.2
@@ -5,7 +5,9 @@
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 @@
$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
Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.328
retrieving revision 1.329
diff -u -d -r1.328 -r1.329
--- Conf.pm 24 Oct 2009 23:37:42 -0000 1.328
+++ Conf.pm 26 Oct 2009 07:12:10 -0000 1.329
@@ -3223,6 +3223,20 @@
'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" },
Index: cust_bill_ApplicationCommon.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_ApplicationCommon.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- cust_bill_ApplicationCommon.pm 21 Sep 2009 02:41:43 -0000 1.13
+++ cust_bill_ApplicationCommon.pm 26 Oct 2009 07:12:11 -0000 1.14
@@ -112,8 +112,7 @@
=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 @@
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 @@
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 @@
# - 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 @@
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 @@
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 @@
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 @@
}
if ( sprintf('%.0f', $diff ) ) {
- $dbh->rollback if $oldAutoCommit;
return "couldn't futz with pennies enough: still $diff left";
}
@@ -308,12 +319,69 @@
}
+ # 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 @@
'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 ) {
Index: cust_bill_pkg_tax_location.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_pkg_tax_location.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- cust_bill_pkg_tax_location.pm 21 Jan 2009 00:52:54 -0000 1.2
+++ cust_bill_pkg_tax_location.pm 26 Oct 2009 07:12:11 -0000 1.3
@@ -6,6 +6,8 @@
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 @@
$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
Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.172
retrieving revision 1.173
diff -u -d -r1.172 -r1.173
--- Schema.pm 22 Oct 2009 12:50:04 -0000 1.172
+++ Schema.pm 26 Oct 2009 07:12:11 -0000 1.173
@@ -664,6 +664,8 @@
'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 @@
],
'primary_key' => 'creditbillpkgnum',
'unique' => [],
- 'index' => [ [ 'creditbillnum' ], [ 'billpkgnum' ], ],
+ 'index' => [ [ 'creditbillnum' ],
+ [ 'billpkgnum' ],
+ [ 'billpkgtaxlocationnum' ],
+ [ 'billpkgtaxratelocationnum' ],
+ ],
},
'cust_main' => {
@@ -1076,6 +1082,8 @@
'billpaypkgnum', 'serial', '', '', '', '',
'billpaynum', 'int', '', '', '', '',
'billpkgnum', 'int', '', '', '', '',
+ 'billpkgtaxlocationnum', 'int', 'NULL', '', '', '',
+ 'billpkgtaxratelocationnum', 'int', 'NULL', '', '', '',
'amount', @money_type, '', '',
'setuprecur', 'varchar', '', $char_d, '', '',
'sdate', @date_type, '', '',
Index: cust_bill_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_pkg.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- cust_bill_pkg.pm 16 Oct 2009 22:39:02 -0000 1.43
+++ cust_bill_pkg.pm 26 Oct 2009 07:12:11 -0000 1.44
@@ -780,6 +780,24 @@
}
+=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
More information about the freeside-commits
mailing list