X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=aa75c88f3ca7bff6040434d334a4e18fd7f0c3f5;hb=ad83d2e07d3c2c28e962b1a2e8d04b6f25a4a868;hp=39bec9ebe9788c8cf65171bc969596d27ec39a1e;hpb=7fe5f8cd2c2d1eddd2a835fb644c262cffcbd34c;p=srvgit diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 39bec9ebe9..aa75c88f3c 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -17,61 +17,69 @@ package C4::Budgets; # 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 Koha::Patrons; use Koha::Acquisition::Invoice::Adjustments; -use C4::Debug; -use vars qw(@ISA @EXPORT); +use C4::Acquisition; +use C4::Log qw(logaction); +our (@ISA, @EXPORT_OK); BEGIN { - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw( - - &GetBudget - &GetBudgetByOrderNumber - &GetBudgetByCode - &GetBudgets - &BudgetsByActivity - &GetBudgetsReport - &GetBudgetReport - &GetBudgetHierarchy - &AddBudget - &ModBudget - &DelBudget - &GetBudgetSpent - &GetBudgetOrdered - &GetBudgetName - &GetPeriodsCount - GetBudgetHierarchySpent - GetBudgetHierarchyOrdered - - &GetBudgetUsers - &ModBudgetUsers - &CanUserUseBudget - &CanUserModifyBudget - - &GetBudgetPeriod - &GetBudgetPeriods - &ModBudgetPeriod - &AddBudgetPeriod - &DelBudgetPeriod - - &ModBudgetPlan - - &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-----------------------------"; @@ -208,12 +216,13 @@ sub SetOwnerToFundHierarchy { # ------------------------------------------------------------------- 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 = _get_rounding_sql(qq|ecost_tax_included|); + 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(| . $roundsql . qq|) AS actual FROM aqorders @@ -223,6 +232,7 @@ sub GetBudgetsPlanCell { $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(| . $roundsql . qq|) FROM aqorders @@ -334,13 +344,13 @@ sub GetBudgetSpent { # unitprice_tax_included should always been set here # we should not need to retrieve ecost_tax_included my $sth = $dbh->prepare(qq| - SELECT SUM( | . _get_rounding_sql("COALESCE(unitprice_tax_included, ecost_tax_included)") . qq| * quantity ) AS sum FROM aqorders + 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 = 0 + $sth->fetchrow_array; + my $sum = ( $sth->fetchrow_array || 0 ) + 0; $sth = $dbh->prepare(qq| SELECT SUM(shipmentcost) AS sum @@ -350,7 +360,7 @@ sub GetBudgetSpent { $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 ){ @@ -365,13 +375,13 @@ sub GetBudgetOrdered { my ($budget_id) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare(qq| - SELECT SUM(| . _get_rounding_sql(qq|ecost_tax_included|) . qq| * 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 = 0 + $sth->fetchrow_array; + my $sum = ( $sth->fetchrow_array || 0 ) + 0; my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, encumber_open => 1, closedate => undef},{ join => 'invoiceid' }); while ( my $adj = $adjustments->next ){ @@ -437,29 +447,15 @@ 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{ @@ -489,7 +485,7 @@ 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| @@ -522,7 +518,6 @@ sub GetBudgetHierarchy { } } $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings; - $debug && warn $query,join(",",@bind_params); my $sth = $dbh->prepare($query); $sth->execute(@bind_params); @@ -555,75 +550,67 @@ sub GetBudgetHierarchy { foreach my $first_parent (@first_parents) { _add_budget_children(\@sort, $first_parent, 0); } - - # 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( COALESCE(unitprice_tax_included, ecost_tax_included) * 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(ecost_tax_included * 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 - WHERE closedate IS NOT NULL - GROUP BY shipmentcost_budgetid - |, 'budget_id'); - my $hr_budget_ordered_shipment = $dbh->selectall_hashref(q| - SELECT shipmentcost_budgetid as budget_id, - SUM(shipmentcost) as shipmentcost - FROM aqinvoices - WHERE closedate IS NULL - 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_ordered_shipment, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ); + 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_ordered_shipment, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ) = @_; + 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_ordered_shipment, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ); + _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}; - $budget->{budget_spent} += $hr_budget_spent_shipment->{$budget->{budget_id}}->{shipmentcost}; - $budget->{budget_spent} += $hr_budget_spent_adjustment->{$budget->{budget_id}}->{adjustments}; - $budget->{budget_ordered} += $hr_budget_ordered->{$budget->{budget_id}}->{budget_ordered}; - $budget->{budget_ordered} += $hr_budget_ordered_shipment->{$budget->{budget_id}}->{shipmentcost}; - $budget->{budget_ordered} += $hr_budget_ordered_adjustment->{$budget->{budget_id}}->{adjustments}; + $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}; @@ -648,35 +635,80 @@ sub _add_budget_children { } # ------------------------------------------------------------------- - +# FIXME Must be replaced by Koha::Acquisition::Fund->store sub AddBudget { my ($budget) = @_; return unless ($budget); - undef $budget->{budget_encumb} if $budget->{budget_encumb} eq ''; - undef $budget->{budget_owner_id} if $budget->{budget_owner_id} eq ''; + 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); - undef $budget->{budget_encumb} if $budget->{budget_encumb} eq ''; - undef $budget->{budget_owner_id} if $budget->{budget_owner_id} eq ''; + # 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; } @@ -821,14 +853,14 @@ sub GetBudgetsReport { ON bp.budget_period_id = b.budget_period_id INNER JOIN aqorders o ON b.budget_id = o.budget_id '; - if($activity ne ''){ + 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 ne ''){ + if ( $activity && $activity ne '' ) { $sth->execute($activity); } else{ @@ -1233,7 +1265,7 @@ sub CloneBudgetHierarchy { my @first_level_budgets = ( not defined $children_of ) ? map { ( not $_->{budget_parent_id} ) ? $_ : () } @$budgets - : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$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; @@ -1254,6 +1286,8 @@ sub CloneBudgetHierarchy { budget_period_id => $new_budget_period_id } ); + my @borrowernumbers = GetBudgetUsers($budget->{budget_id}); + ModBudgetUsers($new_budget_id, @borrowernumbers); CloneBudgetHierarchy( { budgets => $budgets, @@ -1365,25 +1399,6 @@ sub MoveOrders { return \@report; } -=head1 INTERNAL FUNCTIONS - -=cut - -=head3 _get_rounding_sql - - $rounding_sql = _get_rounding_sql("mysql_variable_to_round_string"); - -returns the correct SQL routine based on OrderPriceRounding system preference. - -=cut - -sub _get_rounding_sql { - my $to_round = shift; - my $rounding_pref = C4::Context->preference('OrderPriceRounding'); - if ($rounding_pref eq 'nearest_cent') { return "CAST($to_round*100 AS INTEGER)/100"; } - else { return "$to_round"; } -} - END { } # module clean-up code here (global destructor) 1;