Bug 12168: fix spent and ordered budget values are wrong when depth >= 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.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Galen Charlton <gmc@esilibrary.com>

diff --git a/C4/Budgets.pm b/C4/Budgets.pm
index c0b6a2b..8dd572e 100644 (file)
--- a/C4/Budgets.pm
+++ b/C4/Budgets.pm
@@ -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);

diff --git a/admin/aqbudgets.pl b/admin/aqbudgets.pl
index a307448..7d97450 100755 (executable)
--- 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;