Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 12168: fix spent and ordered budget values are wrong when depth >= 2

Browse source 
A really weird (and old) code process the calculation for the spent and
ordered sublevel funds.

It only takes into account the direct children.

So if you have:
fund1 (spent=100) parent of fund11 (spent=10) parent of fund111 (spent=1),
you get:

fund     | base-level | total spent
fund1    | 100        | 110
fund11   | 10         | 11
fund111  | 1          | 1

which is wrong, it should be

fund     | base-level | total spent
fund1    | 100        | 111
fund11   | 10         | 11
fund111  | 1          | 1

Test plan:
- Create 1 budget and 3 funds with the same structure as above.
- Create some orders and receive them (not all).
- Go on the fund list view and verify the values are correct.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Galen Charlton <gmc@esilibrary.com>
This commit is contained in:
Jonathan Druart 2014-05-01 14:12:18 +02:00 committed by Galen Charlton
parent 2c5f927689
commit 75f00c3e30
2 changed files with 45 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

89
C4/Budgets.pm
View file

@ -45,7 +45,8 @@ BEGIN {
&GetBudgetOrdered
&GetBudgetName
&GetPeriodsCount
&GetChildBudgetsSpent
GetBudgetHierarchySpent
GetBudgetHierarchyOrdered
&GetBudgetUsers
&ModBudgetUsers
@ -555,35 +556,14 @@ sub GetBudgetHierarchy {
last if $children == 0;
}
# add budget-percent and allocation, and flags for html-template
foreach my $r (@sort) {
my $subs_href = $r->{'child'};
my @subs_arr = ();
if ( defined $subs_href ) {
@subs_arr = @{$subs_href};
}
my $moo = $r->{'budget_code_indent'};
$moo =~ s/\ /\&nbsp\;/g;
$r->{'budget_code_indent'} = $moo;
$moo = $r->{'budget_name_indent'};
$moo =~ s/\ /\&nbsp\;/g;
$r->{'budget_name_indent'} = $moo;
$r->{'budget_spent'} = GetBudgetSpent( $r->{'budget_id'} );
$r->{budget_ordered} = GetBudgetOrdered( $r->{budget_id} );
$r->{budget_spent_sublevels} = 0;
$r->{budget_ordered_sublevels} = 0;
# foreach sub-levels
foreach my $sub (@subs_arr) {
my $sub_budget = GetBudget($sub);
$r->{budget_spent_sublevels} += GetBudgetSpent( $sub_budget->{'budget_id'} );
$r->{budget_ordered_sublevels} += GetBudgetOrdered($sub);
}
}
return \@sort;
foreach my $budget (@sort) {
$budget->{budget_spent} = GetBudgetSpent( $budget->{budget_id} );
$budget->{budget_ordered} = GetBudgetOrdered( $budget->{budget_id} );
$budget->{total_spent} = GetBudgetHierarchySpent( $budget->{budget_id} );
$budget->{total_ordered} = GetBudgetHierarchyOrdered( $budget->{budget_id} );
}
return \@sort;
}
# -------------------------------------------------------------------
@ -681,33 +661,54 @@ sub GetBudgetByCode {
return $sth->fetchrow_hashref;
}
=head2 GetChildBudgetsSpent
=head2 GetBudgetHierarchySpent
&GetChildBudgetsSpent($budget-id);
my $spent = GetBudgetHierarchySpent( $budget_id );
gets the total spent of the level and sublevels of $budget_id
Gets the total spent of the level and sublevels of $budget_id
=cut
# -------------------------------------------------------------------
sub GetChildBudgetsSpent {
sub GetBudgetHierarchySpent {
my ( $budget_id ) = @_;
my $dbh = C4::Context->dbh;
my $query = "
SELECT *
my $children_ids = $dbh->selectcol_arrayref(q|
SELECT budget_id
FROM aqbudgets
WHERE budget_parent_id=?
";
my $sth = $dbh->prepare($query);
$sth->execute( $budget_id );
my $result = $sth->fetchall_arrayref({});
my $total_spent = GetBudgetSpent($budget_id);
if ($result){
$total_spent += GetChildBudgetsSpent($_->{"budget_id"}) foreach @$result;
WHERE budget_parent_id = ?
|, {}, $budget_id );
my $total_spent = GetBudgetSpent( $budget_id );
for my $child_id ( @$children_ids ) {
$total_spent += GetBudgetHierarchySpent( $child_id );
}
return $total_spent;
}
=head2 GetBudgetHierarchyOrdered
my $ordered = GetBudgetHierarchyOrdered( $budget_id );
Gets the total ordered of the level and sublevels of $budget_id
=cut
sub GetBudgetHierarchyOrdered {
my ( $budget_id ) = @_;
my $dbh = C4::Context->dbh;
my $children_ids = $dbh->selectcol_arrayref(q|
SELECT budget_id
FROM aqbudgets
WHERE budget_parent_id = ?
|, {}, $budget_id );
my $total_ordered = GetBudgetOrdered( $budget_id );
for my $child_id ( @$children_ids ) {
$total_ordered += GetBudgetHierarchyOrdered( $child_id );
}
return $total_ordered;
}
=head2 GetBudgets
&GetBudgets($filter, $order_by);

3
admin/aqbudgets.pl
View file

@ -273,9 +273,6 @@ if ( $op eq 'list' ) {
#This Looks WEIRD to me : should budgets be filtered in such a way ppl who donot own it would not see the amount spent on the budget by others ?
foreach my $budget (@budgets) {
#Level and sublevels total spent and ordered
$budget->{total_spent} = $budget->{budget_spent_sublevels} + $budget->{budget_spent};
$budget->{total_ordered} = $budget->{budget_ordered_sublevels} + $budget->{budget_ordered};
# PERMISSIONS
unless(CanUserModifyBudget($borrowernumber, $budget, $staffflags)) {
$budget->{'budget_lock'} = 1;