X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=aa75c88f3ca7bff6040434d334a4e18fd7f0c3f5;hb=ad83d2e07d3c2c28e962b1a2e8d04b6f25a4a868;hp=30b9079810e0a4940d8a4ab1d80d3d0bd019836b;hpb=63789fc09531667a313f0433800c2637a0642821;p=srvgit diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 30b9079810..aa75c88f3c 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -4,81 +4,86 @@ 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 Modern::Perl; +use JSON; use C4::Context; use Koha::Database; -use C4::Debug; -use vars qw($VERSION @ISA @EXPORT); +use Koha::Patrons; +use Koha::Acquisition::Invoice::Adjustments; +use C4::Acquisition; +use C4::Log qw(logaction); +our (@ISA, @EXPORT_OK); BEGIN { - # set the version for version checking - $VERSION = 3.07.00.049; - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw( - - &GetBudget - &GetBudgetByOrderNumber - &GetBudgetByCode - &GetBudgets - &GetBudgetHierarchy - &AddBudget - &ModBudget - &DelBudget - &GetBudgetSpent - &GetBudgetOrdered - &GetBudgetName - &GetPeriodsCount - GetBudgetHierarchySpent - GetBudgetHierarchyOrdered - - &GetBudgetUsers - &ModBudgetUsers - &CanUserUseBudget - &CanUserModifyBudget - - &GetBudgetPeriod - &GetBudgetPeriods - &ModBudgetPeriod - &AddBudgetPeriod - &DelBudgetPeriod - - &ModBudgetPlan - - &GetCurrency - &GetCurrencies - &ModCurrencies - &ConvertCurrency - - &GetBudgetsPlanCell - &AddBudgetPlanValue - &GetBudgetAuthCats - &BudgetHasChildren - &CheckBudgetParent - &CheckBudgetParentPerm - - &HideCols - &GetCols - ); + require Exporter; + @ISA = qw(Exporter); + @EXPORT_OK = qw( + + GetBudget + GetBudgetByOrderNumber + GetBudgetByCode + GetBudgets + BudgetsByActivity + GetBudgetsReport + GetBudgetReport + GetBudgetsByActivity + GetBudgetHierarchy + AddBudget + ModBudget + DelBudget + GetBudgetSpent + GetBudgetOrdered + GetBudgetName + GetPeriodsCount + GetBudgetHierarchySpent + GetBudgetHierarchyOrdered + + GetBudgetUsers + ModBudgetUsers + CanUserUseBudget + CanUserModifyBudget + + GetBudgetPeriod + GetBudgetPeriods + ModBudgetPeriod + AddBudgetPeriod + DelBudgetPeriod + + ModBudgetPlan + + GetBudgetsPlanCell + AddBudgetPlanValue + GetBudgetAuthCats + BudgetHasChildren + GetBudgetChildren + SetOwnerToFundHierarchy + CheckBudgetParent + CheckBudgetParentPerm + + HideCols + GetCols + + CloneBudgetPeriod + CloneBudgetHierarchy + MoveOrders + ); } # ----------------------------BUDGETS.PM-----------------------------"; - =head1 FUNCTIONS ABOUT BUDGETS =cut @@ -137,6 +142,7 @@ sub AddBudgetPeriod { my ($budgetperiod) = @_; return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate}); + undef $budgetperiod->{budget_period_id}; my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod'); return $resultset->create($budgetperiod)->id; } @@ -187,25 +193,49 @@ 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 ) = @_; + my ( $cell, $period, $budget ) = @_; #FIXME we don't use $period my ($actual, $sth); my $dbh = C4::Context->dbh; + my $roundsql = C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|); if ( $cell->{'authcat'} eq 'MONTHS' ) { # get the actual amount + # FIXME we should consider quantity $sth = $dbh->prepare( qq| - SELECT SUM(ecost) AS actual FROM aqorders + SELECT SUM(| . $roundsql . qq|) AS actual FROM aqorders WHERE budget_id = ? AND entrydate like "$cell->{'authvalue'}%" | ); $sth->execute( $cell->{'budget_id'} ); } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) { # get the actual amount + # FIXME we should consider quantity $sth = $dbh->prepare( qq| - SELECT SUM(ecost) FROM aqorders + SELECT SUM(| . $roundsql . qq|) FROM aqorders LEFT JOIN aqorders_items ON (aqorders.ordernumber = aqorders_items.ordernumber) LEFT JOIN items @@ -217,7 +247,7 @@ sub GetBudgetsPlanCell { # get the actual amount $sth = $dbh->prepare( qq| - SELECT SUM( ecost * quantity) AS actual + SELECT SUM( | . $roundsql . qq| * quantity) AS actual FROM aqorders JOIN biblioitems ON (biblioitems.biblionumber = aqorders.biblionumber ) WHERE aqorders.budget_id = ? and itemtype = ? | @@ -230,7 +260,7 @@ sub GetBudgetsPlanCell { # get the actual amount $sth = $dbh->prepare( qq| - SELECT SUM(ecost * quantity) AS actual + SELECT SUM(| . $roundsql . qq| * quantity) AS actual FROM aqorders JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id ) WHERE aqorders.budget_id = ? AND @@ -309,26 +339,33 @@ sub ModBudgetPlan { # ------------------------------------------------------------------- sub GetBudgetSpent { - my ($budget_id) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare(qq| - SELECT SUM( COALESCE(unitprice, ecost) * quantity ) AS sum FROM aqorders + my ($budget_id) = @_; + my $dbh = C4::Context->dbh; + # unitprice_tax_included should always been set here + # we should not need to retrieve ecost_tax_included + my $sth = $dbh->prepare(qq| + SELECT SUM( | . C4::Acquisition::get_rounding_sql("COALESCE(unitprice_tax_included, ecost_tax_included)") . qq| * quantity ) AS sum FROM aqorders WHERE budget_id = ? AND quantityreceived > 0 AND datecancellationprinted IS NULL |); $sth->execute($budget_id); - my $sum = $sth->fetchrow_array; + my $sum = ( $sth->fetchrow_array || 0 ) + 0; $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; + $sum += ( $shipmentcost_sum || 0 ) + 0; + + my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, closedate => { '!=' => undef } },{ join => 'invoiceid' }); + while ( my $adj = $adjustments->next ){ + $sum += $adj->adjustment; + } return $sum; } @@ -338,23 +375,18 @@ sub GetBudgetOrdered { my ($budget_id) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare(qq| - SELECT SUM(ecost * quantity) AS sum FROM aqorders + SELECT SUM(| . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . qq| * quantity) AS sum FROM aqorders WHERE budget_id = ? AND quantityreceived = 0 AND datecancellationprinted IS NULL |); $sth->execute($budget_id); - my $sum = $sth->fetchrow_array; + my $sum = ( $sth->fetchrow_array || 0 ) + 0; - $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; + my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, encumber_open => 1, closedate => undef},{ join => 'invoiceid' }); + while ( my $adj = $adjustments->next ){ + $sum += $adj->adjustment; + } return $sum; } @@ -381,7 +413,14 @@ sub GetBudgetName { return $sth->fetchrow_array; } -# ------------------------------------------------------------------- +=head2 GetBudgetAuthCats + + my $auth_cats = &GetBudgetAuthCats($budget_period_id); + +Return the list of authcat for a given budget_period_id + +=cut + sub GetBudgetAuthCats { my ($budget_period_id) = shift; # now, populate the auth_cats_loop used in the budget planning button @@ -391,14 +430,10 @@ sub GetBudgetAuthCats { $sth->execute($budget_period_id); my %authcats; while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) { - $authcats{$sort1_authcat}=1; - $authcats{$sort2_authcat}=1; - } - my @auth_cats_loop; - foreach (sort keys %authcats) { - push @auth_cats_loop,{ authcat => $_ }; + $authcats{$sort1_authcat}=1 if $sort1_authcat; + $authcats{$sort2_authcat}=1 if $sort2_authcat; } - return \@auth_cats_loop; + return [ sort keys %authcats ]; } # ------------------------------------------------------------------- @@ -412,32 +447,17 @@ sub GetBudgetPeriods { } # ------------------------------------------------------------------- sub GetBudgetPeriod { - my ($budget_period_id) = @_; - my $dbh = C4::Context->dbh; - ## $total = number of records linked to the record that must be deleted - my $total = 0; - ## get information about the record that will be deleted - my $sth; - if ($budget_period_id) { - $sth = $dbh->prepare( qq| - SELECT * - FROM aqbudgetperiods - WHERE budget_period_id=? | - ); - $sth->execute($budget_period_id); - } else { # ACTIVE BUDGET - $sth = $dbh->prepare(qq| - SELECT * - FROM aqbudgetperiods - WHERE budget_period_active=1 | - ); - $sth->execute(); - } - my $data = $sth->fetchrow_hashref; - return $data; + my ($budget_period_id) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( qq| + SELECT * + FROM aqbudgetperiods + WHERE budget_period_id=? | + ); + $sth->execute($budget_period_id); + return $sth->fetchrow_hashref; } -# ------------------------------------------------------------------- sub DelBudgetPeriod{ my ($budget_period_id) = @_; my $dbh = C4::Context->dbh; @@ -465,14 +485,16 @@ sub ModBudgetPeriod { # ------------------------------------------------------------------- sub GetBudgetHierarchy { - my ( $budget_period_id, $branchcode, $owner ) = @_; + my ( $budget_period_id, $branchcode, $owner, $skiptotals ) = @_; my @bind_params; my $dbh = C4::Context->dbh; my $query = qq| - SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description + SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description, + b.firstname as budget_owner_firstname, b.surname as budget_owner_surname, b.borrowernumber as budget_owner_borrowernumber FROM aqbudgets + LEFT JOIN borrowers b on b.borrowernumber = aqbudgets.budget_owner_id JOIN aqbudgetperiods USING (budget_period_id)|; - + my @where_strings; # show only period X if requested if ($budget_period_id) { @@ -491,120 +513,208 @@ sub GetBudgetHierarchy { } } else { if ($branchcode) { - push @where_strings," (budget_branchcode =? or budget_branchcode is NULL)"; + push @where_strings," (budget_branchcode =? or budget_branchcode is NULL OR budget_branchcode='')"; push @bind_params, $branchcode; } } $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings; - $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; - } - - - 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} ); + + my %links; + # create hash with budget_id has key + while ( my $data = $sth->fetchrow_hashref ) { + $links{ $data->{'budget_id'} } = $data; + } + + # 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 @sort = (); + foreach my $first_parent (@first_parents) { + _add_budget_children(\@sort, $first_parent, 0); + } + if (!$skiptotals) { + # Get all the budgets totals in as few queries as possible + my $hr_budget_spent = $dbh->selectall_hashref(q| + SELECT aqorders.budget_id, aqbudgets.budget_parent_id, + SUM( | . C4::Acquisition::get_rounding_sql(qq|COALESCE(unitprice_tax_included, ecost_tax_included)|) . q| * quantity ) AS budget_spent + FROM aqorders JOIN aqbudgets USING (budget_id) + WHERE quantityreceived > 0 AND datecancellationprinted IS NULL + GROUP BY budget_id, budget_parent_id + |, 'budget_id'); + my $hr_budget_ordered = $dbh->selectall_hashref(q| + SELECT aqorders.budget_id, aqbudgets.budget_parent_id, + SUM( | . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . q| * quantity) AS budget_ordered + FROM aqorders JOIN aqbudgets USING (budget_id) + WHERE quantityreceived = 0 AND datecancellationprinted IS NULL + GROUP BY budget_id, budget_parent_id + |, 'budget_id'); + my $hr_budget_spent_shipment = $dbh->selectall_hashref(q| + SELECT shipmentcost_budgetid as budget_id, + SUM(shipmentcost) as shipmentcost + FROM aqinvoices + GROUP BY shipmentcost_budgetid + |, 'budget_id'); + my $hr_budget_spent_adjustment = $dbh->selectall_hashref(q| + SELECT budget_id, + SUM(adjustment) as adjustments + FROM aqinvoice_adjustments + JOIN aqinvoices USING (invoiceid) + WHERE closedate IS NOT NULL + GROUP BY budget_id + |, 'budget_id'); + my $hr_budget_ordered_adjustment = $dbh->selectall_hashref(q| + SELECT budget_id, + SUM(adjustment) as adjustments + FROM aqinvoice_adjustments + JOIN aqinvoices USING (invoiceid) + WHERE closedate IS NULL AND encumber_open = 1 + GROUP BY budget_id + |, 'budget_id'); + + + foreach my $budget (@sort) { + if ( not defined $budget->{budget_parent_id} ) { + _recursiveAdd( $budget, undef, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ); + } + } } return \@sort; } -# ------------------------------------------------------------------- +sub _recursiveAdd { + my ($budget, $parent, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ) = @_; + + foreach my $child (@{$budget->{children}}){ + _recursiveAdd($child, $budget, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ); + } + + $budget->{budget_spent} += $hr_budget_spent->{$budget->{budget_id}}->{budget_spent} || 0; + $budget->{budget_spent} += $hr_budget_spent_shipment->{$budget->{budget_id}}->{shipmentcost} || 0; + $budget->{budget_spent} += $hr_budget_spent_adjustment->{$budget->{budget_id}}->{adjustments} || 0; + $budget->{budget_ordered} += $hr_budget_ordered->{$budget->{budget_id}}->{budget_ordered} || 0; + $budget->{budget_ordered} += $hr_budget_ordered_adjustment->{$budget->{budget_id}}->{adjustments} || 0; + + $budget->{total_spent} += $budget->{budget_spent}; + $budget->{total_ordered} += $budget->{budget_ordered}; + + if ($parent) { + $parent->{total_spent} += $budget->{total_spent}; + $parent->{total_ordered} += $budget->{total_ordered}; + } +} +# Recursive method to add a budget and its chidren to an array +sub _add_budget_children { + my $res = shift; + my $budget = shift; + $budget->{budget_level} = shift; + push @$res, $budget; + my $children = $budget->{'children'} || []; + return unless @$children; # break recursivity + foreach my $child (@$children) { + _add_budget_children($res, $child, $budget->{budget_level} + 1); + } +} + +# ------------------------------------------------------------------- +# FIXME Must be replaced by Koha::Acquisition::Fund->store sub AddBudget { my ($budget) = @_; return unless ($budget); + undef $budget->{budget_encumb} if defined $budget->{budget_encumb} && $budget->{budget_encumb} eq ''; + undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq ''; my $resultset = Koha::Database->new()->schema->resultset('Aqbudget'); - return $resultset->create($budget)->id; + my $id = $resultset->create($budget)->id; + + # Log the addition + if (C4::Context->preference("AcquisitionLog")) { + my $infos = { + budget_amount => $budget->{budget_amount}, + budget_encumb => $budget->{budget_encumb}, + budget_expend => $budget->{budget_expend} + }; + logaction( + 'ACQUISITIONS', + 'CREATE_FUND', + $id, + encode_json($infos) + ); + } + return $id; } # ------------------------------------------------------------------- +# FIXME Must be replaced by Koha::Acquisition::Fund->store sub ModBudget { my ($budget) = @_; my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget); return unless($result); + # Log this modification + if (C4::Context->preference("AcquisitionLog")) { + my $infos = { + budget_amount_new => $budget->{budget_amount}, + budget_encumb_new => $budget->{budget_encumb}, + budget_expend_new => $budget->{budget_expend}, + budget_amount_old => $result->budget_amount, + budget_encumb_old => $result->budget_encumb, + budget_expend_old => $result->budget_expend, + budget_amount_change => 0 - ($result->budget_amount - $budget->{budget_amount}) + }; + logaction( + 'ACQUISITIONS', + 'MODIFY_FUND', + $budget->{budget_id}, + encode_json($infos) + ); + } + + undef $budget->{budget_encumb} if defined $budget->{budget_encumb} && $budget->{budget_encumb} eq ''; + undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq ''; $result = $result->update($budget); return $result->in_storage; } # ------------------------------------------------------------------- +# FIXME Must be replaced by Koha::Acquisition::Fund->delete sub DelBudget { my ($budget_id) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare("delete from aqbudgets where budget_id=?"); my $rc = $sth->execute($budget_id); + # Log the deletion + if (C4::Context->preference("AcquisitionLog")) { + logaction( + 'ACQUISITIONS', + 'DELETE_FUND', + $budget_id + ); + } return $rc; } +# ------------------------------------------------------------------- + =head2 GetBudget &GetBudget($budget_id); @@ -613,7 +723,6 @@ get a specific budget =cut -# ------------------------------------------------------------------- sub GetBudget { my ( $budget_id ) = @_; my $dbh = C4::Context->dbh; @@ -628,6 +737,8 @@ sub GetBudget { return $result; } +# ------------------------------------------------------------------- + =head2 GetBudgetByOrderNumber &GetBudgetByOrderNumber($ordernumber); @@ -636,7 +747,6 @@ get a specific budget by order number =cut -# ------------------------------------------------------------------- sub GetBudgetByOrderNumber { my ( $ordernumber ) = @_; my $dbh = C4::Context->dbh; @@ -652,6 +762,117 @@ sub GetBudgetByOrderNumber { return $result; } +=head2 GetBudgetReport + + &GetBudgetReport( [$budget_id] ); + +Get all orders for a specific budget, without cancelled orders. + +Returns an array of hashrefs. + +=cut + +# -------------------------------------------------------------------- +sub GetBudgetReport { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + my $query = ' + SELECT o.*, b.budget_name + FROM aqbudgets b + INNER JOIN aqorders o + ON b.budget_id = o.budget_id + WHERE b.budget_id=? + AND (o.orderstatus != "cancelled") + ORDER BY b.budget_name'; + + my $sth = $dbh->prepare($query); + $sth->execute( $budget_id ); + + my @results = (); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + return @results; +} + +=head2 GetBudgetsByActivity + + &GetBudgetsByActivity( $budget_period_active ); + +Get all active or inactive budgets, depending of the value +of the parameter. + +1 = active +0 = inactive + +=cut + +# -------------------------------------------------------------------- +sub GetBudgetsByActivity { + my ( $budget_period_active ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT DISTINCT b.* + FROM aqbudgetperiods bp + INNER JOIN aqbudgets b + ON bp.budget_period_id = b.budget_period_id + WHERE bp.budget_period_active=? + "; + my $sth = $dbh->prepare($query); + $sth->execute( $budget_period_active ); + my @results = (); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + return @results; +} +# -------------------------------------------------------------------- + +=head2 GetBudgetsReport + + &GetBudgetsReport( [$activity] ); + +Get all but cancelled orders for all funds. + +If the optionnal activity parameter is passed, returns orders for active/inactive budgets only. + +active = 1 +inactive = 0 + +Returns an array of hashrefs. + +=cut + +sub GetBudgetsReport { + my ($activity) = @_; + my $dbh = C4::Context->dbh; + my $query = ' + SELECT o.*, b.budget_name + FROM aqbudgetperiods bp + INNER JOIN aqbudgets b + ON bp.budget_period_id = b.budget_period_id + INNER JOIN aqorders o + ON b.budget_id = o.budget_id '; + if ( $activity && $activity ne '' ) { + $query .= 'WHERE bp.budget_period_active=? '; + } + $query .= 'AND (o.orderstatus != "cancelled") + ORDER BY b.budget_name'; + + my $sth = $dbh->prepare($query); + if ( $activity && $activity ne '' ) { + $sth->execute($activity); + } + else{ + $sth->execute; + } + my @results = (); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + return @results; +} + =head2 GetBudgetByCode my $budget = &GetBudgetByCode($budget_code); @@ -666,10 +887,11 @@ sub GetBudgetByCode { my $dbh = C4::Context->dbh; my $query = qq{ - SELECT * + SELECT aqbudgets.* FROM aqbudgets + JOIN aqbudgetperiods USING (budget_period_id) WHERE budget_code = ? - ORDER BY budget_id DESC + ORDER BY budget_period_active DESC, budget_id DESC LIMIT 1 }; my $sth = $dbh->prepare( $query ); @@ -805,7 +1027,9 @@ sub CanUserUseBudget { my ($borrower, $budget, $userflags) = @_; if (not ref $borrower) { - $borrower = C4::Members::GetMember(borrowernumber => $borrower); + $borrower = Koha::Patrons->find( $borrower ); + return 0 unless $borrower; + $borrower = $borrower->unblessed; } if (not ref $budget) { $budget = GetBudget($budget); @@ -888,7 +1112,9 @@ sub CanUserModifyBudget { my ($borrower, $budget, $userflags) = @_; if (not ref $borrower) { - $borrower = C4::Members::GetMember(borrowernumber => $borrower); + $borrower = Koha::Patrons->find( $borrower ); + return 0 unless $borrower; + $borrower = $borrower->unblessed; } if (not ref $budget) { $budget = GetBudget($budget); @@ -919,93 +1145,258 @@ sub CanUserModifyBudget { return 1; } -# ------------------------------------------------------------------- +sub _round { + my ($value, $increment) = @_; -=head2 GetCurrencies + if ($increment && $increment != 0) { + $value = int($value / $increment) * $increment; + } + + return $value; +} - @currencies = &GetCurrencies; +=head2 CloneBudgetPeriod -Returns the list of all known currencies. + 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, + }); -C<$currencies> is a array; its elements are references-to-hash, whose -keys are the fields from the currency table in the Koha database. +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 GetCurrencies { - my $dbh = C4::Context->dbh; - my $query = " - SELECT * - FROM currency - "; - my $sth = $dbh->prepare($query); - $sth->execute; - my @results = (); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); +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; } - return @results; -} -# ------------------------------------------------------------------- + my $original_budget_period_id = $budget_period->{budget_period_id}; + delete $budget_period->{budget_period_id}; + my $new_budget_period_id = AddBudgetPeriod( $budget_period ); -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; + 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 $new_budget_period_id; } -=head2 ModCurrencies +=head2 CloneBudgetHierarchy -&ModCurrencies($currency, $newrate); + CloneBudgetHierarchy({ + budgets => $budgets, + new_budget_period_id => $new_budget_period_id; + }); -Sets the exchange rate for C<$currency> to be C<$newrate>. +Clone a budget hierarchy. =cut -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 ); -} +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 { ( defined $_->{budget_parent_id} && $_->{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 ) + { -=head2 ConvertCurrency + my $tidy_budget = + { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () } + keys %$budget }; + delete $tidy_budget->{timestamp}; + my $new_budget_id = AddBudget( + { + %$tidy_budget, + budget_id => undef, + budget_parent_id => $new_parent_id, + budget_period_id => $new_budget_period_id + } + ); + my @borrowernumbers = GetBudgetUsers($budget->{budget_id}); + ModBudgetUsers($new_budget_id, @borrowernumbers); + CloneBudgetHierarchy( + { + budgets => $budgets, + new_budget_period_id => $new_budget_period_id, + children_of => $budget->{budget_id}, + new_parent_id => $new_budget_id + } + ); + } +} - $foreignprice = &ConvertCurrency($currency, $localprice); +=head2 MoveOrders -Converts the price C<$localprice> to foreign currency C<$currency> by -dividing by the exchange rate, and returns the result. + my $report = MoveOrders({ + from_budget_period_id => $from_budget_period_id, + to_budget_period_id => $to_budget_period_id, + }); -If no exchange rate is found, e is one to one. +Move orders from one budget period to another. =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 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 ( $price / $cur ); + return \@report; } END { } # module clean-up code here (global destructor)