From 10cf575142b6a030e51d4133804a7bc3f83fca5f Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Thu, 1 May 2014 14:12:18 +0200 Subject: [PATCH] Bug 12168: Spent and ordered budget values are wrong if deep > 2 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. --- C4/Budgets.pm | 89 ++++++++++++++++++++++++++-------------------------- admin/aqbudgets.pl | 3 -- 2 files changed, 45 insertions(+), 47 deletions(-) diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 7236a06..d7d61c8 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -44,7 +44,8 @@ BEGIN { &GetBudgetOrdered &GetBudgetName &GetPeriodsCount - &GetChildBudgetsSpent + GetBudgetHierarchySpent + GetBudgetHierarchyOrdered &GetBudgetUsers &ModBudgetUsers @@ -594,35 +595,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/\ /\ \;/g; - $r->{'budget_code_indent'} = $moo; - - $moo = $r->{'budget_name_indent'}; - $moo =~ s/\ /\ \;/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; } # ------------------------------------------------------------------- @@ -695,33 +675,54 @@ sub GetBudgetByOrderNumber { return $result; } -=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); diff --git a/admin/aqbudgets.pl b/admin/aqbudgets.pl index a307448..7d97450 100755 --- a/admin/aqbudgets.pl +++ b/admin/aqbudgets.pl @@ -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; -- 1.7.10.4