From 0c875c516f4d5b5d3b3d66e3b2694b00c492f82a Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 2 Jun 2014 10:19:58 +0200 Subject: [PATCH] [PASSED QA] 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 --- 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 9e8245d..b9e4946 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -1117,6 +1117,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 @@ -1135,6 +1136,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( @@ -1151,7 +1159,7 @@ sub MoveOrders { push @report, { moved => 0, - budget_code => $from_budget->{budget_code}, + budget => $from_budget, error => 'budget_code_not_exists', }; next; @@ -1166,14 +1174,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 e342b8c..17350ff 100755 --- a/admin/aqbudgetperiods.pl +++ b/admin/aqbudgetperiods.pl @@ -222,7 +222,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); } @@ -239,11 +242,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 8904659..5161152 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 669b4ce..caaab63 100755 --- a/t/db_dependent/Budgets.t +++ b/t/db_dependent/Budgets.t @@ -1,5 +1,5 @@ use Modern::Perl; -use Test::More tests => 39; +use Test::More tests => 69; BEGIN {use_ok('C4::Budgets') } use C4::Context; @@ -435,14 +435,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" ); @@ -451,6 +451,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; -- 1.9.1