@@ -, +, @@ - Move the budget period clone logic into C4::Budgets The code is moved from the pl to Budgets.pm and unit tests are provided. The original code should certainly be buggy since a typo existed. - On cloning budget period, mark original budget as inactive Cloning a budget period is already possible in Koha, this patch adds a checkbox to mark as inactive the original budget. That avoids to edit the budget and click the "inactive" checkbox. Both do the same action. - On cloning budget periods, add a "reset all funds" option Same as before, a new checkbox is added on cloning a budget period. If you check it, all fund amounts will be set to 0. Otherwise, no change compared to the existing behavior. - Close a budget period (budget) The goal of this patch set is to move unreceived orders from a budget to another. This patch adds a C4::Budgets::MoveOrders routine which does this job. This action is only possible if the fund structure is the same for both budgets, the budget_code field should be the same. - On closing budget period, move unspent amount Unspent amount will be move from the previous budget structure to the new one. - Add UI report This patch only adds a report when closing a budget is done. --- C4/Acquisition.pm | 6 ++ C4/Budgets.pm | 78 +++++++++++++++++ admin/aqbudgetperiods.pl | 50 ++++++++++- .../prog/en/modules/admin/aqbudgetperiods.tt | 91 +++++++++++++++++++- t/db_dependent/Budgets.t | 56 +++++++++++- 5 files changed, 276 insertions(+), 5 deletions(-) --- a/C4/Acquisition.pm +++ a/C4/Acquisition.pm @@ -1723,6 +1723,7 @@ sub SearchOrders { my $owner = $params->{owner}; my $pending = $params->{pending}; my $ordered = $params->{ordered}; + my $budget_id = $params->{budget_id}; my $dbh = C4::Context->dbh; my @args = (); @@ -1812,6 +1813,11 @@ sub SearchOrders { push @args, $userenv->{'number'}; } + if ( $budget_id ) { + $query .= ' AND aqorders.budget_id = ?'; + push @args, $budget_id; + } + $query .= ' ORDER BY aqbasket.basketno'; my $sth = $dbh->prepare($query); --- a/C4/Budgets.pm +++ a/C4/Budgets.pm @@ -1013,6 +1013,8 @@ sub CloneBudgetPeriod { $budget_period->{budget_period_startdate} = $budget_period_startdate; $budget_period->{budget_period_enddate} = $budget_period_enddate; + # The new budget (budget_period) should be active by default + $budget_period->{budget_period_active} = 1; my $original_budget_period_id = $budget_period->{budget_period_id}; delete $budget_period->{budget_period_id}; my $new_budget_period_id = AddBudgetPeriod( $budget_period ); @@ -1092,6 +1094,82 @@ sub CloneBudgetHierarchy { } } +=head2 MoveOrders + + my $report = MoveOrders({ + from_budget_period_id => $from_budget_period_id, + to_budget_period_id => $to_budget_period_id, + }); + +Clone a budget hierarchy. + +=cut + +sub MoveOrders { + my ($params) = @_; + my $from_budget_period_id = $params->{from_budget_period_id}; + my $to_budget_period_id = $params->{to_budget_period_id}; + return + if not $from_budget_period_id + or not $to_budget_period_id + or $from_budget_period_id == $to_budget_period_id; + + # Can't move orders to an inactive budget (budgetperiod) + my $budget_period = GetBudgetPeriod($to_budget_period_id); + return unless $budget_period->{budget_period_active}; + + my @report; + my $dbh = C4::Context->dbh; + my $sth_update_aqorders = $dbh->prepare( + q| + UPDATE aqorders + SET budget_id = ? + WHERE ordernumber = ? + | + ); + my $from_budgets = GetBudgetHierarchy($from_budget_period_id); + for my $from_budget (@$from_budgets) { + my $new_budget_id = $dbh->selectcol_arrayref( + q| + SELECT budget_id + FROM aqbudgets + WHERE budget_period_id = ? + AND budget_code = ? + |, {}, $to_budget_period_id, $from_budget->{budget_code} + ); + $new_budget_id = $new_budget_id->[0]; + my $new_budget = GetBudget( $new_budget_id ); + unless ( $new_budget ) { + push @report, + { + moved => 0, + budget_code => $from_budget->{budget_code}, + error => 'budget_code_not_exists', + }; + next; + } + my $orders_to_move = C4::Acquisition::SearchOrders( + { + budget_id => $from_budget->{budget_id}, + pending => 1, + } + ); + + 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 @report, + { + budget => $new_budget, + orders_moved => \@orders_moved, + moved => 1, + }; + } + return \@report; +} END { } # module clean-up code here (global destructor) --- a/admin/aqbudgetperiods.pl +++ a/admin/aqbudgetperiods.pl @@ -45,8 +45,7 @@ script to administer the budget periods table =cut ## modules -use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; use Number::Format qw(format_price); use CGI; use List::Util qw/min/; @@ -202,6 +201,53 @@ elsif ( $op eq 'duplicate_budget' ){ $op = 'else'; } +elsif ( $op eq 'close_form' ) { + + my $budget_period = GetBudgetPeriod($budget_period_id); + + my $active_budget_periods = + C4::Budgets::GetBudgetPeriods( { active => 1 } ); + + # Remove the budget period from the list + $active_budget_periods = + [ map { ( $_->{budget_period_id} == $budget_period_id ) ? () : $_ } + @$active_budget_periods ]; + + my $budgets_to_move = GetBudgetHierarchy($budget_period_id); + + # C4::Context->userenv->{branchcode}, $show_mine ? $borrower_id : '') + + my $number_of_unreceived_orders = 0; + for my $budget (@$budgets_to_move) { + + # We want to move funds from this budget + my $unreceived_orders = C4::Acquisition::SearchOrders( + { budget_id => $budget->{budget_id}, } ); + $budget->{unreceived_orders} = $unreceived_orders; + $number_of_unreceived_orders += scalar(@$unreceived_orders); + } + + $template->param( + close_form => 1, + budget_period_id => $budget_period_id, + budget_period_description => + $budget_period->{budget_period_description}, + budget_periods => $active_budget_periods, + budgets_to_move => $budgets_to_move, + number_of_unreceived_orders => $number_of_unreceived_orders, + ); +} + +elsif ( $op eq 'close_confirmed' ) { + my $to_budget_period_id = $input->param('to_budget_period_id'); + my $report = C4::Budgets::MoveOrders( + { + from_budget_period_id => $budget_period_id, + to_budget_period_id => $to_budget_period_id, + } + ); +} + # DEFAULT - DISPLAY AQPERIODS TABLE # ------------------------------------------------------------------- # display the list of budget periods --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt @@ -4,6 +4,10 @@ [% INCLUDE 'doc-head-close.inc' %] [% INCLUDE 'calendar.inc' %] [% INCLUDE 'datatables.inc' %] +[% IF close_form %] + + +[% END %] @@ -106,6 +124,9 @@ [% IF ( delete_confirmed ) %]› Data deleted [% END %] + [% IF close_form %]› + Close budget [% budget_period_description %] + [% END %] @@ -150,6 +171,12 @@ [% IF ( duplicate_form ) %] Budgets › Duplicate budget [% END %] + + + [% IF close_form %] + Budgets › + Close budget [% budget_period_description %] + [% END %] [% IF ( else ) %] @@ -162,7 +189,9 @@
-[% INCLUDE 'budgets-admin-toolbar.inc' %] +[% UNLESS close_form %] + [% INCLUDE 'budgets-admin-toolbar.inc' %] +[% END %] [% IF ( duplicate_form ) %]

Duplicate budget

@@ -309,6 +338,62 @@
[% END %] + +[% IF close_form %] + [% IF budget_periods.size == 0 %] + You cannot move funds of this budget, there is no active budget. + Please create a new active budget and retry. + Back + [% ELSIF number_of_unreceived_orders == 0 %] + There is no unreceived orders for this budget. + Back + [% ELSE %] +

Choose the funds you want to move unreceived orders:

+ Fund list of budget [% budget_period_description %]: + + + + + + + + + + + [% FOREACH budget IN budgets_to_move %] + + + + + + + [% END %] + +
Fund idFund codeFund nameUnreceived orders
[% budget.budget_id %][% budget.budget_code_indent %][% budget.budget_name %][% budget.unreceived_orders.size %]
+
+
+
    +
  1. + + +
  2. +
+
+
+ + + + Cancel +
+
+ [% END %] +[% END %] + [% IF ( else ) %]

Budgets administration

@@ -350,6 +435,7 @@ Edit Delete Duplicate + Close Add fund @@ -390,6 +476,7 @@ Edit Delete Duplicate + Close Add fund --- a/t/db_dependent/Budgets.t +++ a/t/db_dependent/Budgets.t @@ -1,5 +1,5 @@ use Modern::Perl; -use Test::More tests => 31; +use Test::More tests => 37; BEGIN {use_ok('C4::Budgets') } use C4::Biblio; @@ -16,6 +16,12 @@ $dbh->{RaiseError} = 1; $dbh->do('DELETE FROM aqbudgetperiods'); +# Mock userenv +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /redefined/ }; +my $userenv; +*C4::Context::userenv = \&Mock_userenv; +$userenv = { flags => 1, id => 'my_userid', branch => 'CPL' }; + # # Budget Periods : # @@ -258,6 +264,7 @@ my %budgets; my $invoiceid = AddInvoice(invoicenumber => 'invoice_test_clone', booksellerid => $booksellerid, unknown => "unknown"); my $item_price = 10; my $item_quantity = 2; +my $number_of_orders_to_move = 0; for my $infos (@order_infos) { for ( 1 .. $infos->{pending_quantity} ) { my ( undef, $ordernumber ) = C4::Acquisition::NewOrder( @@ -279,6 +286,7 @@ for my $infos (@order_infos) { } ); push @{ $budgets{$infos->{budget_id}} }, $ordernumber; + $number_of_orders_to_move++; } for ( 1 .. $infos->{spent_quantity} ) { my ( undef, $ordernumber ) = C4::Acquisition::NewOrder( @@ -397,6 +405,47 @@ is( $number_of_budgets_not_reset, 0, 'CloneBudgetPeriod has reset all budgets (funds)' ); +# MoveOrders +my $number_orders_moved = C4::Budgets::MoveOrders(); +is( $number_orders_moved, undef, 'MoveOrders return undef if no arg passed' ); +$number_orders_moved = + C4::Budgets::MoveOrders( { from_budget_period_id => $budget_period_id } ); +is( $number_orders_moved, undef, + 'MoveOrders return undef if only 1 arg passed' ); +$number_orders_moved = + C4::Budgets::MoveOrders( { to_budget_period_id => $budget_period_id } ); +is( $number_orders_moved, undef, + 'MoveOrders return undef if only 1 arg passed' ); +$number_orders_moved = C4::Budgets::MoveOrders( + { + from_budget_period_id => $budget_period_id, + to_budget_period_id => $budget_period_id + } +); +is( $number_orders_moved, undef, + 'MoveOrders return undef if 2 budget period id are the same' ); + +$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, + } +); +is( scalar( @$report ), 6 , "MoveOrders has processed 6 funds" ); + +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" ); + sub _get_dependencies { my ($budget_hierarchy) = @_; my $graph; @@ -421,3 +470,8 @@ sub _get_budgetname_by_id { @$budgets; return $budget_name; } + +# C4::Context->userenv +sub Mock_userenv { + return $userenv; +} --