Bug 15358: Fix authorities merge
[koha.git] / C4 / Budgets.pm
blob1c30e1bf21c91ffb0b1a7ae6fed40b3d200290d0
1 package C4::Budgets;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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.
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.
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>.
20 use strict;
21 #use warnings; FIXME - Bug 2505
22 use C4::Context;
23 use Koha::Database;
24 use C4::Debug;
25 use vars qw($VERSION @ISA @EXPORT);
27 BEGIN {
28 # set the version for version checking
29 $VERSION = 3.07.00.049;
30 require Exporter;
31 @ISA = qw(Exporter);
32 @EXPORT = qw(
34 &GetBudget
35 &GetBudgetByOrderNumber
36 &GetBudgetByCode
37 &GetBudgets
38 &GetBudgetHierarchy
39 &AddBudget
40 &ModBudget
41 &DelBudget
42 &GetBudgetSpent
43 &GetBudgetOrdered
44 &GetBudgetName
45 &GetPeriodsCount
46 GetBudgetHierarchySpent
47 GetBudgetHierarchyOrdered
49 &GetBudgetUsers
50 &ModBudgetUsers
51 &CanUserUseBudget
52 &CanUserModifyBudget
54 &GetBudgetPeriod
55 &GetBudgetPeriods
56 &ModBudgetPeriod
57 &AddBudgetPeriod
58 &DelBudgetPeriod
60 &ModBudgetPlan
62 &GetCurrency
63 &GetCurrencies
64 &ConvertCurrency
66 &GetBudgetsPlanCell
67 &AddBudgetPlanValue
68 &GetBudgetAuthCats
69 &BudgetHasChildren
70 &CheckBudgetParent
71 &CheckBudgetParentPerm
73 &HideCols
74 &GetCols
78 # ----------------------------BUDGETS.PM-----------------------------";
81 =head1 FUNCTIONS ABOUT BUDGETS
83 =cut
85 sub HideCols {
86 my ( $authcat, @hide_cols ) = @_;
87 my $dbh = C4::Context->dbh;
89 my $sth1 = $dbh->prepare(
90 qq|
91 UPDATE aqbudgets_planning SET display = 0
92 WHERE authcat = ?
93 AND authvalue = ? |
95 foreach my $authvalue (@hide_cols) {
96 # $sth1->{TraceLevel} = 3;
97 $sth1->execute( $authcat, $authvalue );
101 sub GetCols {
102 my ( $authcat, $authvalue ) = @_;
104 my $dbh = C4::Context->dbh;
105 my $sth = $dbh->prepare(
107 SELECT count(display) as cnt from aqbudgets_planning
108 WHERE authcat = ?
109 AND authvalue = ? and display = 0 |
112 # $sth->{TraceLevel} = 3;
113 $sth->execute( $authcat, $authvalue );
114 my $res = $sth->fetchrow_hashref;
116 return $res->{cnt} > 0 ? 0: 1
120 sub CheckBudgetParentPerm {
121 my ( $budget, $borrower_id ) = @_;
122 my $depth = $budget->{depth};
123 my $parent_id = $budget->{budget_parent_id};
124 while ($depth) {
125 my $parent = GetBudget($parent_id);
126 $parent_id = $parent->{budget_parent_id};
127 if ( $parent->{budget_owner_id} == $borrower_id ) {
128 return 1;
130 $depth--
132 return 0;
135 sub AddBudgetPeriod {
136 my ($budgetperiod) = @_;
137 return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate});
139 my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
140 return $resultset->create($budgetperiod)->id;
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'};
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;
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;
170 if ( not defined $res->{'budget_parent_id'} ) {
171 return 0;
173 $parent_id_tmp = $res->{'budget_parent_id'};
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'};
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 );
198 sub SetOwnerToFundHierarchy {
199 my ( $budget_id, $borrowernumber ) = @_;
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 );
210 # -------------------------------------------------------------------
211 sub GetBudgetsPlanCell {
212 my ( $cell, $period, $budget ) = @_;
213 my ($actual, $sth);
214 my $dbh = C4::Context->dbh;
215 if ( $cell->{'authcat'} eq 'MONTHS' ) {
216 # get the actual amount
217 $sth = $dbh->prepare( qq|
219 SELECT SUM(ecost) AS actual FROM aqorders
220 WHERE budget_id = ? AND
221 entrydate like "$cell->{'authvalue'}%" |
223 $sth->execute( $cell->{'budget_id'} );
224 } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
225 # get the actual amount
226 $sth = $dbh->prepare( qq|
228 SELECT SUM(ecost) FROM aqorders
229 LEFT JOIN aqorders_items
230 ON (aqorders.ordernumber = aqorders_items.ordernumber)
231 LEFT JOIN items
232 ON (aqorders_items.itemnumber = items.itemnumber)
233 WHERE budget_id = ? AND homebranch = ? | );
235 $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
236 } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
237 # get the actual amount
238 $sth = $dbh->prepare( qq|
240 SELECT SUM( ecost * quantity) AS actual
241 FROM aqorders JOIN biblioitems
242 ON (biblioitems.biblionumber = aqorders.biblionumber )
243 WHERE aqorders.budget_id = ? and itemtype = ? |
245 $sth->execute( $cell->{'budget_id'},
246 $cell->{'authvalue'} );
248 # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
249 else {
250 # get the actual amount
251 $sth = $dbh->prepare( qq|
253 SELECT SUM(ecost * quantity) AS actual
254 FROM aqorders
255 JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
256 WHERE aqorders.budget_id = ? AND
257 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
258 (aqbudgets.sort2_authcat = ? AND sort2 =?)) |
260 $sth->execute( $cell->{'budget_id'},
261 $budget->{'sort1_authcat'},
262 $cell->{'authvalue'},
263 $budget->{'sort2_authcat'},
264 $cell->{'authvalue'}
267 $actual = $sth->fetchrow_array;
269 # get the estimated amount
270 $sth = $dbh->prepare( qq|
272 SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
273 WHERE budget_period_id = ? AND
274 budget_id = ? AND
275 authvalue = ? AND
276 authcat = ? |
278 $sth->execute( $cell->{'budget_period_id'},
279 $cell->{'budget_id'},
280 $cell->{'authvalue'},
281 $cell->{'authcat'},
285 my $res = $sth->fetchrow_hashref;
286 # my $display = $res->{'display'};
287 my $estimated = $res->{'estimated'};
290 return $actual, $estimated;
293 # -------------------------------------------------------------------
294 sub ModBudgetPlan {
295 my ( $budget_plan, $budget_period_id, $authcat ) = @_;
296 my $dbh = C4::Context->dbh;
297 foreach my $buds (@$budget_plan) {
298 my $lines = $buds->{lines};
299 my $sth = $dbh->prepare( qq|
300 DELETE FROM aqbudgets_planning
301 WHERE budget_period_id = ? AND
302 budget_id = ? AND
303 authcat = ? |
305 #delete a aqplan line of cells, then insert new cells,
306 # these could be UPDATES rather than DEL/INSERTS...
307 $sth->execute( $budget_period_id, $lines->[0]{budget_id} , $authcat );
309 foreach my $cell (@$lines) {
310 my $sth = $dbh->prepare( qq|
312 INSERT INTO aqbudgets_planning
313 SET budget_id = ?,
314 budget_period_id = ?,
315 authcat = ?,
316 estimated_amount = ?,
317 authvalue = ? |
319 $sth->execute(
320 $cell->{'budget_id'},
321 $cell->{'budget_period_id'},
322 $cell->{'authcat'},
323 $cell->{'estimated_amount'},
324 $cell->{'authvalue'},
330 # -------------------------------------------------------------------
331 sub GetBudgetSpent {
332 my ($budget_id) = @_;
333 my $dbh = C4::Context->dbh;
334 my $sth = $dbh->prepare(qq|
335 SELECT SUM( COALESCE(unitprice, ecost) * quantity ) AS sum FROM aqorders
336 WHERE budget_id = ? AND
337 quantityreceived > 0 AND
338 datecancellationprinted IS NULL
340 $sth->execute($budget_id);
341 my $sum = $sth->fetchrow_array;
343 $sth = $dbh->prepare(qq|
344 SELECT SUM(shipmentcost) AS sum
345 FROM aqinvoices
346 WHERE shipmentcost_budgetid = ?
347 AND closedate IS NOT NULL
349 $sth->execute($budget_id);
350 my ($shipmentcost_sum) = $sth->fetchrow_array;
351 $sum += $shipmentcost_sum;
353 return $sum;
356 # -------------------------------------------------------------------
357 sub GetBudgetOrdered {
358 my ($budget_id) = @_;
359 my $dbh = C4::Context->dbh;
360 my $sth = $dbh->prepare(qq|
361 SELECT SUM(ecost * quantity) AS sum FROM aqorders
362 WHERE budget_id = ? AND
363 quantityreceived = 0 AND
364 datecancellationprinted IS NULL
366 $sth->execute($budget_id);
367 my $sum = $sth->fetchrow_array;
369 $sth = $dbh->prepare(qq|
370 SELECT SUM(shipmentcost) AS sum
371 FROM aqinvoices
372 WHERE shipmentcost_budgetid = ?
373 AND closedate IS NULL
375 $sth->execute($budget_id);
376 my ($shipmentcost_sum) = $sth->fetchrow_array;
377 $sum += $shipmentcost_sum;
379 return $sum;
382 =head2 GetBudgetName
384 my $budget_name = &GetBudgetName($budget_id);
386 get the budget_name for a given budget_id
388 =cut
390 sub GetBudgetName {
391 my ( $budget_id ) = @_;
392 my $dbh = C4::Context->dbh;
393 my $sth = $dbh->prepare(
395 SELECT budget_name
396 FROM aqbudgets
397 WHERE budget_id = ?
400 $sth->execute($budget_id);
401 return $sth->fetchrow_array;
404 # -------------------------------------------------------------------
405 sub GetBudgetAuthCats {
406 my ($budget_period_id) = shift;
407 # now, populate the auth_cats_loop used in the budget planning button
408 # we must retrieve all auth values used by at least one budget
409 my $dbh = C4::Context->dbh;
410 my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
411 $sth->execute($budget_period_id);
412 my %authcats;
413 while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
414 $authcats{$sort1_authcat}=1;
415 $authcats{$sort2_authcat}=1;
417 my @auth_cats_loop;
418 foreach (sort keys %authcats) {
419 push @auth_cats_loop,{ authcat => $_ };
421 return \@auth_cats_loop;
424 # -------------------------------------------------------------------
425 sub GetBudgetPeriods {
426 my ($filters,$orderby) = @_;
428 my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
429 $rs = $rs->search( $filters, { order_by => $orderby } );
430 $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
431 return [ $rs->all ];
433 # -------------------------------------------------------------------
434 sub GetBudgetPeriod {
435 my ($budget_period_id) = @_;
436 my $dbh = C4::Context->dbh;
437 ## $total = number of records linked to the record that must be deleted
438 my $total = 0;
439 ## get information about the record that will be deleted
440 my $sth;
441 if ($budget_period_id) {
442 $sth = $dbh->prepare( qq|
443 SELECT *
444 FROM aqbudgetperiods
445 WHERE budget_period_id=? |
447 $sth->execute($budget_period_id);
448 } else { # ACTIVE BUDGET
449 $sth = $dbh->prepare(qq|
450 SELECT *
451 FROM aqbudgetperiods
452 WHERE budget_period_active=1 |
454 $sth->execute();
456 my $data = $sth->fetchrow_hashref;
457 return $data;
460 # -------------------------------------------------------------------
461 sub DelBudgetPeriod{
462 my ($budget_period_id) = @_;
463 my $dbh = C4::Context->dbh;
464 ; ## $total = number of records linked to the record that must be deleted
465 my $total = 0;
467 ## get information about the record that will be deleted
468 my $sth = $dbh->prepare(qq|
469 DELETE
470 FROM aqbudgetperiods
471 WHERE budget_period_id=? |
473 return $sth->execute($budget_period_id);
476 # -------------------------------------------------------------------
477 sub ModBudgetPeriod {
478 my ($budget_period) = @_;
479 my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period);
480 return unless($result);
482 $result = $result->update($budget_period);
483 return $result->in_storage;
486 # -------------------------------------------------------------------
487 sub GetBudgetHierarchy {
488 my ( $budget_period_id, $branchcode, $owner ) = @_;
489 my @bind_params;
490 my $dbh = C4::Context->dbh;
491 my $query = qq|
492 SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description
493 FROM aqbudgets
494 JOIN aqbudgetperiods USING (budget_period_id)|;
496 my @where_strings;
497 # show only period X if requested
498 if ($budget_period_id) {
499 push @where_strings," aqbudgets.budget_period_id = ?";
500 push @bind_params, $budget_period_id;
502 # show only budgets owned by me, my branch or everyone
503 if ($owner) {
504 if ($branchcode) {
505 push @where_strings,
506 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="")))};
507 push @bind_params, ( $owner, $branchcode );
508 } else {
509 push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
510 push @bind_params, $owner;
512 } else {
513 if ($branchcode) {
514 push @where_strings," (budget_branchcode =? or budget_branchcode is NULL)";
515 push @bind_params, $branchcode;
518 $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
519 $debug && warn $query,join(",",@bind_params);
520 my $sth = $dbh->prepare($query);
521 $sth->execute(@bind_params);
523 my %links;
524 # create hash with budget_id has key
525 while ( my $data = $sth->fetchrow_hashref ) {
526 $links{ $data->{'budget_id'} } = $data;
529 # link child to parent
530 my @first_parents;
531 foreach my $budget ( sort { $a->{budget_code} cmp $b->{budget_code} } values %links ) {
532 my $child = $links{$budget->{budget_id}};
533 if ( $child->{'budget_parent_id'} ) {
534 my $parent = $links{ $child->{'budget_parent_id'} };
535 if ($parent) {
536 unless ( $parent->{'children'} ) {
537 # init child arrayref
538 $parent->{'children'} = [];
540 # add as child
541 push @{ $parent->{'children'} }, $child;
543 } else {
544 push @first_parents, $child;
548 my @sort = ();
549 foreach my $first_parent (@first_parents) {
550 _add_budget_children(\@sort, $first_parent);
553 foreach my $budget (@sort) {
554 $budget->{budget_spent} = GetBudgetSpent( $budget->{budget_id} );
555 $budget->{budget_ordered} = GetBudgetOrdered( $budget->{budget_id} );
556 $budget->{total_spent} = GetBudgetHierarchySpent( $budget->{budget_id} );
557 $budget->{total_ordered} = GetBudgetHierarchyOrdered( $budget->{budget_id} );
559 return \@sort;
562 # Recursive method to add a budget and its chidren to an array
563 sub _add_budget_children {
564 my $res = shift;
565 my $budget = shift;
566 push @$res, $budget;
567 my $children = $budget->{'children'} || [];
568 return unless @$children; # break recursivity
569 foreach my $child (@$children) {
570 _add_budget_children($res, $child);
574 # -------------------------------------------------------------------
576 sub AddBudget {
577 my ($budget) = @_;
578 return unless ($budget);
580 my $resultset = Koha::Database->new()->schema->resultset('Aqbudget');
581 return $resultset->create($budget)->id;
584 # -------------------------------------------------------------------
585 sub ModBudget {
586 my ($budget) = @_;
587 my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget);
588 return unless($result);
590 $result = $result->update($budget);
591 return $result->in_storage;
594 # -------------------------------------------------------------------
595 sub DelBudget {
596 my ($budget_id) = @_;
597 my $dbh = C4::Context->dbh;
598 my $sth = $dbh->prepare("delete from aqbudgets where budget_id=?");
599 my $rc = $sth->execute($budget_id);
600 return $rc;
604 =head2 GetBudget
606 &GetBudget($budget_id);
608 get a specific budget
610 =cut
612 # -------------------------------------------------------------------
613 sub GetBudget {
614 my ( $budget_id ) = @_;
615 my $dbh = C4::Context->dbh;
616 my $query = "
617 SELECT *
618 FROM aqbudgets
619 WHERE budget_id=?
621 my $sth = $dbh->prepare($query);
622 $sth->execute( $budget_id );
623 my $result = $sth->fetchrow_hashref;
624 return $result;
627 =head2 GetBudgetByOrderNumber
629 &GetBudgetByOrderNumber($ordernumber);
631 get a specific budget by order number
633 =cut
635 # -------------------------------------------------------------------
636 sub GetBudgetByOrderNumber {
637 my ( $ordernumber ) = @_;
638 my $dbh = C4::Context->dbh;
639 my $query = "
640 SELECT aqbudgets.*
641 FROM aqbudgets, aqorders
642 WHERE ordernumber=?
643 AND aqorders.budget_id = aqbudgets.budget_id
645 my $sth = $dbh->prepare($query);
646 $sth->execute( $ordernumber );
647 my $result = $sth->fetchrow_hashref;
648 return $result;
651 =head2 GetBudgetByCode
653 my $budget = &GetBudgetByCode($budget_code);
655 Retrieve all aqbudgets fields as a hashref for the budget that has
656 given budget_code
658 =cut
660 sub GetBudgetByCode {
661 my ( $budget_code ) = @_;
663 my $dbh = C4::Context->dbh;
664 my $query = qq{
665 SELECT *
666 FROM aqbudgets
667 WHERE budget_code = ?
668 ORDER BY budget_id DESC
669 LIMIT 1
671 my $sth = $dbh->prepare( $query );
672 $sth->execute( $budget_code );
673 return $sth->fetchrow_hashref;
676 =head2 GetBudgetHierarchySpent
678 my $spent = GetBudgetHierarchySpent( $budget_id );
680 Gets the total spent of the level and sublevels of $budget_id
682 =cut
684 sub GetBudgetHierarchySpent {
685 my ( $budget_id ) = @_;
686 my $dbh = C4::Context->dbh;
687 my $children_ids = $dbh->selectcol_arrayref(q|
688 SELECT budget_id
689 FROM aqbudgets
690 WHERE budget_parent_id = ?
691 |, {}, $budget_id );
693 my $total_spent = GetBudgetSpent( $budget_id );
694 for my $child_id ( @$children_ids ) {
695 $total_spent += GetBudgetHierarchySpent( $child_id );
697 return $total_spent;
700 =head2 GetBudgetHierarchyOrdered
702 my $ordered = GetBudgetHierarchyOrdered( $budget_id );
704 Gets the total ordered of the level and sublevels of $budget_id
706 =cut
708 sub GetBudgetHierarchyOrdered {
709 my ( $budget_id ) = @_;
710 my $dbh = C4::Context->dbh;
711 my $children_ids = $dbh->selectcol_arrayref(q|
712 SELECT budget_id
713 FROM aqbudgets
714 WHERE budget_parent_id = ?
715 |, {}, $budget_id );
717 my $total_ordered = GetBudgetOrdered( $budget_id );
718 for my $child_id ( @$children_ids ) {
719 $total_ordered += GetBudgetHierarchyOrdered( $child_id );
721 return $total_ordered;
724 =head2 GetBudgets
726 &GetBudgets($filter, $order_by);
728 gets all budgets
730 =cut
732 # -------------------------------------------------------------------
733 sub GetBudgets {
734 my ($filters, $orderby) = @_;
735 $orderby = 'budget_name' unless($orderby);
737 my $rs = Koha::Database->new()->schema->resultset('Aqbudget');
738 $rs = $rs->search( $filters, { order_by => $orderby } );
739 $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
740 return [ $rs->all ];
743 =head2 GetBudgetUsers
745 my @borrowernumbers = &GetBudgetUsers($budget_id);
747 Return the list of borrowernumbers linked to a budget
749 =cut
751 sub GetBudgetUsers {
752 my ($budget_id) = @_;
754 my $dbh = C4::Context->dbh;
755 my $query = qq{
756 SELECT borrowernumber
757 FROM aqbudgetborrowers
758 WHERE budget_id = ?
760 my $sth = $dbh->prepare($query);
761 $sth->execute($budget_id);
763 my @borrowernumbers;
764 while (my ($borrowernumber) = $sth->fetchrow_array) {
765 push @borrowernumbers, $borrowernumber
768 return @borrowernumbers;
771 =head2 ModBudgetUsers
773 &ModBudgetUsers($budget_id, @borrowernumbers);
775 Modify the list of borrowernumbers linked to a budget
777 =cut
779 sub ModBudgetUsers {
780 my ($budget_id, @budget_users_id) = @_;
782 return unless $budget_id;
784 my $dbh = C4::Context->dbh;
785 my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
786 my $sth = $dbh->prepare($query);
787 $sth->execute($budget_id);
789 $query = qq{
790 INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
791 VALUES (?,?)
793 $sth = $dbh->prepare($query);
794 foreach my $borrowernumber (@budget_users_id) {
795 next unless $borrowernumber;
796 $sth->execute($budget_id, $borrowernumber);
800 sub CanUserUseBudget {
801 my ($borrower, $budget, $userflags) = @_;
803 if (not ref $borrower) {
804 $borrower = C4::Members::GetMember(borrowernumber => $borrower);
806 if (not ref $budget) {
807 $budget = GetBudget($budget);
810 return 0 unless ($borrower and $budget);
812 if (not defined $userflags) {
813 $userflags = C4::Auth::getuserflags($borrower->{flags},
814 $borrower->{userid});
817 unless ($userflags->{superlibrarian}
818 || (ref $userflags->{acquisition}
819 && $userflags->{acquisition}->{budget_manage_all})
820 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
822 if (not exists $userflags->{acquisition}) {
823 return 0;
826 if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
827 return 0;
830 # Budget restricted to owner
831 if ( $budget->{budget_permission} == 1 ) {
832 if ( $budget->{budget_owner_id}
833 and $budget->{budget_owner_id} != $borrower->{borrowernumber} )
835 return 0;
839 # Budget restricted to owner, users and library
840 elsif ( $budget->{budget_permission} == 2 ) {
841 my @budget_users = GetBudgetUsers( $budget->{budget_id} );
843 if (
845 $budget->{budget_owner_id}
846 and $budget->{budget_owner_id} !=
847 $borrower->{borrowernumber}
848 or not $budget->{budget_owner_id}
850 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
851 @budget_users )
852 and defined $budget->{budget_branchcode}
853 and $budget->{budget_branchcode} ne
854 C4::Context->userenv->{branch}
857 return 0;
861 # Budget restricted to owner and users
862 elsif ( $budget->{budget_permission} == 3 ) {
863 my @budget_users = GetBudgetUsers( $budget->{budget_id} );
864 if (
866 $budget->{budget_owner_id}
867 and $budget->{budget_owner_id} !=
868 $borrower->{borrowernumber}
869 or not $budget->{budget_owner_id}
871 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
872 @budget_users )
875 return 0;
880 return 1;
883 sub CanUserModifyBudget {
884 my ($borrower, $budget, $userflags) = @_;
886 if (not ref $borrower) {
887 $borrower = C4::Members::GetMember(borrowernumber => $borrower);
889 if (not ref $budget) {
890 $budget = GetBudget($budget);
893 return 0 unless ($borrower and $budget);
895 if (not defined $userflags) {
896 $userflags = C4::Auth::getuserflags($borrower->{flags},
897 $borrower->{userid});
900 unless ($userflags->{superlibrarian}
901 || (ref $userflags->{acquisition}
902 && $userflags->{acquisition}->{budget_manage_all})
903 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
905 if (!CanUserUseBudget($borrower, $budget, $userflags)) {
906 return 0;
909 if (ref $userflags->{acquisition}
910 && !$userflags->{acquisition}->{budget_modify}) {
911 return 0;
915 return 1;
918 # -------------------------------------------------------------------
920 =head2 GetCurrencies
922 @currencies = &GetCurrencies;
924 Returns the list of all known currencies.
926 C<$currencies> is a array; its elements are references-to-hash, whose
927 keys are the fields from the currency table in the Koha database.
929 =cut
931 sub GetCurrencies {
932 my $dbh = C4::Context->dbh;
933 my $query = "
934 SELECT *
935 FROM currency
937 my $sth = $dbh->prepare($query);
938 $sth->execute;
939 my @results = ();
940 while ( my $data = $sth->fetchrow_hashref ) {
941 push( @results, $data );
943 return @results;
946 # -------------------------------------------------------------------
948 sub GetCurrency {
949 my $dbh = C4::Context->dbh;
950 my $query = "
951 SELECT * FROM currency where active = '1' ";
952 my $sth = $dbh->prepare($query);
953 $sth->execute;
954 my $r = $sth->fetchrow_hashref;
955 return $r;
958 # -------------------------------------------------------------------
960 =head2 ConvertCurrency
962 $foreignprice = &ConvertCurrency($currency, $localprice);
964 Converts the price C<$localprice> to foreign currency C<$currency> by
965 dividing by the exchange rate, and returns the result.
967 If no exchange rate is found, e is one to one.
969 =cut
971 sub ConvertCurrency {
972 my ( $currency, $price ) = @_;
973 my $dbh = C4::Context->dbh;
974 my $query = "
975 SELECT rate
976 FROM currency
977 WHERE currency=?
979 my $sth = $dbh->prepare($query);
980 $sth->execute($currency);
981 my $cur = ( $sth->fetchrow_array() )[0];
982 unless ($cur) {
983 $cur = 1;
985 return ( $price / $cur );
988 sub _round {
989 my ($value, $increment) = @_;
991 if ($increment && $increment != 0) {
992 $value = int($value / $increment) * $increment;
995 return $value;
998 =head2 CloneBudgetPeriod
1000 my $new_budget_period_id = CloneBudgetPeriod({
1001 budget_period_id => $budget_period_id,
1002 budget_period_startdate => $budget_period_startdate,
1003 budget_period_enddate => $budget_period_enddate,
1004 mark_original_budget_as_inactive => 1n
1005 reset_all_budgets => 1,
1008 Clone a budget period with all budgets.
1009 If the mark_origin_budget_as_inactive is set (0 by default),
1010 the original budget will be marked as inactive.
1012 If the reset_all_budgets is set (0 by default), all budget (fund)
1013 amounts will be reset.
1015 =cut
1017 sub CloneBudgetPeriod {
1018 my ($params) = @_;
1019 my $budget_period_id = $params->{budget_period_id};
1020 my $budget_period_startdate = $params->{budget_period_startdate};
1021 my $budget_period_enddate = $params->{budget_period_enddate};
1022 my $budget_period_description = $params->{budget_period_description};
1023 my $amount_change_percentage = $params->{amount_change_percentage};
1024 my $amount_change_round_increment = $params->{amount_change_round_increment};
1025 my $mark_original_budget_as_inactive =
1026 $params->{mark_original_budget_as_inactive} || 0;
1027 my $reset_all_budgets = $params->{reset_all_budgets} || 0;
1029 my $budget_period = GetBudgetPeriod($budget_period_id);
1031 $budget_period->{budget_period_startdate} = $budget_period_startdate;
1032 $budget_period->{budget_period_enddate} = $budget_period_enddate;
1033 $budget_period->{budget_period_description} = $budget_period_description;
1034 # The new budget (budget_period) should be active by default
1035 $budget_period->{budget_period_active} = 1;
1037 if ($amount_change_percentage) {
1038 my $total = $budget_period->{budget_period_total};
1039 $total += $total * $amount_change_percentage / 100;
1040 $total = _round($total, $amount_change_round_increment);
1041 $budget_period->{budget_period_total} = $total;
1044 my $original_budget_period_id = $budget_period->{budget_period_id};
1045 delete $budget_period->{budget_period_id};
1046 my $new_budget_period_id = AddBudgetPeriod( $budget_period );
1048 my $budgets = GetBudgetHierarchy($budget_period_id);
1049 CloneBudgetHierarchy(
1051 budgets => $budgets,
1052 new_budget_period_id => $new_budget_period_id
1056 if ($mark_original_budget_as_inactive) {
1057 ModBudgetPeriod(
1059 budget_period_id => $budget_period_id,
1060 budget_period_active => 0,
1065 if ( $reset_all_budgets ) {
1066 my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1067 for my $budget ( @$budgets ) {
1068 $budget->{budget_amount} = 0;
1069 ModBudget( $budget );
1071 } elsif ($amount_change_percentage) {
1072 my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1073 for my $budget ( @$budgets ) {
1074 my $amount = $budget->{budget_amount};
1075 $amount += $amount * $amount_change_percentage / 100;
1076 $amount = _round($amount, $amount_change_round_increment);
1077 $budget->{budget_amount} = $amount;
1078 ModBudget( $budget );
1082 return $new_budget_period_id;
1085 =head2 CloneBudgetHierarchy
1087 CloneBudgetHierarchy({
1088 budgets => $budgets,
1089 new_budget_period_id => $new_budget_period_id;
1092 Clone a budget hierarchy.
1094 =cut
1096 sub CloneBudgetHierarchy {
1097 my ($params) = @_;
1098 my $budgets = $params->{budgets};
1099 my $new_budget_period_id = $params->{new_budget_period_id};
1100 next unless @$budgets or $new_budget_period_id;
1102 my $children_of = $params->{children_of};
1103 my $new_parent_id = $params->{new_parent_id};
1105 my @first_level_budgets =
1106 ( not defined $children_of )
1107 ? map { ( not $_->{budget_parent_id} ) ? $_ : () } @$budgets
1108 : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
1110 # get only the columns of aqbudgets
1111 my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
1113 for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
1114 @first_level_budgets )
1117 my $tidy_budget =
1118 { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
1119 keys %$budget };
1120 my $new_budget_id = AddBudget(
1122 %$tidy_budget,
1123 budget_id => undef,
1124 budget_parent_id => $new_parent_id,
1125 budget_period_id => $new_budget_period_id
1128 CloneBudgetHierarchy(
1130 budgets => $budgets,
1131 new_budget_period_id => $new_budget_period_id,
1132 children_of => $budget->{budget_id},
1133 new_parent_id => $new_budget_id
1139 =head2 MoveOrders
1141 my $report = MoveOrders({
1142 from_budget_period_id => $from_budget_period_id,
1143 to_budget_period_id => $to_budget_period_id,
1146 Move orders from one budget period to another.
1148 =cut
1150 sub MoveOrders {
1151 my ($params) = @_;
1152 my $from_budget_period_id = $params->{from_budget_period_id};
1153 my $to_budget_period_id = $params->{to_budget_period_id};
1154 my $move_remaining_unspent = $params->{move_remaining_unspent};
1155 return
1156 if not $from_budget_period_id
1157 or not $to_budget_period_id
1158 or $from_budget_period_id == $to_budget_period_id;
1160 # Can't move orders to an inactive budget (budgetperiod)
1161 my $budget_period = GetBudgetPeriod($to_budget_period_id);
1162 return unless $budget_period->{budget_period_active};
1164 my @report;
1165 my $dbh = C4::Context->dbh;
1166 my $sth_update_aqorders = $dbh->prepare(
1168 UPDATE aqorders
1169 SET budget_id = ?
1170 WHERE ordernumber = ?
1173 my $sth_update_budget_amount = $dbh->prepare(
1175 UPDATE aqbudgets
1176 SET budget_amount = ?
1177 WHERE budget_id = ?
1180 my $from_budgets = GetBudgetHierarchy($from_budget_period_id);
1181 for my $from_budget (@$from_budgets) {
1182 my $new_budget_id = $dbh->selectcol_arrayref(
1184 SELECT budget_id
1185 FROM aqbudgets
1186 WHERE budget_period_id = ?
1187 AND budget_code = ?
1188 |, {}, $to_budget_period_id, $from_budget->{budget_code}
1190 $new_budget_id = $new_budget_id->[0];
1191 my $new_budget = GetBudget( $new_budget_id );
1192 unless ( $new_budget ) {
1193 push @report,
1195 moved => 0,
1196 budget => $from_budget,
1197 error => 'budget_code_not_exists',
1199 next;
1201 my $orders_to_move = C4::Acquisition::SearchOrders(
1203 budget_id => $from_budget->{budget_id},
1204 pending => 1,
1208 my @orders_moved;
1209 for my $order (@$orders_to_move) {
1210 $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} );
1211 push @orders_moved, $order;
1214 my $unspent_moved = 0;
1215 if ($move_remaining_unspent) {
1216 my $spent = GetBudgetHierarchySpent( $from_budget->{budget_id} );
1217 my $unspent = $from_budget->{budget_amount} - $spent;
1218 my $new_budget_amount = $new_budget->{budget_amount};
1219 if ( $unspent > 0 ) {
1220 $new_budget_amount += $unspent;
1221 $unspent_moved = $unspent;
1223 $new_budget->{budget_amount} = $new_budget_amount;
1224 $sth_update_budget_amount->execute( $new_budget_amount,
1225 $new_budget->{budget_id} );
1228 push @report,
1230 budget => $new_budget,
1231 orders_moved => \@orders_moved,
1232 moved => 1,
1233 unspent_moved => $unspent_moved,
1236 return \@report;
1239 END { } # module clean-up code here (global destructor)
1242 __END__
1244 =head1 AUTHOR
1246 Koha Development Team <http://koha-community.org/>
1248 =cut