]> git.koha-community.org Git - koha.git/blob - C4/Budgets.pm
Bug 13629: SingleBranchMode removes both library and availability search from advance...
[koha.git] / C4 / Budgets.pm
1 package C4::Budgets;
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use strict;
21 #use warnings; FIXME - Bug 2505
22 use C4::Context;
23 use Koha::Database;
24 use Koha::Patrons;
25 use Koha::Acquisition::Invoice::Adjustments;
26 use C4::Debug;
27 use C4::Acquisition;
28 use vars qw(@ISA @EXPORT);
29
30 BEGIN {
31         require Exporter;
32         @ISA    = qw(Exporter);
33         @EXPORT = qw(
34
35         &GetBudget
36         &GetBudgetByOrderNumber
37         &GetBudgetByCode
38         &GetBudgets
39         &BudgetsByActivity
40         &GetBudgetsReport
41         &GetBudgetReport
42         &GetBudgetHierarchy
43             &AddBudget
44         &ModBudget
45         &DelBudget
46         &GetBudgetSpent
47         &GetBudgetOrdered
48         &GetBudgetName
49         &GetPeriodsCount
50         GetBudgetHierarchySpent
51         GetBudgetHierarchyOrdered
52
53         &GetBudgetUsers
54         &ModBudgetUsers
55         &CanUserUseBudget
56         &CanUserModifyBudget
57
58             &GetBudgetPeriod
59         &GetBudgetPeriods
60         &ModBudgetPeriod
61         &AddBudgetPeriod
62             &DelBudgetPeriod
63
64         &ModBudgetPlan
65
66                 &GetBudgetsPlanCell
67         &AddBudgetPlanValue
68         &GetBudgetAuthCats
69         &BudgetHasChildren
70         &CheckBudgetParent
71         &CheckBudgetParentPerm
72
73         &HideCols
74         &GetCols
75         );
76 }
77
78 # ----------------------------BUDGETS.PM-----------------------------";
79
80 =head1 FUNCTIONS ABOUT BUDGETS
81
82 =cut
83
84 sub HideCols {
85     my ( $authcat, @hide_cols ) = @_;
86     my $dbh = C4::Context->dbh;
87
88     my $sth1 = $dbh->prepare(
89         qq|
90         UPDATE aqbudgets_planning SET display = 0 
91         WHERE authcat = ? 
92         AND  authvalue = ? |
93     );
94     foreach my $authvalue (@hide_cols) {
95 #        $sth1->{TraceLevel} = 3;
96         $sth1->execute(  $authcat, $authvalue );
97     }
98 }
99
100 sub GetCols {
101     my ( $authcat, $authvalue ) = @_;
102
103     my $dbh = C4::Context->dbh;
104     my $sth = $dbh->prepare(
105         qq|
106         SELECT count(display) as cnt from aqbudgets_planning
107         WHERE  authcat = ? 
108         AND authvalue = ? and display  = 0   |
109     );
110
111 #    $sth->{TraceLevel} = 3;
112     $sth->execute( $authcat, $authvalue );
113     my $res  = $sth->fetchrow_hashref;
114
115     return  $res->{cnt} > 0 ? 0: 1
116
117 }
118
119 sub CheckBudgetParentPerm {
120     my ( $budget, $borrower_id ) = @_;
121     my $depth = $budget->{depth};
122     my $parent_id = $budget->{budget_parent_id};
123     while ($depth) {
124         my $parent = GetBudget($parent_id);
125         $parent_id = $parent->{budget_parent_id};
126         if ( $parent->{budget_owner_id} == $borrower_id ) {
127             return 1;
128         }
129         $depth--
130     }
131     return 0;
132 }
133
134 sub AddBudgetPeriod {
135     my ($budgetperiod) = @_;
136     return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate});
137
138     undef $budgetperiod->{budget_period_id};
139     my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
140     return $resultset->create($budgetperiod)->id;
141 }
142 # -------------------------------------------------------------------
143 sub GetPeriodsCount {
144     my $dbh = C4::Context->dbh;
145     my $sth = $dbh->prepare("
146         SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
147     $sth->execute();
148     my $res = $sth->fetchrow_hashref;
149     return $res->{'sum'};
150 }
151
152 # -------------------------------------------------------------------
153 sub CheckBudgetParent {
154     my ( $new_parent, $budget ) = @_;
155     my $new_parent_id = $new_parent->{'budget_id'};
156     my $budget_id     = $budget->{'budget_id'};
157     my $dbh           = C4::Context->dbh;
158     my $parent_id_tmp = $new_parent_id;
159
160     # check new-parent is not a child (or a child's child ;)
161     my $sth = $dbh->prepare(qq|
162         SELECT budget_parent_id FROM
163             aqbudgets where budget_id = ? | );
164     while (1) {
165         $sth->execute($parent_id_tmp);
166         my $res = $sth->fetchrow_hashref;
167         if ( $res->{'budget_parent_id'} == $budget_id ) {
168             return 1;
169         }
170         if ( not defined $res->{'budget_parent_id'} ) {
171             return 0;
172         }
173         $parent_id_tmp = $res->{'budget_parent_id'};
174     }
175 }
176
177 # -------------------------------------------------------------------
178 sub BudgetHasChildren {
179     my ( $budget_id  ) = @_;
180     my $dbh = C4::Context->dbh;
181     my $sth = $dbh->prepare(qq|
182        SELECT count(*) as sum FROM  aqbudgets
183         WHERE budget_parent_id = ?   | );
184     $sth->execute( $budget_id );
185     my $sum = $sth->fetchrow_hashref;
186     return $sum->{'sum'};
187 }
188
189 sub GetBudgetChildren {
190     my ( $budget_id ) = @_;
191     my $dbh = C4::Context->dbh;
192     return $dbh->selectall_arrayref(q|
193        SELECT  * FROM  aqbudgets
194         WHERE budget_parent_id = ?
195     |, { Slice => {} }, $budget_id );
196 }
197
198 sub SetOwnerToFundHierarchy {
199     my ( $budget_id, $borrowernumber ) = @_;
200
201     my $budget = GetBudget( $budget_id );
202     $budget->{budget_owner_id} = $borrowernumber;
203     ModBudget( $budget );
204     my $children = GetBudgetChildren( $budget_id );
205     for my $child ( @$children ) {
206         SetOwnerToFundHierarchy( $child->{budget_id}, $borrowernumber );
207     }
208 }
209
210 # -------------------------------------------------------------------
211 sub GetBudgetsPlanCell {
212     my ( $cell, $period, $budget ) = @_; #FIXME we don't use $period
213     my ($actual, $sth);
214     my $dbh = C4::Context->dbh;
215     my $roundsql = C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|);
216     if ( $cell->{'authcat'} eq 'MONTHS' ) {
217         # get the actual amount
218         # FIXME we should consider quantity
219         $sth = $dbh->prepare( qq|
220
221             SELECT SUM(| .  $roundsql . qq|) AS actual FROM aqorders
222                 WHERE    budget_id = ? AND
223                 entrydate like "$cell->{'authvalue'}%"  |
224         );
225         $sth->execute( $cell->{'budget_id'} );
226     } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
227         # get the actual amount
228         # FIXME we should consider quantity
229         $sth = $dbh->prepare( qq|
230
231             SELECT SUM(| . $roundsql . qq|) FROM aqorders
232                 LEFT JOIN aqorders_items
233                 ON (aqorders.ordernumber = aqorders_items.ordernumber)
234                 LEFT JOIN items
235                 ON (aqorders_items.itemnumber = items.itemnumber)
236                 WHERE budget_id = ? AND homebranch = ? |          );
237
238         $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
239     } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
240         # get the actual amount
241         $sth = $dbh->prepare(  qq|
242
243             SELECT SUM( | . $roundsql . qq| *  quantity) AS actual
244                 FROM aqorders JOIN biblioitems
245                 ON (biblioitems.biblionumber = aqorders.biblionumber )
246                 WHERE aqorders.budget_id = ? and itemtype  = ? |
247         );
248         $sth->execute(  $cell->{'budget_id'},
249                         $cell->{'authvalue'} );
250     }
251     # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
252     else {
253         # get the actual amount
254         $sth = $dbh->prepare( qq|
255
256         SELECT  SUM(| . $roundsql . qq| * quantity) AS actual
257             FROM aqorders
258             JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
259             WHERE  aqorders.budget_id = ? AND
260                 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
261                 (aqbudgets.sort2_authcat = ? AND sort2 =?))    |
262         );
263         $sth->execute(  $cell->{'budget_id'},
264                         $budget->{'sort1_authcat'},
265                         $cell->{'authvalue'},
266                         $budget->{'sort2_authcat'},
267                         $cell->{'authvalue'}
268         );
269     }
270     $actual = $sth->fetchrow_array;
271
272     # get the estimated amount
273     $sth = $dbh->prepare( qq|
274
275         SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
276             WHERE budget_period_id = ? AND
277                 budget_id = ? AND
278                 authvalue = ? AND
279                 authcat = ?         |
280     );
281     $sth->execute(  $cell->{'budget_period_id'},
282                     $cell->{'budget_id'},
283                     $cell->{'authvalue'},
284                     $cell->{'authcat'},
285     );
286
287
288     my $res  = $sth->fetchrow_hashref;
289   #  my $display = $res->{'display'};
290     my $estimated = $res->{'estimated'};
291
292
293     return $actual, $estimated;
294 }
295
296 # -------------------------------------------------------------------
297 sub ModBudgetPlan {
298     my ( $budget_plan, $budget_period_id, $authcat ) = @_;
299     my $dbh = C4::Context->dbh;
300     foreach my $buds (@$budget_plan) {
301         my $lines = $buds->{lines};
302         my $sth = $dbh->prepare( qq|
303                 DELETE FROM aqbudgets_planning
304                     WHERE   budget_period_id   = ? AND
305                             budget_id   = ? AND
306                             authcat            = ? |
307         );
308     #delete a aqplan line of cells, then insert new cells, 
309     # these could be UPDATES rather than DEL/INSERTS...
310         $sth->execute( $budget_period_id,  $lines->[0]{budget_id}   , $authcat );
311
312         foreach my $cell (@$lines) {
313             my $sth = $dbh->prepare( qq|
314
315                 INSERT INTO aqbudgets_planning
316                      SET   budget_id     = ?,
317                      budget_period_id  = ?,
318                      authcat          = ?,
319                      estimated_amount  = ?,
320                      authvalue       = ?  |
321             );
322             $sth->execute(
323                             $cell->{'budget_id'},
324                             $cell->{'budget_period_id'},
325                             $cell->{'authcat'},
326                             $cell->{'estimated_amount'},
327                             $cell->{'authvalue'},
328             );
329         }
330     }
331 }
332
333 # -------------------------------------------------------------------
334 sub GetBudgetSpent {
335     my ($budget_id) = @_;
336     my $dbh = C4::Context->dbh;
337     # unitprice_tax_included should always been set here
338     # we should not need to retrieve ecost_tax_included
339     my $sth = $dbh->prepare(qq|
340         SELECT SUM( | . C4::Acquisition::get_rounding_sql("COALESCE(unitprice_tax_included, ecost_tax_included)") . qq| * quantity ) AS sum FROM aqorders
341             WHERE budget_id = ? AND
342             quantityreceived > 0 AND
343             datecancellationprinted IS NULL
344     |);
345         $sth->execute($budget_id);
346     my $sum = 0 + $sth->fetchrow_array;
347
348     $sth = $dbh->prepare(qq|
349         SELECT SUM(shipmentcost) AS sum
350         FROM aqinvoices
351         WHERE shipmentcost_budgetid = ?
352     |);
353
354     $sth->execute($budget_id);
355     my ($shipmentcost_sum) = $sth->fetchrow_array;
356     $sum += $shipmentcost_sum;
357
358     my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, closedate => { '!=' => undef } },{ join => 'invoiceid' });
359     while ( my $adj = $adjustments->next ){
360         $sum += $adj->adjustment;
361     }
362
363         return $sum;
364 }
365
366 # -------------------------------------------------------------------
367 sub GetBudgetOrdered {
368         my ($budget_id) = @_;
369         my $dbh = C4::Context->dbh;
370         my $sth = $dbh->prepare(qq|
371         SELECT SUM(| . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . qq| *  quantity) AS sum FROM aqorders
372             WHERE budget_id = ? AND
373             quantityreceived = 0 AND
374             datecancellationprinted IS NULL
375     |);
376         $sth->execute($budget_id);
377     my $sum =  0 + $sth->fetchrow_array;
378
379     my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, encumber_open => 1, closedate => undef},{ join => 'invoiceid' });
380     while ( my $adj = $adjustments->next ){
381         $sum += $adj->adjustment;
382     }
383
384         return $sum;
385 }
386
387 =head2 GetBudgetName
388
389   my $budget_name = &GetBudgetName($budget_id);
390
391 get the budget_name for a given budget_id
392
393 =cut
394
395 sub GetBudgetName {
396     my ( $budget_id ) = @_;
397     my $dbh         = C4::Context->dbh;
398     my $sth         = $dbh->prepare(
399         qq|
400         SELECT budget_name
401         FROM aqbudgets
402         WHERE budget_id = ?
403     |);
404
405     $sth->execute($budget_id);
406     return $sth->fetchrow_array;
407 }
408
409 =head2 GetBudgetAuthCats
410
411   my $auth_cats = &GetBudgetAuthCats($budget_period_id);
412
413 Return the list of authcat for a given budget_period_id
414
415 =cut
416
417 sub GetBudgetAuthCats  {
418     my ($budget_period_id) = shift;
419     # now, populate the auth_cats_loop used in the budget planning button
420     # we must retrieve all auth values used by at least one budget
421     my $dbh = C4::Context->dbh;
422     my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
423     $sth->execute($budget_period_id);
424     my %authcats;
425     while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
426         $authcats{$sort1_authcat}=1 if $sort1_authcat;
427         $authcats{$sort2_authcat}=1 if $sort2_authcat;
428     }
429     return [ sort keys %authcats ];
430 }
431
432 # -------------------------------------------------------------------
433 sub GetBudgetPeriods {
434         my ($filters,$orderby) = @_;
435
436     my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
437     $rs = $rs->search( $filters, { order_by => $orderby } );
438     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
439     return [ $rs->all ];
440 }
441 # -------------------------------------------------------------------
442 sub GetBudgetPeriod {
443     my ($budget_period_id) = @_;
444     my $dbh = C4::Context->dbh;
445     my $sth = $dbh->prepare( qq|
446         SELECT      *
447         FROM aqbudgetperiods
448         WHERE budget_period_id=? |
449     );
450     $sth->execute($budget_period_id);
451     return $sth->fetchrow_hashref;
452 }
453
454 sub DelBudgetPeriod{
455         my ($budget_period_id) = @_;
456         my $dbh = C4::Context->dbh;
457           ; ## $total = number of records linked to the record that must be deleted
458     my $total = 0;
459
460         ## get information about the record that will be deleted
461         my $sth = $dbh->prepare(qq|
462                 DELETE 
463          FROM aqbudgetperiods
464          WHERE budget_period_id=? |
465         );
466         return $sth->execute($budget_period_id);
467 }
468
469 # -------------------------------------------------------------------
470 sub ModBudgetPeriod {
471     my ($budget_period) = @_;
472     my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period);
473     return unless($result);
474
475     $result = $result->update($budget_period);
476     return $result->in_storage;
477 }
478
479 # -------------------------------------------------------------------
480 sub GetBudgetHierarchy {
481     my ( $budget_period_id, $branchcode, $owner ) = @_;
482     my @bind_params;
483     my $dbh   = C4::Context->dbh;
484     my $query = qq|
485                     SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description,
486                            b.firstname as budget_owner_firstname, b.surname as budget_owner_surname, b.borrowernumber as budget_owner_borrowernumber
487                     FROM aqbudgets 
488                     LEFT JOIN borrowers b on b.borrowernumber = aqbudgets.budget_owner_id
489                     JOIN aqbudgetperiods USING (budget_period_id)|;
490
491         my @where_strings;
492     # show only period X if requested
493     if ($budget_period_id) {
494         push @where_strings," aqbudgets.budget_period_id = ?";
495         push @bind_params, $budget_period_id;
496     }
497         # show only budgets owned by me, my branch or everyone
498     if ($owner) {
499         if ($branchcode) {
500             push @where_strings,
501             qq{ (budget_owner_id = ? OR budget_branchcode = ? OR ((budget_branchcode IS NULL or budget_branchcode="") AND (budget_owner_id IS NULL OR budget_owner_id="")))};
502             push @bind_params, ( $owner, $branchcode );
503         } else {
504             push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
505             push @bind_params, $owner;
506         }
507     } else {
508         if ($branchcode) {
509             push @where_strings," (budget_branchcode =? or budget_branchcode is NULL OR budget_branchcode='')";
510             push @bind_params, $branchcode;
511         }
512     }
513         $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
514         $debug && warn $query,join(",",@bind_params);
515         my $sth = $dbh->prepare($query);
516         $sth->execute(@bind_params);
517
518     my %links;
519     # create hash with budget_id has key
520     while ( my $data = $sth->fetchrow_hashref ) {
521         $links{ $data->{'budget_id'} } = $data;
522     }
523
524     # link child to parent
525     my @first_parents;
526     foreach my $budget ( sort { $a->{budget_code} cmp $b->{budget_code} } values %links ) {
527         my $child = $links{$budget->{budget_id}};
528         if ( $child->{'budget_parent_id'} ) {
529             my $parent = $links{ $child->{'budget_parent_id'} };
530             if ($parent) {
531                 unless ( $parent->{'children'} ) {
532                     # init child arrayref
533                     $parent->{'children'} = [];
534                 }
535                 # add as child
536                 push @{ $parent->{'children'} }, $child;
537             }
538         } else {
539             push @first_parents, $child;
540         }
541     }
542
543     my @sort = ();
544     foreach my $first_parent (@first_parents) {
545         _add_budget_children(\@sort, $first_parent, 0);
546     }
547
548     # Get all the budgets totals in as few queries as possible
549     my $hr_budget_spent = $dbh->selectall_hashref(q|
550         SELECT aqorders.budget_id, aqbudgets.budget_parent_id,
551                SUM( | . C4::Acquisition::get_rounding_sql(qq|COALESCE(unitprice_tax_included, ecost_tax_included)|) . q| * quantity ) AS budget_spent
552         FROM aqorders JOIN aqbudgets USING (budget_id)
553         WHERE quantityreceived > 0 AND datecancellationprinted IS NULL
554         GROUP BY budget_id, budget_parent_id
555         |, 'budget_id');
556     my $hr_budget_ordered = $dbh->selectall_hashref(q|
557         SELECT aqorders.budget_id, aqbudgets.budget_parent_id,
558                SUM( | . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . q| *  quantity) AS budget_ordered
559         FROM aqorders JOIN aqbudgets USING (budget_id)
560         WHERE quantityreceived = 0 AND datecancellationprinted IS NULL
561         GROUP BY budget_id, budget_parent_id
562         |, 'budget_id');
563     my $hr_budget_spent_shipment = $dbh->selectall_hashref(q|
564         SELECT shipmentcost_budgetid as budget_id,
565                SUM(shipmentcost) as shipmentcost
566         FROM aqinvoices
567         WHERE closedate IS NOT NULL
568         GROUP BY shipmentcost_budgetid
569         |, 'budget_id');
570     my $hr_budget_ordered_shipment = $dbh->selectall_hashref(q|
571         SELECT shipmentcost_budgetid as budget_id,
572                SUM(shipmentcost) as shipmentcost
573         FROM aqinvoices
574         WHERE closedate IS NULL
575         GROUP BY shipmentcost_budgetid
576         |, 'budget_id');
577     my $hr_budget_spent_adjustment = $dbh->selectall_hashref(q|
578         SELECT budget_id,
579                SUM(adjustment) as adjustments
580         FROM aqinvoice_adjustments
581         JOIN aqinvoices USING (invoiceid)
582         WHERE closedate IS NOT NULL
583         GROUP BY budget_id
584         |, 'budget_id');
585     my $hr_budget_ordered_adjustment = $dbh->selectall_hashref(q|
586         SELECT budget_id,
587                SUM(adjustment) as adjustments
588         FROM aqinvoice_adjustments
589         JOIN aqinvoices USING (invoiceid)
590         WHERE closedate IS NULL AND encumber_open = 1
591         GROUP BY budget_id
592         |, 'budget_id');
593
594
595     foreach my $budget (@sort) {
596         if ( not defined $budget->{budget_parent_id} ) {
597             _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 );
598         }
599     }
600     return \@sort;
601 }
602
603 sub _recursiveAdd {
604     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 ) = @_;
605
606     foreach my $child (@{$budget->{children}}){
607         _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 );
608     }
609
610     $budget->{budget_spent} += $hr_budget_spent->{$budget->{budget_id}}->{budget_spent};
611     $budget->{budget_spent} += $hr_budget_spent_shipment->{$budget->{budget_id}}->{shipmentcost};
612     $budget->{budget_spent} += $hr_budget_spent_adjustment->{$budget->{budget_id}}->{adjustments};
613     $budget->{budget_ordered} += $hr_budget_ordered->{$budget->{budget_id}}->{budget_ordered};
614     $budget->{budget_ordered} += $hr_budget_ordered_shipment->{$budget->{budget_id}}->{shipmentcost};
615     $budget->{budget_ordered} += $hr_budget_ordered_adjustment->{$budget->{budget_id}}->{adjustments};
616
617     $budget->{total_spent} += $budget->{budget_spent};
618     $budget->{total_ordered} += $budget->{budget_ordered};
619
620     if ($parent) {
621         $parent->{total_spent} += $budget->{total_spent};
622         $parent->{total_ordered} += $budget->{total_ordered};
623     }
624 }
625
626 # Recursive method to add a budget and its chidren to an array
627 sub _add_budget_children {
628     my $res = shift;
629     my $budget = shift;
630     $budget->{budget_level} = shift;
631     push @$res, $budget;
632     my $children = $budget->{'children'} || [];
633     return unless @$children; # break recursivity
634     foreach my $child (@$children) {
635         _add_budget_children($res, $child, $budget->{budget_level} + 1);
636     }
637 }
638
639 # -------------------------------------------------------------------
640
641 sub AddBudget {
642     my ($budget) = @_;
643     return unless ($budget);
644
645     undef $budget->{budget_encumb} if $budget->{budget_encumb} eq '';
646     undef $budget->{budget_owner_id} if $budget->{budget_owner_id} eq '';
647     my $resultset = Koha::Database->new()->schema->resultset('Aqbudget');
648     return $resultset->create($budget)->id;
649 }
650
651 # -------------------------------------------------------------------
652 sub ModBudget {
653     my ($budget) = @_;
654     my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget);
655     return unless($result);
656
657     undef $budget->{budget_encumb} if $budget->{budget_encumb} eq '';
658     undef $budget->{budget_owner_id} if $budget->{budget_owner_id} eq '';
659     $result = $result->update($budget);
660     return $result->in_storage;
661 }
662
663 # -------------------------------------------------------------------
664 sub DelBudget {
665         my ($budget_id) = @_;
666         my $dbh         = C4::Context->dbh;
667         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
668         my $rc          = $sth->execute($budget_id);
669         return $rc;
670 }
671
672
673 # -------------------------------------------------------------------
674
675 =head2 GetBudget
676
677   &GetBudget($budget_id);
678
679 get a specific budget
680
681 =cut
682
683 sub GetBudget {
684     my ( $budget_id ) = @_;
685     my $dbh = C4::Context->dbh;
686     my $query = "
687         SELECT *
688         FROM   aqbudgets
689         WHERE  budget_id=?
690         ";
691     my $sth = $dbh->prepare($query);
692     $sth->execute( $budget_id );
693     my $result = $sth->fetchrow_hashref;
694     return $result;
695 }
696
697 # -------------------------------------------------------------------
698
699 =head2 GetBudgetByOrderNumber
700
701   &GetBudgetByOrderNumber($ordernumber);
702
703 get a specific budget by order number
704
705 =cut
706
707 sub GetBudgetByOrderNumber {
708     my ( $ordernumber ) = @_;
709     my $dbh = C4::Context->dbh;
710     my $query = "
711         SELECT aqbudgets.*
712         FROM   aqbudgets, aqorders
713         WHERE  ordernumber=?
714         AND    aqorders.budget_id = aqbudgets.budget_id
715         ";
716     my $sth = $dbh->prepare($query);
717     $sth->execute( $ordernumber );
718     my $result = $sth->fetchrow_hashref;
719     return $result;
720 }
721
722 =head2 GetBudgetReport
723
724   &GetBudgetReport( [$budget_id] );
725
726 Get all orders for a specific budget, without cancelled orders.
727
728 Returns an array of hashrefs.
729
730 =cut
731
732 # --------------------------------------------------------------------
733 sub GetBudgetReport {
734     my ( $budget_id ) = @_;
735     my $dbh = C4::Context->dbh;
736     my $query = '
737         SELECT o.*, b.budget_name
738         FROM   aqbudgets b
739         INNER JOIN aqorders o
740         ON b.budget_id = o.budget_id
741         WHERE  b.budget_id=?
742         AND (o.orderstatus != "cancelled")
743         ORDER BY b.budget_name';
744
745     my $sth = $dbh->prepare($query);
746     $sth->execute( $budget_id );
747
748     my @results = ();
749     while ( my $data = $sth->fetchrow_hashref ) {
750         push( @results, $data );
751     }
752     return @results;
753 }
754
755 =head2 GetBudgetsByActivity
756
757   &GetBudgetsByActivity( $budget_period_active );
758
759 Get all active or inactive budgets, depending of the value
760 of the parameter.
761
762 1 = active
763 0 = inactive
764
765 =cut
766
767 # --------------------------------------------------------------------
768 sub GetBudgetsByActivity {
769     my ( $budget_period_active ) = @_;
770     my $dbh = C4::Context->dbh;
771     my $query = "
772         SELECT DISTINCT b.*
773         FROM   aqbudgetperiods bp
774         INNER JOIN aqbudgets b
775         ON bp.budget_period_id = b.budget_period_id
776         WHERE  bp.budget_period_active=?
777         ";
778     my $sth = $dbh->prepare($query);
779     $sth->execute( $budget_period_active );
780     my @results = ();
781     while ( my $data = $sth->fetchrow_hashref ) {
782         push( @results, $data );
783     }
784     return @results;
785 }
786 # --------------------------------------------------------------------
787
788 =head2 GetBudgetsReport
789
790   &GetBudgetsReport( [$activity] );
791
792 Get all but cancelled orders for all funds.
793
794 If the optionnal activity parameter is passed, returns orders for active/inactive budgets only.
795
796 active = 1
797 inactive = 0
798
799 Returns an array of hashrefs.
800
801 =cut
802
803 sub GetBudgetsReport {
804     my ($activity) = @_;
805     my $dbh = C4::Context->dbh;
806     my $query = '
807         SELECT o.*, b.budget_name
808         FROM   aqbudgetperiods bp
809         INNER JOIN aqbudgets b
810         ON bp.budget_period_id = b.budget_period_id
811         INNER JOIN aqorders o
812         ON b.budget_id = o.budget_id ';
813     if($activity ne ''){
814         $query .= 'WHERE  bp.budget_period_active=? ';
815     }
816     $query .= 'AND (o.orderstatus != "cancelled")
817                ORDER BY b.budget_name';
818
819     my $sth = $dbh->prepare($query);
820     if($activity ne ''){
821         $sth->execute($activity);
822     }
823     else{
824         $sth->execute;
825     }
826     my @results = ();
827     while ( my $data = $sth->fetchrow_hashref ) {
828         push( @results, $data );
829     }
830     return @results;
831 }
832
833 =head2 GetBudgetByCode
834
835     my $budget = &GetBudgetByCode($budget_code);
836
837 Retrieve all aqbudgets fields as a hashref for the budget that has
838 given budget_code
839
840 =cut
841
842 sub GetBudgetByCode {
843     my ( $budget_code ) = @_;
844
845     my $dbh = C4::Context->dbh;
846     my $query = qq{
847         SELECT aqbudgets.*
848         FROM aqbudgets
849         JOIN aqbudgetperiods USING (budget_period_id)
850         WHERE budget_code = ?
851         ORDER BY budget_period_active DESC, budget_id DESC
852         LIMIT 1
853     };
854     my $sth = $dbh->prepare( $query );
855     $sth->execute( $budget_code );
856     return $sth->fetchrow_hashref;
857 }
858
859 =head2 GetBudgetHierarchySpent
860
861   my $spent = GetBudgetHierarchySpent( $budget_id );
862
863 Gets the total spent of the level and sublevels of $budget_id
864
865 =cut
866
867 sub GetBudgetHierarchySpent {
868     my ( $budget_id ) = @_;
869     my $dbh = C4::Context->dbh;
870     my $children_ids = $dbh->selectcol_arrayref(q|
871         SELECT budget_id
872         FROM   aqbudgets
873         WHERE  budget_parent_id = ?
874     |, {}, $budget_id );
875
876     my $total_spent = GetBudgetSpent( $budget_id );
877     for my $child_id ( @$children_ids ) {
878         $total_spent += GetBudgetHierarchySpent( $child_id );
879     }
880     return $total_spent;
881 }
882
883 =head2 GetBudgetHierarchyOrdered
884
885   my $ordered = GetBudgetHierarchyOrdered( $budget_id );
886
887 Gets the total ordered of the level and sublevels of $budget_id
888
889 =cut
890
891 sub GetBudgetHierarchyOrdered {
892     my ( $budget_id ) = @_;
893     my $dbh = C4::Context->dbh;
894     my $children_ids = $dbh->selectcol_arrayref(q|
895         SELECT budget_id
896         FROM   aqbudgets
897         WHERE  budget_parent_id = ?
898     |, {}, $budget_id );
899
900     my $total_ordered = GetBudgetOrdered( $budget_id );
901     for my $child_id ( @$children_ids ) {
902         $total_ordered += GetBudgetHierarchyOrdered( $child_id );
903     }
904     return $total_ordered;
905 }
906
907 =head2 GetBudgets
908
909   &GetBudgets($filter, $order_by);
910
911 gets all budgets
912
913 =cut
914
915 # -------------------------------------------------------------------
916 sub GetBudgets {
917     my ($filters, $orderby) = @_;
918     $orderby = 'budget_name' unless($orderby);
919
920     my $rs = Koha::Database->new()->schema->resultset('Aqbudget');
921     $rs = $rs->search( $filters, { order_by => $orderby } );
922     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
923     return [ $rs->all  ];
924 }
925
926 =head2 GetBudgetUsers
927
928     my @borrowernumbers = &GetBudgetUsers($budget_id);
929
930 Return the list of borrowernumbers linked to a budget
931
932 =cut
933
934 sub GetBudgetUsers {
935     my ($budget_id) = @_;
936
937     my $dbh = C4::Context->dbh;
938     my $query = qq{
939         SELECT borrowernumber
940         FROM aqbudgetborrowers
941         WHERE budget_id = ?
942     };
943     my $sth = $dbh->prepare($query);
944     $sth->execute($budget_id);
945
946     my @borrowernumbers;
947     while (my ($borrowernumber) = $sth->fetchrow_array) {
948         push @borrowernumbers, $borrowernumber
949     }
950
951     return @borrowernumbers;
952 }
953
954 =head2 ModBudgetUsers
955
956     &ModBudgetUsers($budget_id, @borrowernumbers);
957
958 Modify the list of borrowernumbers linked to a budget
959
960 =cut
961
962 sub ModBudgetUsers {
963     my ($budget_id, @budget_users_id) = @_;
964
965     return unless $budget_id;
966
967     my $dbh = C4::Context->dbh;
968     my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
969     my $sth = $dbh->prepare($query);
970     $sth->execute($budget_id);
971
972     $query = qq{
973         INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
974         VALUES (?,?)
975     };
976     $sth = $dbh->prepare($query);
977     foreach my $borrowernumber (@budget_users_id) {
978         next unless $borrowernumber;
979         $sth->execute($budget_id, $borrowernumber);
980     }
981 }
982
983 sub CanUserUseBudget {
984     my ($borrower, $budget, $userflags) = @_;
985
986     if (not ref $borrower) {
987         $borrower = Koha::Patrons->find( $borrower );
988         return 0 unless $borrower;
989         $borrower = $borrower->unblessed;
990     }
991     if (not ref $budget) {
992         $budget = GetBudget($budget);
993     }
994
995     return 0 unless ($borrower and $budget);
996
997     if (not defined $userflags) {
998         $userflags = C4::Auth::getuserflags($borrower->{flags},
999             $borrower->{userid});
1000     }
1001
1002     unless ($userflags->{superlibrarian}
1003     || (ref $userflags->{acquisition}
1004         && $userflags->{acquisition}->{budget_manage_all})
1005     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
1006     {
1007         if (not exists $userflags->{acquisition}) {
1008             return 0;
1009         }
1010
1011         if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
1012             return 0;
1013         }
1014
1015         # Budget restricted to owner
1016         if ( $budget->{budget_permission} == 1 ) {
1017             if (    $budget->{budget_owner_id}
1018                 and $budget->{budget_owner_id} != $borrower->{borrowernumber} )
1019             {
1020                 return 0;
1021             }
1022         }
1023
1024         # Budget restricted to owner, users and library
1025         elsif ( $budget->{budget_permission} == 2 ) {
1026             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
1027
1028             if (
1029                 (
1030                         $budget->{budget_owner_id}
1031                     and $budget->{budget_owner_id} !=
1032                     $borrower->{borrowernumber}
1033                     or not $budget->{budget_owner_id}
1034                 )
1035                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
1036                     @budget_users )
1037                 and defined $budget->{budget_branchcode}
1038                 and $budget->{budget_branchcode} ne
1039                 C4::Context->userenv->{branch}
1040               )
1041             {
1042                 return 0;
1043             }
1044         }
1045
1046         # Budget restricted to owner and users
1047         elsif ( $budget->{budget_permission} == 3 ) {
1048             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
1049             if (
1050                 (
1051                         $budget->{budget_owner_id}
1052                     and $budget->{budget_owner_id} !=
1053                     $borrower->{borrowernumber}
1054                     or not $budget->{budget_owner_id}
1055                 )
1056                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
1057                     @budget_users )
1058               )
1059             {
1060                 return 0;
1061             }
1062         }
1063     }
1064
1065     return 1;
1066 }
1067
1068 sub CanUserModifyBudget {
1069     my ($borrower, $budget, $userflags) = @_;
1070
1071     if (not ref $borrower) {
1072         $borrower = Koha::Patrons->find( $borrower );
1073         return 0 unless $borrower;
1074         $borrower = $borrower->unblessed;
1075     }
1076     if (not ref $budget) {
1077         $budget = GetBudget($budget);
1078     }
1079
1080     return 0 unless ($borrower and $budget);
1081
1082     if (not defined $userflags) {
1083         $userflags = C4::Auth::getuserflags($borrower->{flags},
1084             $borrower->{userid});
1085     }
1086
1087     unless ($userflags->{superlibrarian}
1088     || (ref $userflags->{acquisition}
1089         && $userflags->{acquisition}->{budget_manage_all})
1090     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
1091     {
1092         if (!CanUserUseBudget($borrower, $budget, $userflags)) {
1093             return 0;
1094         }
1095
1096         if (ref $userflags->{acquisition}
1097         && !$userflags->{acquisition}->{budget_modify}) {
1098             return 0;
1099         }
1100     }
1101
1102     return 1;
1103 }
1104
1105 sub _round {
1106     my ($value, $increment) = @_;
1107
1108     if ($increment && $increment != 0) {
1109         $value = int($value / $increment) * $increment;
1110     }
1111
1112     return $value;
1113 }
1114
1115 =head2 CloneBudgetPeriod
1116
1117   my $new_budget_period_id = CloneBudgetPeriod({
1118     budget_period_id => $budget_period_id,
1119     budget_period_startdate => $budget_period_startdate,
1120     budget_period_enddate   => $budget_period_enddate,
1121     mark_original_budget_as_inactive => 1n
1122     reset_all_budgets => 1,
1123   });
1124
1125 Clone a budget period with all budgets.
1126 If the mark_origin_budget_as_inactive is set (0 by default),
1127 the original budget will be marked as inactive.
1128
1129 If the reset_all_budgets is set (0 by default), all budget (fund)
1130 amounts will be reset.
1131
1132 =cut
1133
1134 sub CloneBudgetPeriod {
1135     my ($params)                  = @_;
1136     my $budget_period_id          = $params->{budget_period_id};
1137     my $budget_period_startdate   = $params->{budget_period_startdate};
1138     my $budget_period_enddate     = $params->{budget_period_enddate};
1139     my $budget_period_description = $params->{budget_period_description};
1140     my $amount_change_percentage  = $params->{amount_change_percentage};
1141     my $amount_change_round_increment = $params->{amount_change_round_increment};
1142     my $mark_original_budget_as_inactive =
1143       $params->{mark_original_budget_as_inactive} || 0;
1144     my $reset_all_budgets = $params->{reset_all_budgets} || 0;
1145
1146     my $budget_period = GetBudgetPeriod($budget_period_id);
1147
1148     $budget_period->{budget_period_startdate}   = $budget_period_startdate;
1149     $budget_period->{budget_period_enddate}     = $budget_period_enddate;
1150     $budget_period->{budget_period_description} = $budget_period_description;
1151     # The new budget (budget_period) should be active by default
1152     $budget_period->{budget_period_active}    = 1;
1153
1154     if ($amount_change_percentage) {
1155         my $total = $budget_period->{budget_period_total};
1156         $total += $total * $amount_change_percentage / 100;
1157         $total = _round($total, $amount_change_round_increment);
1158         $budget_period->{budget_period_total} = $total;
1159     }
1160
1161     my $original_budget_period_id = $budget_period->{budget_period_id};
1162     delete $budget_period->{budget_period_id};
1163     my $new_budget_period_id = AddBudgetPeriod( $budget_period );
1164
1165     my $budgets = GetBudgetHierarchy($budget_period_id);
1166     CloneBudgetHierarchy(
1167         {
1168             budgets              => $budgets,
1169             new_budget_period_id => $new_budget_period_id
1170         }
1171     );
1172
1173     if ($mark_original_budget_as_inactive) {
1174         ModBudgetPeriod(
1175             {
1176                 budget_period_id     => $budget_period_id,
1177                 budget_period_active => 0,
1178             }
1179         );
1180     }
1181
1182     if ( $reset_all_budgets ) {
1183         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1184         for my $budget ( @$budgets ) {
1185             $budget->{budget_amount} = 0;
1186             ModBudget( $budget );
1187         }
1188     } elsif ($amount_change_percentage) {
1189         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1190         for my $budget ( @$budgets ) {
1191             my $amount = $budget->{budget_amount};
1192             $amount += $amount * $amount_change_percentage / 100;
1193             $amount = _round($amount, $amount_change_round_increment);
1194             $budget->{budget_amount} = $amount;
1195             ModBudget( $budget );
1196         }
1197     }
1198
1199     return $new_budget_period_id;
1200 }
1201
1202 =head2 CloneBudgetHierarchy
1203
1204   CloneBudgetHierarchy({
1205     budgets => $budgets,
1206     new_budget_period_id => $new_budget_period_id;
1207   });
1208
1209 Clone a budget hierarchy.
1210
1211 =cut
1212
1213 sub CloneBudgetHierarchy {
1214     my ($params)             = @_;
1215     my $budgets              = $params->{budgets};
1216     my $new_budget_period_id = $params->{new_budget_period_id};
1217     next unless @$budgets or $new_budget_period_id;
1218
1219     my $children_of   = $params->{children_of};
1220     my $new_parent_id = $params->{new_parent_id};
1221
1222     my @first_level_budgets =
1223       ( not defined $children_of )
1224       ? map { ( not $_->{budget_parent_id} )             ? $_ : () } @$budgets
1225       : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
1226
1227     # get only the columns of aqbudgets
1228     my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
1229
1230     for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
1231         @first_level_budgets )
1232     {
1233
1234         my $tidy_budget =
1235           { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
1236               keys %$budget };
1237         delete $tidy_budget->{timestamp};
1238         my $new_budget_id = AddBudget(
1239             {
1240                 %$tidy_budget,
1241                 budget_id        => undef,
1242                 budget_parent_id => $new_parent_id,
1243                 budget_period_id => $new_budget_period_id
1244             }
1245         );
1246         CloneBudgetHierarchy(
1247             {
1248                 budgets              => $budgets,
1249                 new_budget_period_id => $new_budget_period_id,
1250                 children_of          => $budget->{budget_id},
1251                 new_parent_id        => $new_budget_id
1252             }
1253         );
1254     }
1255 }
1256
1257 =head2 MoveOrders
1258
1259   my $report = MoveOrders({
1260     from_budget_period_id => $from_budget_period_id,
1261     to_budget_period_id   => $to_budget_period_id,
1262   });
1263
1264 Move orders from one budget period to another.
1265
1266 =cut
1267
1268 sub MoveOrders {
1269     my ($params)              = @_;
1270     my $from_budget_period_id = $params->{from_budget_period_id};
1271     my $to_budget_period_id   = $params->{to_budget_period_id};
1272     my $move_remaining_unspent = $params->{move_remaining_unspent};
1273     return
1274       if not $from_budget_period_id
1275           or not $to_budget_period_id
1276           or $from_budget_period_id == $to_budget_period_id;
1277
1278     # Can't move orders to an inactive budget (budgetperiod)
1279     my $budget_period = GetBudgetPeriod($to_budget_period_id);
1280     return unless $budget_period->{budget_period_active};
1281
1282     my @report;
1283     my $dbh     = C4::Context->dbh;
1284     my $sth_update_aqorders = $dbh->prepare(
1285         q|
1286             UPDATE aqorders
1287             SET budget_id = ?
1288             WHERE ordernumber = ?
1289         |
1290     );
1291     my $sth_update_budget_amount = $dbh->prepare(
1292         q|
1293             UPDATE aqbudgets
1294             SET budget_amount = ?
1295             WHERE budget_id = ?
1296         |
1297     );
1298     my $from_budgets = GetBudgetHierarchy($from_budget_period_id);
1299     for my $from_budget (@$from_budgets) {
1300         my $new_budget_id = $dbh->selectcol_arrayref(
1301             q|
1302                 SELECT budget_id
1303                 FROM aqbudgets
1304                 WHERE budget_period_id = ?
1305                     AND budget_code = ?
1306             |, {}, $to_budget_period_id, $from_budget->{budget_code}
1307         );
1308         $new_budget_id = $new_budget_id->[0];
1309         my $new_budget = GetBudget( $new_budget_id );
1310         unless ( $new_budget ) {
1311             push @report,
1312               {
1313                 moved       => 0,
1314                 budget      => $from_budget,
1315                 error       => 'budget_code_not_exists',
1316               };
1317             next;
1318         }
1319         my $orders_to_move = C4::Acquisition::SearchOrders(
1320             {
1321                 budget_id => $from_budget->{budget_id},
1322                 pending   => 1,
1323             }
1324         );
1325
1326         my @orders_moved;
1327         for my $order (@$orders_to_move) {
1328             $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} );
1329             push @orders_moved, $order;
1330         }
1331
1332         my $unspent_moved = 0;
1333         if ($move_remaining_unspent) {
1334             my $spent   = GetBudgetHierarchySpent( $from_budget->{budget_id} );
1335             my $unspent = $from_budget->{budget_amount} - $spent;
1336             my $new_budget_amount = $new_budget->{budget_amount};
1337             if ( $unspent > 0 ) {
1338                 $new_budget_amount += $unspent;
1339                 $unspent_moved = $unspent;
1340             }
1341             $new_budget->{budget_amount} = $new_budget_amount;
1342             $sth_update_budget_amount->execute( $new_budget_amount,
1343                 $new_budget->{budget_id} );
1344         }
1345
1346         push @report,
1347           {
1348             budget        => $new_budget,
1349             orders_moved  => \@orders_moved,
1350             moved         => 1,
1351             unspent_moved => $unspent_moved,
1352           };
1353     }
1354     return \@report;
1355 }
1356
1357 END { }    # module clean-up code here (global destructor)
1358
1359 1;
1360 __END__
1361
1362 =head1 AUTHOR
1363
1364 Koha Development Team <http://koha-community.org/>
1365
1366 =cut