X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=9c50bda420926d747302f8e9cdfda6d2f66a9392;hb=8637627dc9c99b2f1e47b4748c7e4360dbaac5f1;hp=7c867e0aabdea5a5a3170845bfd3b4635e1c71d2;hpb=c8df6bdcc9fe2523a77c839270b31304d8e13ee5;p=koha.git diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 7c867e0aab..9c50bda420 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -4,36 +4,36 @@ package C4::Budgets; # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . use strict; #use warnings; FIXME - Bug 2505 use C4::Context; -use C4::Dates qw(format_date format_date_in_iso); -use C4::SQLHelper qw<:all>; +use Koha::Database; use C4::Debug; - use vars qw($VERSION @ISA @EXPORT); BEGIN { # set the version for version checking - $VERSION = 3.01; + $VERSION = 3.07.00.049; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( &GetBudget + &GetBudgetByOrderNumber + &GetBudgetByCode &GetBudgets &GetBudgetHierarchy &AddBudget @@ -41,8 +41,15 @@ BEGIN { &DelBudget &GetBudgetSpent &GetBudgetOrdered + &GetBudgetName &GetPeriodsCount - &GetChildBudgetsSpent + GetBudgetHierarchySpent + GetBudgetHierarchyOrdered + + &GetBudgetUsers + &ModBudgetUsers + &CanUserUseBudget + &CanUserModifyBudget &GetBudgetPeriod &GetBudgetPeriods @@ -50,15 +57,8 @@ BEGIN { &AddBudgetPeriod &DelBudgetPeriod - &GetAuthvalueDropbox - &ModBudgetPlan - &GetCurrency - &GetCurrencies - &ModCurrencies - &ConvertCurrency - &GetBudgetsPlanCell &AddBudgetPlanValue &GetBudgetAuthCats @@ -130,7 +130,10 @@ sub CheckBudgetParentPerm { sub AddBudgetPeriod { my ($budgetperiod) = @_; - return InsertInTable("aqbudgetperiods",$budgetperiod); + return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate}); + + my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod'); + return $resultset->create($budgetperiod)->id; } # ------------------------------------------------------------------- sub GetPeriodsCount { @@ -179,6 +182,27 @@ sub BudgetHasChildren { return $sum->{'sum'}; } +sub GetBudgetChildren { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + return $dbh->selectall_arrayref(q| + SELECT * FROM aqbudgets + WHERE budget_parent_id = ? + |, { Slice => {} }, $budget_id ); +} + +sub SetOwnerToFundHierarchy { + my ( $budget_id, $borrowernumber ) = @_; + + my $budget = GetBudget( $budget_id ); + $budget->{budget_owner_id} = $borrowernumber; + ModBudget( $budget ); + my $children = GetBudgetChildren( $budget_id ); + for my $child ( @$children ) { + SetOwnerToFundHierarchy( $child->{budget_id}, $borrowernumber ); + } +} + # ------------------------------------------------------------------- sub GetBudgetsPlanCell { my ( $cell, $period, $budget ) = @_; @@ -309,9 +333,19 @@ sub GetBudgetSpent { quantityreceived > 0 AND datecancellationprinted IS NULL |); - $sth->execute($budget_id); my $sum = $sth->fetchrow_array; + + $sth = $dbh->prepare(qq| + SELECT SUM(shipmentcost) AS sum + FROM aqinvoices + WHERE shipmentcost_budgetid = ? + AND closedate IS NOT NULL + |); + $sth->execute($budget_id); + my ($shipmentcost_sum) = $sth->fetchrow_array; + $sum += $shipmentcost_sum; + return $sum; } @@ -325,12 +359,44 @@ sub GetBudgetOrdered { quantityreceived = 0 AND datecancellationprinted IS NULL |); - $sth->execute($budget_id); my $sum = $sth->fetchrow_array; + + $sth = $dbh->prepare(qq| + SELECT SUM(shipmentcost) AS sum + FROM aqinvoices + WHERE shipmentcost_budgetid = ? + AND closedate IS NULL + |); + $sth->execute($budget_id); + my ($shipmentcost_sum) = $sth->fetchrow_array; + $sum += $shipmentcost_sum; + return $sum; } +=head2 GetBudgetName + + my $budget_name = &GetBudgetName($budget_id); + +get the budget_name for a given budget_id + +=cut + +sub GetBudgetName { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + qq| + SELECT budget_name + FROM aqbudgets + WHERE budget_id = ? + |); + + $sth->execute($budget_id); + return $sth->fetchrow_array; +} + # ------------------------------------------------------------------- sub GetBudgetAuthCats { my ($budget_period_id) = shift; @@ -351,35 +417,14 @@ sub GetBudgetAuthCats { return \@auth_cats_loop; } -# ------------------------------------------------------------------- -sub GetAuthvalueDropbox { - my ( $authcat, $default ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - 'SELECT authorised_value,lib FROM authorised_values - WHERE category = ? ORDER BY lib' - ); - $sth->execute( $authcat ); - my $option_list = []; - my @authorised_values = ( q{} ); - while (my ($value, $lib) = $sth->fetchrow_array) { - push @{$option_list}, { - value => $value, - label => $lib, - default => ($default eq $value), - }; - } - - if ( @{$option_list} ) { - return $option_list; - } - return; -} - # ------------------------------------------------------------------- sub GetBudgetPeriods { my ($filters,$orderby) = @_; - return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide"); + + my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod'); + $rs = $rs->search( $filters, { order_by => $orderby } ); + $rs->result_class('DBIx::Class::ResultClass::HashRefInflator'); + return [ $rs->all ]; } # ------------------------------------------------------------------- sub GetBudgetPeriod { @@ -426,8 +471,12 @@ sub DelBudgetPeriod{ # ------------------------------------------------------------------- sub ModBudgetPeriod { - my ($budget_period_information) = @_; - return UpdateInTable("aqbudgetperiods",$budget_period_information); + my ($budget_period) = @_; + my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period); + return unless($result); + + $result = $result->update($budget_period); + return $result->in_storage; } # ------------------------------------------------------------------- @@ -436,7 +485,7 @@ sub GetBudgetHierarchy { my @bind_params; my $dbh = C4::Context->dbh; my $query = qq| - SELECT aqbudgets.*, aqbudgetperiods.budget_period_active + SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description FROM aqbudgets JOIN aqbudgetperiods USING (budget_period_id)|; @@ -466,116 +515,76 @@ sub GetBudgetHierarchy { $debug && warn $query,join(",",@bind_params); my $sth = $dbh->prepare($query); $sth->execute(@bind_params); - my $results = $sth->fetchall_arrayref({}); - my @res = @$results; - my $i = 0; - while (1) { - my $depth_cnt = 0; - foreach my $r (@res) { - my @child; - # look for children - $r->{depth} = '0' if !defined $r->{budget_parent_id}; - foreach my $r2 (@res) { - if (defined $r2->{budget_parent_id} - && $r2->{budget_parent_id} == $r->{budget_id}) { - push @child, $r2->{budget_id}; - $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth}; - } - } - $r->{child} = \@child if scalar @child > 0; # add the child - $depth_cnt++ if !defined $r->{'depth'}; - } - last if ($depth_cnt == 0 || $i == 100); - $i++; - } - # look for top parents 1st - my (@sort, $depth_count); - ($i, $depth_count) = 0; - while (1) { - my $children = 0; - foreach my $r (@res) { - if ($r->{depth} == $depth_count) { - $children++ if (ref $r->{child} eq 'ARRAY'); - - # find the parent id element_id and insert it after - my $i2 = 0; - my $parent; - if ($depth_count > 0) { - - # add indent - my $depth = $r->{depth} * 2; - $r->{budget_code_indent} = $r->{budget_code}; - $r->{budget_name_indent} = $r->{budget_name}; - foreach my $r3 (@sort) { - if ($r3->{budget_id} == $r->{budget_parent_id}) { - $parent = $i2; - last; - } - $i2++; - } - } else { - $r->{budget_code_indent} = $r->{budget_code}; - $r->{budget_name_indent} = $r->{budget_name}; - } - - if (defined $parent) { - splice @sort, ($parent + 1), 0, $r; - } else { - push @sort, $r; - } - } - - $i++; - } # --------------foreach - $depth_count++; - last if $children == 0; - } + my %links; + # create hash with budget_id has key + while ( my $data = $sth->fetchrow_hashref ) { + $links{ $data->{'budget_id'} } = $data; + } -# 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}; + # link child to parent + my @first_parents; + foreach my $budget ( sort { $a->{budget_code} cmp $b->{budget_code} } values %links ) { + my $child = $links{$budget->{budget_id}}; + if ( $child->{'budget_parent_id'} ) { + my $parent = $links{ $child->{'budget_parent_id'} }; + if ($parent) { + unless ( $parent->{'children'} ) { + # init child arrayref + $parent->{'children'} = []; + } + # add as child + push @{ $parent->{'children'} }, $child; + } + } else { + push @first_parents, $child; } + } - 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_amount_total'} = $r->{'budget_amount'}; - - # foreach sub-levels - my $unalloc_count ; + my @sort = (); + foreach my $first_parent (@first_parents) { + _add_budget_children(\@sort, $first_parent); + } - foreach my $sub (@subs_arr) { - my $sub_budget = GetBudget($sub); + 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; +} - $r->{budget_spent_sublevel} += GetBudgetSpent( $sub_budget->{'budget_id'} ); - $unalloc_count += $sub_budget->{'budget_amount'}; - } - } - return \@sort; +# Recursive method to add a budget and its chidren to an array +sub _add_budget_children { + my $res = shift; + my $budget = shift; + push @$res, $budget; + my $children = $budget->{'children'} || []; + return unless @$children; # break recursivity + foreach my $child (@$children) { + _add_budget_children($res, $child); + } } # ------------------------------------------------------------------- sub AddBudget { my ($budget) = @_; - return InsertInTable("aqbudgets",$budget); + return unless ($budget); + + my $resultset = Koha::Database->new()->schema->resultset('Aqbudget'); + return $resultset->create($budget)->id; } # ------------------------------------------------------------------- sub ModBudget { my ($budget) = @_; - return UpdateInTable("aqbudgets",$budget); + my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget); + return unless($result); + + $result = $result->update($budget); + return $result->in_storage; } # ------------------------------------------------------------------- @@ -611,33 +620,103 @@ sub GetBudget { return $result; } -=head2 GetChildBudgetsSpent +=head2 GetBudgetByOrderNumber - &GetChildBudgetsSpent($budget-id); + &GetBudgetByOrderNumber($ordernumber); -gets the total spent of the level and sublevels of $budget_id +get a specific budget by order number =cut # ------------------------------------------------------------------- -sub GetChildBudgetsSpent { - my ( $budget_id ) = @_; +sub GetBudgetByOrderNumber { + my ( $ordernumber ) = @_; my $dbh = C4::Context->dbh; my $query = " - SELECT * - FROM aqbudgets - WHERE budget_parent_id=? + SELECT aqbudgets.* + FROM aqbudgets, aqorders + WHERE ordernumber=? + AND aqorders.budget_id = aqbudgets.budget_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; + $sth->execute( $ordernumber ); + my $result = $sth->fetchrow_hashref; + return $result; +} + +=head2 GetBudgetByCode + + my $budget = &GetBudgetByCode($budget_code); + +Retrieve all aqbudgets fields as a hashref for the budget that has +given budget_code + +=cut + +sub GetBudgetByCode { + my ( $budget_code ) = @_; + + my $dbh = C4::Context->dbh; + my $query = qq{ + SELECT * + FROM aqbudgets + WHERE budget_code = ? + ORDER BY budget_id DESC + LIMIT 1 + }; + my $sth = $dbh->prepare( $query ); + $sth->execute( $budget_code ); + return $sth->fetchrow_hashref; +} + +=head2 GetBudgetHierarchySpent + + my $spent = GetBudgetHierarchySpent( $budget_id ); + +Gets the total spent of the level and sublevels of $budget_id + +=cut + +sub GetBudgetHierarchySpent { + 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_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); @@ -648,128 +727,439 @@ gets all budgets # ------------------------------------------------------------------- sub GetBudgets { - my ($filters,$orderby) = @_; - return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide"); + my ($filters, $orderby) = @_; + $orderby = 'budget_name' unless($orderby); + + my $rs = Koha::Database->new()->schema->resultset('Aqbudget'); + $rs = $rs->search( $filters, { order_by => $orderby } ); + $rs->result_class('DBIx::Class::ResultClass::HashRefInflator'); + return [ $rs->all ]; } -# ------------------------------------------------------------------- +=head2 GetBudgetUsers + + my @borrowernumbers = &GetBudgetUsers($budget_id); -=head2 GetCurrencies +Return the list of borrowernumbers linked to a budget - @currencies = &GetCurrencies; +=cut -Returns the list of all known currencies. +sub GetBudgetUsers { + my ($budget_id) = @_; -C<$currencies> is a array; its elements are references-to-hash, whose -keys are the fields from the currency table in the Koha database. + my $dbh = C4::Context->dbh; + my $query = qq{ + SELECT borrowernumber + FROM aqbudgetborrowers + WHERE budget_id = ? + }; + my $sth = $dbh->prepare($query); + $sth->execute($budget_id); + + my @borrowernumbers; + while (my ($borrowernumber) = $sth->fetchrow_array) { + push @borrowernumbers, $borrowernumber + } + + return @borrowernumbers; +} + +=head2 ModBudgetUsers + + &ModBudgetUsers($budget_id, @borrowernumbers); + +Modify the list of borrowernumbers linked to a budget =cut -sub GetCurrencies { - my $dbh = C4::Context->dbh; - my $query = " - SELECT * - FROM currency - "; +sub ModBudgetUsers { + my ($budget_id, @budget_users_id) = @_; + + return unless $budget_id; + + my $dbh = C4::Context->dbh; + my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?"; my $sth = $dbh->prepare($query); - $sth->execute; - my @results = (); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); + $sth->execute($budget_id); + + $query = qq{ + INSERT INTO aqbudgetborrowers (budget_id, borrowernumber) + VALUES (?,?) + }; + $sth = $dbh->prepare($query); + foreach my $borrowernumber (@budget_users_id) { + next unless $borrowernumber; + $sth->execute($budget_id, $borrowernumber); } - return @results; } -# ------------------------------------------------------------------- +sub CanUserUseBudget { + my ($borrower, $budget, $userflags) = @_; -sub GetCurrency { - my $dbh = C4::Context->dbh; - my $query = " - SELECT * FROM currency where active = '1' "; - my $sth = $dbh->prepare($query); - $sth->execute; - my $r = $sth->fetchrow_hashref; - return $r; + if (not ref $borrower) { + $borrower = C4::Members::GetMember(borrowernumber => $borrower); + } + if (not ref $budget) { + $budget = GetBudget($budget); + } + + return 0 unless ($borrower and $budget); + + if (not defined $userflags) { + $userflags = C4::Auth::getuserflags($borrower->{flags}, + $borrower->{userid}); + } + + unless ($userflags->{superlibrarian} + || (ref $userflags->{acquisition} + && $userflags->{acquisition}->{budget_manage_all}) + || (!ref $userflags->{acquisition} && $userflags->{acquisition})) + { + if (not exists $userflags->{acquisition}) { + return 0; + } + + if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) { + return 0; + } + + # Budget restricted to owner + if ( $budget->{budget_permission} == 1 ) { + if ( $budget->{budget_owner_id} + and $budget->{budget_owner_id} != $borrower->{borrowernumber} ) + { + return 0; + } + } + + # Budget restricted to owner, users and library + elsif ( $budget->{budget_permission} == 2 ) { + my @budget_users = GetBudgetUsers( $budget->{budget_id} ); + + if ( + ( + $budget->{budget_owner_id} + and $budget->{budget_owner_id} != + $borrower->{borrowernumber} + or not $budget->{budget_owner_id} + ) + and ( 0 == grep { $borrower->{borrowernumber} == $_ } + @budget_users ) + and defined $budget->{budget_branchcode} + and $budget->{budget_branchcode} ne + C4::Context->userenv->{branch} + ) + { + return 0; + } + } + + # Budget restricted to owner and users + elsif ( $budget->{budget_permission} == 3 ) { + my @budget_users = GetBudgetUsers( $budget->{budget_id} ); + if ( + ( + $budget->{budget_owner_id} + and $budget->{budget_owner_id} != + $borrower->{borrowernumber} + or not $budget->{budget_owner_id} + ) + and ( 0 == grep { $borrower->{borrowernumber} == $_ } + @budget_users ) + ) + { + return 0; + } + } + } + + return 1; } -=head2 ModCurrencies +sub CanUserModifyBudget { + my ($borrower, $budget, $userflags) = @_; -&ModCurrencies($currency, $newrate); + if (not ref $borrower) { + $borrower = C4::Members::GetMember(borrowernumber => $borrower); + } + if (not ref $budget) { + $budget = GetBudget($budget); + } -Sets the exchange rate for C<$currency> to be C<$newrate>. + return 0 unless ($borrower and $budget); -=cut + if (not defined $userflags) { + $userflags = C4::Auth::getuserflags($borrower->{flags}, + $borrower->{userid}); + } -sub ModCurrencies { - my ( $currency, $rate ) = @_; - my $dbh = C4::Context->dbh; - my $query = qq| - UPDATE currency - SET rate=? - WHERE currency=? |; - my $sth = $dbh->prepare($query); - $sth->execute( $rate, $currency ); + unless ($userflags->{superlibrarian} + || (ref $userflags->{acquisition} + && $userflags->{acquisition}->{budget_manage_all}) + || (!ref $userflags->{acquisition} && $userflags->{acquisition})) + { + if (!CanUserUseBudget($borrower, $budget, $userflags)) { + return 0; + } + + if (ref $userflags->{acquisition} + && !$userflags->{acquisition}->{budget_modify}) { + return 0; + } + } + + return 1; } -# ------------------------------------------------------------------- +sub _round { + my ($value, $increment) = @_; -=head2 ConvertCurrency + if ($increment && $increment != 0) { + $value = int($value / $increment) * $increment; + } + + return $value; +} - $foreignprice = &ConvertCurrency($currency, $localprice); +=head2 CloneBudgetPeriod -Converts the price C<$localprice> to foreign currency C<$currency> by -dividing by the exchange rate, and returns the result. + my $new_budget_period_id = CloneBudgetPeriod({ + budget_period_id => $budget_period_id, + budget_period_startdate => $budget_period_startdate, + budget_period_enddate => $budget_period_enddate, + mark_original_budget_as_inactive => 1n + reset_all_budgets => 1, + }); -If no exchange rate is found, e is one to one. +Clone a budget period with all budgets. +If the mark_origin_budget_as_inactive is set (0 by default), +the original budget will be marked as inactive. + +If the reset_all_budgets is set (0 by default), all budget (fund) +amounts will be reset. =cut -sub ConvertCurrency { - my ( $currency, $price ) = @_; - my $dbh = C4::Context->dbh; - my $query = " - SELECT rate - FROM currency - WHERE currency=? - "; - my $sth = $dbh->prepare($query); - $sth->execute($currency); - my $cur = ( $sth->fetchrow_array() )[0]; - unless ($cur) { - $cur = 1; +sub CloneBudgetPeriod { + my ($params) = @_; + my $budget_period_id = $params->{budget_period_id}; + my $budget_period_startdate = $params->{budget_period_startdate}; + my $budget_period_enddate = $params->{budget_period_enddate}; + my $budget_period_description = $params->{budget_period_description}; + my $amount_change_percentage = $params->{amount_change_percentage}; + my $amount_change_round_increment = $params->{amount_change_round_increment}; + my $mark_original_budget_as_inactive = + $params->{mark_original_budget_as_inactive} || 0; + my $reset_all_budgets = $params->{reset_all_budgets} || 0; + + my $budget_period = GetBudgetPeriod($budget_period_id); + + $budget_period->{budget_period_startdate} = $budget_period_startdate; + $budget_period->{budget_period_enddate} = $budget_period_enddate; + $budget_period->{budget_period_description} = $budget_period_description; + # The new budget (budget_period) should be active by default + $budget_period->{budget_period_active} = 1; + + if ($amount_change_percentage) { + my $total = $budget_period->{budget_period_total}; + $total += $total * $amount_change_percentage / 100; + $total = _round($total, $amount_change_round_increment); + $budget_period->{budget_period_total} = $total; + } + + my $original_budget_period_id = $budget_period->{budget_period_id}; + delete $budget_period->{budget_period_id}; + my $new_budget_period_id = AddBudgetPeriod( $budget_period ); + + my $budgets = GetBudgetHierarchy($budget_period_id); + CloneBudgetHierarchy( + { + budgets => $budgets, + new_budget_period_id => $new_budget_period_id + } + ); + + if ($mark_original_budget_as_inactive) { + ModBudgetPeriod( + { + budget_period_id => $budget_period_id, + budget_period_active => 0, + } + ); + } + + if ( $reset_all_budgets ) { + my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id }); + for my $budget ( @$budgets ) { + $budget->{budget_amount} = 0; + ModBudget( $budget ); + } + } elsif ($amount_change_percentage) { + my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id }); + for my $budget ( @$budgets ) { + my $amount = $budget->{budget_amount}; + $amount += $amount * $amount_change_percentage / 100; + $amount = _round($amount, $amount_change_round_increment); + $budget->{budget_amount} = $amount; + ModBudget( $budget ); + } } - return ( $price / $cur ); + + return $new_budget_period_id; } -=head2 _columns +=head2 CloneBudgetHierarchy + + CloneBudgetHierarchy({ + budgets => $budgets, + new_budget_period_id => $new_budget_period_id; + }); -returns an array containing fieldname followed by PRI as value if PRIMARY Key +Clone a budget hierarchy. =cut -sub _columns(;$) { - my $tablename=shift||"aqbudgets"; - return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from $tablename",{Columns=>[1,4]})}; -} - -sub _filter_fields{ - my $budget=shift; - my $tablename=shift; - my @keys; - my @values; - my %columns= _columns($tablename); - #Filter Primary Keys of table - my $elements=join "|",grep {$columns{$_} ne "PRI"} keys %columns; - foreach my $field (grep {/\b($elements)\b/} keys %$budget){ - $$budget{$field}=format_date_in_iso($$budget{$field}) if ($field=~/date/ && $$budget{$field} !~C4::Dates->regexp("iso")); - my $strkeys= " $field = ? "; - if ($field=~/branch/){ - $strkeys="( $strkeys OR $field='' OR $field IS NULL) "; - } - push @values, $$budget{$field}; - push @keys, $strkeys; - } - return (\@keys,\@values); +sub CloneBudgetHierarchy { + my ($params) = @_; + my $budgets = $params->{budgets}; + my $new_budget_period_id = $params->{new_budget_period_id}; + next unless @$budgets or $new_budget_period_id; + + my $children_of = $params->{children_of}; + my $new_parent_id = $params->{new_parent_id}; + + my @first_level_budgets = + ( not defined $children_of ) + ? map { ( not $_->{budget_parent_id} ) ? $_ : () } @$budgets + : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets; + + # get only the columns of aqbudgets + my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns; + + for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} } + @first_level_budgets ) + { + + my $tidy_budget = + { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () } + keys %$budget }; + my $new_budget_id = AddBudget( + { + %$tidy_budget, + budget_id => undef, + budget_parent_id => $new_parent_id, + budget_period_id => $new_budget_period_id + } + ); + CloneBudgetHierarchy( + { + budgets => $budgets, + new_budget_period_id => $new_budget_period_id, + children_of => $budget->{budget_id}, + new_parent_id => $new_budget_id + } + ); + } +} + +=head2 MoveOrders + + my $report = MoveOrders({ + from_budget_period_id => $from_budget_period_id, + to_budget_period_id => $to_budget_period_id, + }); + +Move orders from one budget period to another. + +=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}; + my $move_remaining_unspent = $params->{move_remaining_unspent}; + 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 $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( + 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 => $from_budget, + 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; + } + + 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, + orders_moved => \@orders_moved, + moved => 1, + unspent_moved => $unspent_moved, + }; + } + return \@report; } END { } # module clean-up code here (global destructor)