bug 8215: (followup) make sure C4::CourseReserves doesn't export anything
[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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use strict;
21 #use warnings; FIXME - Bug 2505
22 use C4::Context;
23 use C4::Dates qw(format_date format_date_in_iso);
24 use C4::SQLHelper qw<:all>;
25 use C4::Debug;
26
27 use vars qw($VERSION @ISA @EXPORT);
28
29 BEGIN {
30         # set the version for version checking
31     $VERSION = 3.07.00.049;
32         require Exporter;
33         @ISA    = qw(Exporter);
34         @EXPORT = qw(
35
36         &GetBudget
37         &GetBudgets
38         &GetBudgetHierarchy
39             &AddBudget
40         &ModBudget
41         &DelBudget
42         &GetBudgetSpent
43         &GetBudgetOrdered
44         &GetBudgetName
45         &GetPeriodsCount
46         &GetChildBudgetsSpent
47
48         &GetBudgetUsers
49         &ModBudgetUsers
50         &CanUserUseBudget
51         &CanUserModifyBudget
52
53             &GetBudgetPeriod
54         &GetBudgetPeriods
55         &ModBudgetPeriod
56         &AddBudgetPeriod
57             &DelBudgetPeriod
58
59         &GetAuthvalueDropbox
60
61         &ModBudgetPlan
62
63         &GetCurrency
64         &GetCurrencies
65         &ModCurrencies
66         &ConvertCurrency
67         
68                 &GetBudgetsPlanCell
69         &AddBudgetPlanValue
70         &GetBudgetAuthCats
71         &BudgetHasChildren
72         &CheckBudgetParent
73         &CheckBudgetParentPerm
74
75         &HideCols
76         &GetCols
77         );
78 }
79
80 # ----------------------------BUDGETS.PM-----------------------------";
81
82
83 =head1 FUNCTIONS ABOUT BUDGETS
84
85 =cut
86
87 sub HideCols {
88     my ( $authcat, @hide_cols ) = @_;
89     my $dbh = C4::Context->dbh;
90
91     my $sth1 = $dbh->prepare(
92         qq|
93         UPDATE aqbudgets_planning SET display = 0 
94         WHERE authcat = ? 
95         AND  authvalue = ? |
96     );
97     foreach my $authvalue (@hide_cols) {
98 #        $sth1->{TraceLevel} = 3;
99         $sth1->execute(  $authcat, $authvalue );
100     }
101 }
102
103 sub GetCols {
104     my ( $authcat, $authvalue ) = @_;
105
106     my $dbh = C4::Context->dbh;
107     my $sth = $dbh->prepare(
108         qq|
109         SELECT count(display) as cnt from aqbudgets_planning
110         WHERE  authcat = ? 
111         AND authvalue = ? and display  = 0   |
112     );
113
114 #    $sth->{TraceLevel} = 3;
115     $sth->execute( $authcat, $authvalue );
116     my $res  = $sth->fetchrow_hashref;
117
118     return  $res->{cnt} > 0 ? 0: 1
119
120 }
121
122 sub CheckBudgetParentPerm {
123     my ( $budget, $borrower_id ) = @_;
124     my $depth = $budget->{depth};
125     my $parent_id = $budget->{budget_parent_id};
126     while ($depth) {
127         my $parent = GetBudget($parent_id);
128         $parent_id = $parent->{budget_parent_id};
129         if ( $parent->{budget_owner_id} == $borrower_id ) {
130             return 1;
131         }
132         $depth--
133     }
134     return 0;
135 }
136
137 sub AddBudgetPeriod {
138     my ($budgetperiod) = @_;
139         return InsertInTable("aqbudgetperiods",$budgetperiod);
140 }
141 # -------------------------------------------------------------------
142 sub GetPeriodsCount {
143     my $dbh = C4::Context->dbh;
144     my $sth = $dbh->prepare("
145         SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
146     $sth->execute();
147     my $res = $sth->fetchrow_hashref;
148     return $res->{'sum'};
149 }
150
151 # -------------------------------------------------------------------
152 sub CheckBudgetParent {
153     my ( $new_parent, $budget ) = @_;
154     my $new_parent_id = $new_parent->{'budget_id'};
155     my $budget_id     = $budget->{'budget_id'};
156     my $dbh           = C4::Context->dbh;
157     my $parent_id_tmp = $new_parent_id;
158
159     # check new-parent is not a child (or a child's child ;)
160     my $sth = $dbh->prepare(qq|
161         SELECT budget_parent_id FROM
162             aqbudgets where budget_id = ? | );
163     while (1) {
164         $sth->execute($parent_id_tmp);
165         my $res = $sth->fetchrow_hashref;
166         if ( $res->{'budget_parent_id'} == $budget_id ) {
167             return 1;
168         }
169         if ( not defined $res->{'budget_parent_id'} ) {
170             return 0;
171         }
172         $parent_id_tmp = $res->{'budget_parent_id'};
173     }
174 }
175
176 # -------------------------------------------------------------------
177 sub BudgetHasChildren {
178     my ( $budget_id  ) = @_;
179     my $dbh = C4::Context->dbh;
180     my $sth = $dbh->prepare(qq|
181        SELECT count(*) as sum FROM  aqbudgets
182         WHERE budget_parent_id = ?   | );
183     $sth->execute( $budget_id );
184     my $sum = $sth->fetchrow_hashref;
185     return $sum->{'sum'};
186 }
187
188 # -------------------------------------------------------------------
189 sub GetBudgetsPlanCell {
190     my ( $cell, $period, $budget ) = @_;
191     my ($actual, $sth);
192     my $dbh = C4::Context->dbh;
193     if ( $cell->{'authcat'} eq 'MONTHS' ) {
194         # get the actual amount
195         $sth = $dbh->prepare( qq|
196
197             SELECT SUM(ecost) AS actual FROM aqorders
198                 WHERE    budget_id = ? AND
199                 entrydate like "$cell->{'authvalue'}%"  |
200         );
201         $sth->execute( $cell->{'budget_id'} );
202     } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
203         # get the actual amount
204         $sth = $dbh->prepare( qq|
205
206             SELECT SUM(ecost) FROM aqorders
207                 LEFT JOIN aqorders_items
208                 ON (aqorders.ordernumber = aqorders_items.ordernumber)
209                 LEFT JOIN items
210                 ON (aqorders_items.itemnumber = items.itemnumber)
211                 WHERE budget_id = ? AND homebranch = ? |          );
212
213         $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
214     } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
215         # get the actual amount
216         $sth = $dbh->prepare(  qq|
217
218             SELECT SUM( ecost *  quantity) AS actual
219                 FROM aqorders JOIN biblioitems
220                 ON (biblioitems.biblionumber = aqorders.biblionumber )
221                 WHERE aqorders.budget_id = ? and itemtype  = ? |
222         );
223         $sth->execute(  $cell->{'budget_id'},
224                         $cell->{'authvalue'} );
225     }
226     # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
227     else {
228         # get the actual amount
229         $sth = $dbh->prepare( qq|
230
231         SELECT  SUM(ecost * quantity) AS actual
232             FROM aqorders
233             JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
234             WHERE  aqorders.budget_id = ? AND
235                 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
236                 (aqbudgets.sort2_authcat = ? AND sort2 =?))    |
237         );
238         $sth->execute(  $cell->{'budget_id'},
239                         $budget->{'sort1_authcat'},
240                         $cell->{'authvalue'},
241                         $budget->{'sort2_authcat'},
242                         $cell->{'authvalue'}
243         );
244     }
245     $actual = $sth->fetchrow_array;
246
247     # get the estimated amount
248     $sth = $dbh->prepare( qq|
249
250         SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
251             WHERE budget_period_id = ? AND
252                 budget_id = ? AND
253                 authvalue = ? AND
254                 authcat = ?         |
255     );
256     $sth->execute(  $cell->{'budget_period_id'},
257                     $cell->{'budget_id'},
258                     $cell->{'authvalue'},
259                     $cell->{'authcat'},
260     );
261
262
263     my $res  = $sth->fetchrow_hashref;
264   #  my $display = $res->{'display'};
265     my $estimated = $res->{'estimated'};
266
267
268     return $actual, $estimated;
269 }
270
271 # -------------------------------------------------------------------
272 sub ModBudgetPlan {
273     my ( $budget_plan, $budget_period_id, $authcat ) = @_;
274     my $dbh = C4::Context->dbh;
275     foreach my $buds (@$budget_plan) {
276         my $lines = $buds->{lines};
277         my $sth = $dbh->prepare( qq|
278                 DELETE FROM aqbudgets_planning
279                     WHERE   budget_period_id   = ? AND
280                             budget_id   = ? AND
281                             authcat            = ? |
282         );
283     #delete a aqplan line of cells, then insert new cells, 
284     # these could be UPDATES rather than DEL/INSERTS...
285         $sth->execute( $budget_period_id,  $lines->[0]{budget_id}   , $authcat );
286
287         foreach my $cell (@$lines) {
288             my $sth = $dbh->prepare( qq|
289
290                 INSERT INTO aqbudgets_planning
291                      SET   budget_id     = ?,
292                      budget_period_id  = ?,
293                      authcat          = ?,
294                      estimated_amount  = ?,
295                      authvalue       = ?  |
296             );
297             $sth->execute(
298                             $cell->{'budget_id'},
299                             $cell->{'budget_period_id'},
300                             $cell->{'authcat'},
301                             $cell->{'estimated_amount'},
302                             $cell->{'authvalue'},
303             );
304         }
305     }
306 }
307
308 # -------------------------------------------------------------------
309 sub GetBudgetSpent {
310         my ($budget_id) = @_;
311         my $dbh = C4::Context->dbh;
312         my $sth = $dbh->prepare(qq|
313         SELECT SUM( COALESCE(unitprice, ecost) * quantity ) AS sum FROM aqorders
314             WHERE budget_id = ? AND
315             quantityreceived > 0 AND
316             datecancellationprinted IS NULL
317     |);
318         $sth->execute($budget_id);
319         my $sum =  $sth->fetchrow_array;
320
321     $sth = $dbh->prepare(qq|
322         SELECT SUM(shipmentcost) AS sum
323         FROM aqinvoices
324         WHERE shipmentcost_budgetid = ?
325           AND closedate IS NOT NULL
326     |);
327     $sth->execute($budget_id);
328     my ($shipmentcost_sum) = $sth->fetchrow_array;
329     $sum += $shipmentcost_sum;
330
331         return $sum;
332 }
333
334 # -------------------------------------------------------------------
335 sub GetBudgetOrdered {
336         my ($budget_id) = @_;
337         my $dbh = C4::Context->dbh;
338         my $sth = $dbh->prepare(qq|
339         SELECT SUM(ecost *  quantity) AS sum FROM aqorders
340             WHERE budget_id = ? AND
341             quantityreceived = 0 AND
342             datecancellationprinted IS NULL
343     |);
344         $sth->execute($budget_id);
345         my $sum =  $sth->fetchrow_array;
346
347     $sth = $dbh->prepare(qq|
348         SELECT SUM(shipmentcost) AS sum
349         FROM aqinvoices
350         WHERE shipmentcost_budgetid = ?
351           AND closedate IS NULL
352     |);
353     $sth->execute($budget_id);
354     my ($shipmentcost_sum) = $sth->fetchrow_array;
355     $sum += $shipmentcost_sum;
356
357         return $sum;
358 }
359
360 =head2 GetBudgetName
361
362   my $budget_name = &GetBudgetName($budget_id);
363
364 get the budget_name for a given budget_id
365
366 =cut
367
368 sub GetBudgetName {
369     my ( $budget_id ) = @_;
370     my $dbh         = C4::Context->dbh;
371     my $sth         = $dbh->prepare(
372         qq|
373         SELECT budget_name
374         FROM aqbudgets
375         WHERE budget_id = ?
376     |);
377
378     $sth->execute($budget_id);
379     return $sth->fetchrow_array;
380 }
381
382 # -------------------------------------------------------------------
383 sub GetBudgetAuthCats  {
384     my ($budget_period_id) = shift;
385     # now, populate the auth_cats_loop used in the budget planning button
386     # we must retrieve all auth values used by at least one budget
387     my $dbh = C4::Context->dbh;
388     my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
389     $sth->execute($budget_period_id);
390     my %authcats;
391     while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
392         $authcats{$sort1_authcat}=1;
393         $authcats{$sort2_authcat}=1;
394     }
395     my @auth_cats_loop;
396     foreach (sort keys %authcats) {
397         push @auth_cats_loop,{ authcat => $_ };
398     }
399     return \@auth_cats_loop;
400 }
401
402 # -------------------------------------------------------------------
403 sub GetAuthvalueDropbox {
404     my ( $authcat, $default ) = @_;
405     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
406     my $dbh = C4::Context->dbh;
407
408     my $query = qq{
409         SELECT *
410         FROM authorised_values
411     };
412     $query .= qq{
413           LEFT JOIN authorised_values_branches ON ( id = av_id )
414     } if $branch_limit;
415     $query .= qq{
416         WHERE category = ?
417     };
418     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
419     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
420     my $sth = $dbh->prepare($query);
421     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
422
423
424     my $option_list = [];
425     my @authorised_values = ( q{} );
426     while (my $av = $sth->fetchrow_hashref) {
427         push @{$option_list}, {
428             value => $av->{authorised_value},
429             label => $av->{lib},
430             default => ($default eq $av->{authorised_value}),
431         };
432     }
433
434     if ( @{$option_list} ) {
435         return $option_list;
436     }
437     return;
438 }
439
440 # -------------------------------------------------------------------
441 sub GetBudgetPeriods {
442         my ($filters,$orderby) = @_;
443     return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide");
444 }
445 # -------------------------------------------------------------------
446 sub GetBudgetPeriod {
447         my ($budget_period_id) = @_;
448         my $dbh = C4::Context->dbh;
449         ## $total = number of records linked to the record that must be deleted
450         my $total = 0;
451         ## get information about the record that will be deleted
452         my $sth;
453         if ($budget_period_id) {
454                 $sth = $dbh->prepare( qq|
455               SELECT      *
456                 FROM aqbudgetperiods
457                 WHERE budget_period_id=? |
458                 );
459                 $sth->execute($budget_period_id);
460         } else {         # ACTIVE BUDGET
461                 $sth = $dbh->prepare(qq|
462                           SELECT      *
463                 FROM aqbudgetperiods
464                 WHERE budget_period_active=1 |
465                 );
466                 $sth->execute();
467         }
468         my $data = $sth->fetchrow_hashref;
469         return $data;
470 }
471
472 # -------------------------------------------------------------------
473 sub DelBudgetPeriod{
474         my ($budget_period_id) = @_;
475         my $dbh = C4::Context->dbh;
476           ; ## $total = number of records linked to the record that must be deleted
477     my $total = 0;
478
479         ## get information about the record that will be deleted
480         my $sth = $dbh->prepare(qq|
481                 DELETE 
482          FROM aqbudgetperiods
483          WHERE budget_period_id=? |
484         );
485         return $sth->execute($budget_period_id);
486 }
487
488 # -------------------------------------------------------------------
489 sub ModBudgetPeriod {
490         my ($budget_period_information) = @_;
491         return UpdateInTable("aqbudgetperiods",$budget_period_information);
492 }
493
494 # -------------------------------------------------------------------
495 sub GetBudgetHierarchy {
496     my ( $budget_period_id, $branchcode, $owner ) = @_;
497     my @bind_params;
498     my $dbh   = C4::Context->dbh;
499     my $query = qq|
500                     SELECT aqbudgets.*, aqbudgetperiods.budget_period_active
501                     FROM aqbudgets 
502                     JOIN aqbudgetperiods USING (budget_period_id)|;
503                         
504         my @where_strings;
505     # show only period X if requested
506     if ($budget_period_id) {
507         push @where_strings," aqbudgets.budget_period_id = ?";
508         push @bind_params, $budget_period_id;
509     }
510         # show only budgets owned by me, my branch or everyone
511     if ($owner) {
512         if ($branchcode) {
513             push @where_strings,
514             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="")))};
515             push @bind_params, ( $owner, $branchcode );
516         } else {
517             push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
518             push @bind_params, $owner;
519         }
520     } else {
521         if ($branchcode) {
522             push @where_strings," (budget_branchcode =? or budget_branchcode is NULL)";
523             push @bind_params, $branchcode;
524         }
525     }
526         $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
527         $debug && warn $query,join(",",@bind_params);
528         my $sth = $dbh->prepare($query);
529         $sth->execute(@bind_params);
530         my $results = $sth->fetchall_arrayref({});
531         my @res     = @$results;
532         my $i = 0;
533         while (1) {
534                 my $depth_cnt = 0;
535                 foreach my $r (@res) {
536                         my @child;
537                         # look for children
538                         $r->{depth} = '0' if !defined $r->{budget_parent_id};
539                         foreach my $r2 (@res) {
540                                 if (defined $r2->{budget_parent_id}
541                                         && $r2->{budget_parent_id} == $r->{budget_id}) {
542                                         push @child, $r2->{budget_id};
543                                         $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
544                                 }
545                         }
546                         $r->{child} = \@child if scalar @child > 0;    # add the child
547                         $depth_cnt++ if !defined $r->{'depth'};
548                 }
549                 last if ($depth_cnt == 0 || $i == 100);
550                 $i++;
551         }
552
553         # look for top parents 1st
554         my (@sort, $depth_count);
555         ($i, $depth_count) = 0;
556         while (1) {
557                 my $children = 0;
558                 foreach my $r (@res) {
559                         if ($r->{depth} == $depth_count) {
560                                 $children++ if (ref $r->{child} eq 'ARRAY');
561
562                                 # find the parent id element_id and insert it after
563                                 my $i2 = 0;
564                                 my $parent;
565                                 if ($depth_count > 0) {
566
567                                         # add indent
568                                         my $depth = $r->{depth} * 2;
569                                         $r->{budget_code_indent} = $r->{budget_code};
570                                         $r->{budget_name_indent} = $r->{budget_name};
571                                         foreach my $r3 (@sort) {
572                                                 if ($r3->{budget_id} == $r->{budget_parent_id}) {
573                                                         $parent = $i2;
574                                                         last;
575                                                 }
576                                                 $i2++;
577                                         }
578                                 } else {
579                                         $r->{budget_code_indent} = $r->{budget_code};
580                                         $r->{budget_name_indent} = $r->{budget_name};
581                                 }
582                 
583                                 if (defined $parent) {
584                                         splice @sort, ($parent + 1), 0, $r;
585                                 } else {
586                                         push @sort, $r;
587                                 }
588                         }
589
590                         $i++;
591                 }    # --------------foreach
592                 $depth_count++;
593                 last if $children == 0;
594         }
595
596 # add budget-percent and allocation, and flags for html-template
597         foreach my $r (@sort) {
598                 my $subs_href = $r->{'child'};
599         my @subs_arr = ();
600         if ( defined $subs_href ) {
601             @subs_arr = @{$subs_href};
602         }
603
604         my $moo = $r->{'budget_code_indent'};
605         $moo =~ s/\ /\&nbsp\;/g;
606         $r->{'budget_code_indent'} =  $moo;
607
608         $moo = $r->{'budget_name_indent'};
609         $moo =~ s/\ /\&nbsp\;/g;
610         $r->{'budget_name_indent'} = $moo;
611
612         $r->{'budget_spent'}       = GetBudgetSpent( $r->{'budget_id'} );
613
614         $r->{'budget_amount_total'} =  $r->{'budget_amount'};
615
616         # foreach sub-levels
617         my $unalloc_count ;
618
619                 foreach my $sub (@subs_arr) {
620                         my $sub_budget = GetBudget($sub);
621
622                         $r->{budget_spent_sublevel} +=    GetBudgetSpent( $sub_budget->{'budget_id'} );
623                         $unalloc_count +=   $sub_budget->{'budget_amount'};
624                 }
625         }
626         return \@sort;
627 }
628
629 # -------------------------------------------------------------------
630
631 sub AddBudget {
632     my ($budget) = @_;
633         return InsertInTable("aqbudgets",$budget);
634 }
635
636 # -------------------------------------------------------------------
637 sub ModBudget {
638     my ($budget) = @_;
639         return UpdateInTable("aqbudgets",$budget);
640 }
641
642 # -------------------------------------------------------------------
643 sub DelBudget {
644         my ($budget_id) = @_;
645         my $dbh         = C4::Context->dbh;
646         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
647         my $rc          = $sth->execute($budget_id);
648         return $rc;
649 }
650
651
652 =head2 GetBudget
653
654   &GetBudget($budget_id);
655
656 get a specific budget
657
658 =cut
659
660 # -------------------------------------------------------------------
661 sub GetBudget {
662     my ( $budget_id ) = @_;
663     my $dbh = C4::Context->dbh;
664     my $query = "
665         SELECT *
666         FROM   aqbudgets
667         WHERE  budget_id=?
668         ";
669     my $sth = $dbh->prepare($query);
670     $sth->execute( $budget_id );
671     my $result = $sth->fetchrow_hashref;
672     return $result;
673 }
674
675 =head2 GetChildBudgetsSpent
676
677   &GetChildBudgetsSpent($budget-id);
678
679 gets the total spent of the level and sublevels of $budget_id
680
681 =cut
682
683 # -------------------------------------------------------------------
684 sub GetChildBudgetsSpent {
685     my ( $budget_id ) = @_;
686     my $dbh = C4::Context->dbh;
687     my $query = "
688         SELECT *
689         FROM   aqbudgets
690         WHERE  budget_parent_id=?
691         ";
692     my $sth = $dbh->prepare($query);
693     $sth->execute( $budget_id );
694     my $result = $sth->fetchall_arrayref({});
695     my $total_spent = GetBudgetSpent($budget_id);
696     if ($result){
697         $total_spent += GetChildBudgetsSpent($_->{"budget_id"}) foreach @$result;    
698     }
699     return $total_spent;
700 }
701
702 =head2 GetBudgets
703
704   &GetBudgets($filter, $order_by);
705
706 gets all budgets
707
708 =cut
709
710 # -------------------------------------------------------------------
711 sub GetBudgets {
712     my ($filters,$orderby) = @_;
713     return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide");
714 }
715
716 =head2 GetBudgetUsers
717
718     my @borrowernumbers = &GetBudgetUsers($budget_id);
719
720 Return the list of borrowernumbers linked to a budget
721
722 =cut
723
724 sub GetBudgetUsers {
725     my ($budget_id) = @_;
726
727     my $dbh = C4::Context->dbh;
728     my $query = qq{
729         SELECT borrowernumber
730         FROM aqbudgetborrowers
731         WHERE budget_id = ?
732     };
733     my $sth = $dbh->prepare($query);
734     $sth->execute($budget_id);
735
736     my @borrowernumbers;
737     while (my ($borrowernumber) = $sth->fetchrow_array) {
738         push @borrowernumbers, $borrowernumber
739     }
740
741     return @borrowernumbers;
742 }
743
744 =head2 ModBudgetUsers
745
746     &ModBudgetUsers($budget_id, @borrowernumbers);
747
748 Modify the list of borrowernumbers linked to a budget
749
750 =cut
751
752 sub ModBudgetUsers {
753     my ($budget_id, @budget_users_id) = @_;
754
755     return unless $budget_id;
756
757     my $dbh = C4::Context->dbh;
758     my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
759     my $sth = $dbh->prepare($query);
760     $sth->execute($budget_id);
761
762     $query = qq{
763         INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
764         VALUES (?,?)
765     };
766     $sth = $dbh->prepare($query);
767     foreach my $borrowernumber (@budget_users_id) {
768         next unless $borrowernumber;
769         $sth->execute($budget_id, $borrowernumber);
770     }
771 }
772
773 sub CanUserUseBudget {
774     my ($borrower, $budget, $userflags) = @_;
775
776     if (not ref $borrower) {
777         $borrower = C4::Members::GetMember(borrowernumber => $borrower);
778     }
779     if (not ref $budget) {
780         $budget = GetBudget($budget);
781     }
782
783     return 0 unless ($borrower and $budget);
784
785     if (not defined $userflags) {
786         $userflags = C4::Auth::getuserflags($borrower->{flags},
787             $borrower->{userid});
788     }
789
790     unless ($userflags->{superlibrarian}
791     || (ref $userflags->{acquisition}
792         && $userflags->{acquisition}->{budget_manage_all})
793     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
794     {
795         if (not exists $userflags->{acquisition}) {
796             return 0;
797         }
798
799         if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
800             return 0;
801         }
802
803         # Budget restricted to owner
804         if ($budget->{budget_permission} == 1
805         && $budget->{budget_owner_id}
806         && $budget->{budget_owner_id} != $borrower->{borrowernumber}) {
807             return 0;
808         }
809
810         my @budget_users = GetBudgetUsers($budget->{budget_id});
811
812         # Budget restricted to owner, users and library
813         if ($budget->{budget_permission} == 2
814         && $budget->{budget_owner_id}
815         && $budget->{budget_owner_id} != $borrower->{borrowernumber}
816         && (0 == grep {$borrower->{borrowernumber} == $_} @budget_users)
817         && defined $budget->{budget_branchcode}
818         && $budget->{budget_branchcode} ne C4::Context->userenv->{branch}) {
819             return 0;
820         }
821
822         # Budget restricted to owner and users
823         if ($budget->{budget_permission} == 3
824         && $budget->{budget_owner_id}
825         && $budget->{budget_owner_id} != $borrower->{borrowernumber}
826         && (0 == grep {$borrower->{borrowernumber} == $_} @budget_users)) {
827             return 0;
828         }
829     }
830
831     return 1;
832 }
833
834 sub CanUserModifyBudget {
835     my ($borrower, $budget, $userflags) = @_;
836
837     if (not ref $borrower) {
838         $borrower = C4::Members::GetMember(borrowernumber => $borrower);
839     }
840     if (not ref $budget) {
841         $budget = GetBudget($budget);
842     }
843
844     return 0 unless ($borrower and $budget);
845
846     if (not defined $userflags) {
847         $userflags = C4::Auth::getuserflags($borrower->{flags},
848             $borrower->{userid});
849     }
850
851     unless ($userflags->{superlibrarian}
852     || (ref $userflags->{acquisition}
853         && $userflags->{acquisition}->{budget_manage_all})
854     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
855     {
856         if (!CanUserUseBudget($borrower, $budget, $userflags)) {
857             return 0;
858         }
859
860         if (ref $userflags->{acquisition}
861         && !$userflags->{acquisition}->{budget_modify}) {
862             return 0;
863         }
864     }
865
866     return 1;
867 }
868
869 # -------------------------------------------------------------------
870
871 =head2 GetCurrencies
872
873   @currencies = &GetCurrencies;
874
875 Returns the list of all known currencies.
876
877 C<$currencies> is a array; its elements are references-to-hash, whose
878 keys are the fields from the currency table in the Koha database.
879
880 =cut
881
882 sub GetCurrencies {
883     my $dbh   = C4::Context->dbh;
884     my $query = "
885         SELECT *
886         FROM   currency
887     ";
888     my $sth = $dbh->prepare($query);
889     $sth->execute;
890     my @results = ();
891     while ( my $data = $sth->fetchrow_hashref ) {
892         push( @results, $data );
893     }
894     return @results;
895 }
896
897 # -------------------------------------------------------------------
898
899 sub GetCurrency {
900     my $dbh   = C4::Context->dbh;
901     my $query = "
902         SELECT * FROM currency where active = '1'    ";
903     my $sth = $dbh->prepare($query);
904     $sth->execute;
905     my $r = $sth->fetchrow_hashref;
906     return $r;
907 }
908
909 =head2 ModCurrencies
910
911 &ModCurrencies($currency, $newrate);
912
913 Sets the exchange rate for C<$currency> to be C<$newrate>.
914
915 =cut
916
917 sub ModCurrencies {
918     my ( $currency, $rate ) = @_;
919     my $dbh   = C4::Context->dbh;
920     my $query = qq|
921         UPDATE currency
922         SET    rate=?
923         WHERE  currency=? |;
924     my $sth = $dbh->prepare($query);
925     $sth->execute( $rate, $currency );
926 }
927
928 # -------------------------------------------------------------------
929
930 =head2 ConvertCurrency
931
932   $foreignprice = &ConvertCurrency($currency, $localprice);
933
934 Converts the price C<$localprice> to foreign currency C<$currency> by
935 dividing by the exchange rate, and returns the result.
936
937 If no exchange rate is found, e is one to one.
938
939 =cut
940
941 sub ConvertCurrency {
942     my ( $currency, $price ) = @_;
943     my $dbh   = C4::Context->dbh;
944     my $query = "
945         SELECT rate
946         FROM   currency
947         WHERE  currency=?
948     ";
949     my $sth = $dbh->prepare($query);
950     $sth->execute($currency);
951     my $cur = ( $sth->fetchrow_array() )[0];
952     unless ($cur) {
953         $cur = 1;
954     }
955     return ( $price / $cur );
956 }
957
958 =head2 _columns
959
960 returns an array containing fieldname followed by PRI as value if PRIMARY Key
961
962 =cut
963
964 sub _columns(;$) {
965         my $tablename=shift||"aqbudgets";
966     return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from $tablename",{Columns=>[1,4]})};
967 }
968
969 sub _filter_fields{
970         my $budget=shift;
971         my $tablename=shift;
972     my @keys; 
973         my @values;
974         my %columns= _columns($tablename);
975         #Filter Primary Keys of table
976     my $elements=join "|",grep {$columns{$_} ne "PRI"} keys %columns;
977         foreach my $field (grep {/\b($elements)\b/} keys %$budget){
978                 $$budget{$field}=format_date_in_iso($$budget{$field}) if ($field=~/date/ && $$budget{$field} !~C4::Dates->regexp("iso"));
979                 my $strkeys= " $field = ? ";
980                 if ($field=~/branch/){
981                         $strkeys="( $strkeys OR $field='' OR $field IS NULL) ";
982                 }
983                 push @values, $$budget{$field};
984                 push @keys, $strkeys;
985         }
986         return (\@keys,\@values);
987 }
988
989 END { }    # module clean-up code here (global destructor)
990
991 1;
992 __END__
993
994 =head1 AUTHOR
995
996 Koha Development Team <http://koha-community.org/>
997
998 =cut