From 986b8c92620580166ab408362f72ce52d045d92c Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 2 Jun 2014 10:19:58 +0200 Subject: [PATCH] Bug 12164: On closing budget period, move unspent amount On closing a budget (budget period), the user will be presented with an option to move remaining unspent funds from the previous budget to the newly created one - adding to the amounts already entered in those funds. Signed-off-by: Paola Rossi Signed-off-by: Katrin Fischer Signed-off-by: Tomas Cohen Arazi --- C4/Budgets.pm | 29 ++++++++++++++-- admin/aqbudgetperiods.pl | 15 ++++++--- .../prog/en/modules/admin/aqbudgetperiods.tt | 4 +++ t/db_dependent/Budgets.t | 33 ++++++++++++++++--- 4 files changed, 69 insertions(+), 12 deletions(-) diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 075cef7b6f..3ac8ba98ce 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -1144,6 +1144,7 @@ sub MoveOrders { my ($params) = @_; my $from_budget_period_id = $params->{from_budget_period_id}; my $to_budget_period_id = $params->{to_budget_period_id}; + my $move_remaining_unspent = $params->{move_remaining_unspent}; return if not $from_budget_period_id or not $to_budget_period_id @@ -1162,6 +1163,13 @@ sub MoveOrders { WHERE ordernumber = ? | ); + my $sth_update_budget_amount = $dbh->prepare( + q| + UPDATE aqbudgets + SET budget_amount = ? + WHERE budget_id = ? + | + ); my $from_budgets = GetBudgetHierarchy($from_budget_period_id); for my $from_budget (@$from_budgets) { my $new_budget_id = $dbh->selectcol_arrayref( @@ -1178,7 +1186,7 @@ sub MoveOrders { push @report, { moved => 0, - budget_code => $from_budget->{budget_code}, + budget => $from_budget, error => 'budget_code_not_exists', }; next; @@ -1193,14 +1201,29 @@ sub MoveOrders { my @orders_moved; for my $order (@$orders_to_move) { $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} ); - push @orders_moved, $order->{ordernumber}; + push @orders_moved, $order; + } + + my $unspent_moved = 0; + if ($move_remaining_unspent) { + my $spent = GetBudgetHierarchySpent( $from_budget->{budget_id} ); + my $unspent = $from_budget->{budget_amount} - $spent; + my $new_budget_amount = $new_budget->{budget_amount}; + if ( $unspent > 0 ) { + $new_budget_amount += $unspent; + $unspent_moved = $unspent; + } + $new_budget->{budget_amount} = $new_budget_amount; + $sth_update_budget_amount->execute( $new_budget_amount, + $new_budget->{budget_id} ); } push @report, { - budget => $new_budget, + budget => $new_budget, orders_moved => \@orders_moved, moved => 1, + unspent_moved => $unspent_moved, }; } return \@report; diff --git a/admin/aqbudgetperiods.pl b/admin/aqbudgetperiods.pl index 8ab29ecfbc..5034a58a4b 100755 --- a/admin/aqbudgetperiods.pl +++ b/admin/aqbudgetperiods.pl @@ -227,7 +227,10 @@ elsif ( $op eq 'close_form' ) { # We want to move funds from this budget my $unreceived_orders = C4::Acquisition::SearchOrders( - { budget_id => $budget->{budget_id}, } ); + { + budget_id => $budget->{budget_id}, + } + ); $budget->{unreceived_orders} = $unreceived_orders; $number_of_unreceived_orders += scalar(@$unreceived_orders); } @@ -244,11 +247,13 @@ elsif ( $op eq 'close_form' ) { } elsif ( $op eq 'close_confirmed' ) { - my $to_budget_period_id = $input->param('to_budget_period_id'); - my $report = C4::Budgets::MoveOrders( + my $to_budget_period_id = $input->param('to_budget_period_id'); + my $move_remaining_unspent = $input->param('move_remaining_unspent'); + my $report = C4::Budgets::MoveOrders( { - from_budget_period_id => $budget_period_id, - to_budget_period_id => $to_budget_period_id, + from_budget_period_id => $budget_period_id, + to_budget_period_id => $to_budget_period_id, + move_remaining_unspent => $move_remaining_unspent, } ); } diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt index 8904659090..516115276d 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt @@ -382,6 +382,10 @@ [% END %] +
  • + + +
    • diff --git a/t/db_dependent/Budgets.t b/t/db_dependent/Budgets.t index 5a22315716..a565c8d32d 100755 --- a/t/db_dependent/Budgets.t +++ b/t/db_dependent/Budgets.t @@ -1,5 +1,5 @@ use Modern::Perl; -use Test::More tests => 77; +use Test::More tests => 107; BEGIN { use_ok('C4::Budgets') @@ -467,14 +467,14 @@ $budget_period_id_cloned = C4::Budgets::CloneBudgetPeriod( budget_period_id => $budget_period_id, budget_period_startdate => '2014-01-01', budget_period_enddate => '2014-12-31', - reset_all_funds => 1, } ); my $report = C4::Budgets::MoveOrders( { - from_budget_period_id => $budget_period_id, - to_budget_period_id => $budget_period_id_cloned, + from_budget_period_id => $budget_period_id, + to_budget_period_id => $budget_period_id_cloned, + move_remaining_unspent => 1, } ); is( scalar( @$report ), 6 , "MoveOrders has processed 6 funds" ); @@ -483,6 +483,31 @@ my $number_of_orders_moved = 0; $number_of_orders_moved += scalar( @{ $_->{orders_moved} } ) for @$report; is( $number_of_orders_moved, $number_of_orders_to_move, "MoveOrders has moved $number_of_orders_to_move orders" ); +my @new_budget_ids = map { $_->{budget_id} } + @{ C4::Budgets::GetBudgetHierarchy($budget_period_id_cloned) }; +my @old_budget_ids = map { $_->{budget_id} } + @{ C4::Budgets::GetBudgetHierarchy($budget_period_id) }; +for my $budget_id ( keys %budgets ) { + for my $ordernumber ( @{ $budgets{$budget_id} } ) { + my $budget = GetBudgetByOrderNumber($ordernumber); + my $is_in_new_budgets = grep /^$budget->{budget_id}$/, @new_budget_ids; + my $is_in_old_budgets = grep /^$budget->{budget_id}$/, @old_budget_ids; + is( $is_in_new_budgets, 1, "MoveOrders changed the budget_id for order $ordernumber" ); + is( $is_in_old_budgets, 0, "MoveOrders changed the budget_id for order $ordernumber" ); + } +} + + +# MoveOrders with param move_remaining_unspent +my @new_budgets = @{ C4::Budgets::GetBudgetHierarchy($budget_period_id_cloned) }; +my @old_budgets = @{ C4::Budgets::GetBudgetHierarchy($budget_period_id) }; + +for my $new_budget ( @new_budgets ) { + my ( $old_budget ) = map { $_->{budget_code} eq $new_budget->{budget_code} ? $_ : () } @old_budgets; + my $new_budget_amount_should_be = $old_budget->{budget_amount} * 2 - $old_budget->{total_spent}; + is( $new_budget->{budget_amount} + 0, $new_budget_amount_should_be, "MoveOrders updated the budget amount with the previous unspent budget (for budget $new_budget->{budget_code})" ); +} + sub _get_dependencies { my ($budget_hierarchy) = @_; my $graph;