From 525674dddd6b1c9df38407bdf30ab28171ae47e0 Mon Sep 17 00:00:00 2001 From: Nick Clemens Date: Fri, 8 Feb 2019 20:24:05 +0000 Subject: [PATCH] WIP Add Invoice Adjustments to GetBudgetHierarchy Seems to work but lots of debug code and test are incomplete. I think I made assumptions about how GetBudgetHierarchy takes a budget_period_id that are wrong https://bugs.koha-community.org/show_bug.cgi?id=22296 --- C4/Budgets.pm | 28 +++++++++++++++++++++++++--- t/db_dependent/Budgets.t | 26 ++++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 5 deletions(-) diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 6c7e9460e7..eba63ce4b1 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -488,6 +488,8 @@ sub ModBudgetPeriod { # ------------------------------------------------------------------- sub GetBudgetHierarchy { + warn "Here"; + $debug=1; my ( $budget_period_id, $branchcode, $owner ) = @_; my @bind_params; my $dbh = C4::Context->dbh; @@ -532,7 +534,9 @@ sub GetBudgetHierarchy { } # link child to parent + warn Data::Dumper::Dumper( %links ); my @first_parents; + warn Data::Dumper::Dumper(( sort { $a->{budget_code} cmp $b->{budget_code} } values %links )); foreach my $budget ( sort { $a->{budget_code} cmp $b->{budget_code} } values %links ) { my $child = $links{$budget->{budget_id}}; if ( $child->{'budget_parent_id'} ) { @@ -584,27 +588,45 @@ sub GetBudgetHierarchy { 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 ); + _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 ); } } return \@sort; } sub _recursiveAdd { - my ($budget, $parent, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_ordered_shipment ) = @_; + 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 ) = @_; foreach my $child (@{$budget->{children}}){ - _recursiveAdd($child, $budget, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_ordered_shipment ); + _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 ); } $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->{total_spent} += $budget->{budget_spent}; $budget->{total_ordered} += $budget->{budget_ordered}; diff --git a/t/db_dependent/Budgets.t b/t/db_dependent/Budgets.t index 6e4ad2c729..0c07c9b6a3 100755 --- a/t/db_dependent/Budgets.t +++ b/t/db_dependent/Budgets.t @@ -821,10 +821,30 @@ is( scalar @{$authCat}, 0, "GetBudgetAuthCats returns only non-empty sorting cat subtest 'GetBudgetSpent and GetBudgetOrdered' => sub { plan tests => 10; + my $budget_period = $builder->build({ + source => 'Aqbudgetperiod', + value => { + budget_period_active => 1, + budget_total => 10000, + } + }); + warn $budget_period->{budget_period_id}; + my $budget0 = $builder->build({ + source => 'Aqbudget', + value => { + budget_amount => 1000, + budget_encumb => undef, + budget_expend => undef, + budget_period_id => $budget_period->{budget_period_id}, + } + }); my $budget = $builder->build({ source => 'Aqbudget', value => { budget_amount => 1000, + budget_encumb => undef, + budget_expend => undef, + budget_period_id => $budget_period->{budget_period_id}, } }); my $invoice = $builder->build({ @@ -834,11 +854,13 @@ subtest 'GetBudgetSpent and GetBudgetOrdered' => sub { } }); - my $spent = GetBudgetSpent( $budget->{budget_id} ); - my $ordered = GetBudgetOrdered( $budget->{budget_id} ); + my $spent = GetBudgetSpent( $budget->{budget_id} ); + my $ordered = GetBudgetOrdered( $budget->{budget_id} ); + my $hierarchy = GetBudgetHierarchy($budget_period->{budget_period_id} ); is( $spent, 0, "New budget, no orders/invoices, should be nothing spent"); is( $ordered, 0, "New budget, no orders/invoices, should be nothing ordered"); + warn Data::Dumper::Dumper( $hierarchy ); my $inv_adj_1 = $builder->build({ source => 'AqinvoiceAdjustment', -- 2.11.0