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 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
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.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
22 use C4::Dates qw(format_date format_date_in_iso);
25 use vars qw($VERSION @ISA @EXPORT);
28 # set the version for version checking
48 &GetBudgetPeriodsDropbox
64 &CheckBudgetParentPerm
71 # ----------------------------BUDGETS.PM-----------------------------";
75 my ( $authcat, @hide_cols ) = @_;
76 my $dbh = C4::Context->dbh;
79 my $sth = $dbh->prepare(
81 UPDATE aqbudgets_planning
82 SET display = 1 where authcat = ? |
84 $sth->execute( $authcat );
87 my $sth1 = $dbh->prepare(
89 UPDATE aqbudgets_planning SET display = 0
93 foreach my $authvalue (@hide_cols) {
94 # $sth1->{TraceLevel} = 3;
95 $sth1->execute( $authcat, $authvalue );
100 my ( $authcat, $authvalue ) = @_;
102 my $dbh = C4::Context->dbh;
103 my $sth = $dbh->prepare(
105 SELECT count(display) as cnt from aqbudgets_planning
107 AND authvalue = ? and display = 0 |
110 # $sth->{TraceLevel} = 3;
111 $sth->execute( $authcat, $authvalue );
112 my $res = $sth->fetchrow_hashref;
114 return $res->{cnt} > 0 ? 0: 1
118 sub CheckBudgetParentPerm {
119 my ( $budget, $borrower_id ) = @_;
120 my $depth = $budget->{depth};
121 my $parent_id = $budget->{budget_parent_id};
123 my $parent = GetBudget($parent_id);
124 $parent_id = $parent->{budget_parent_id};
125 if ( $parent->{budget_owner_id} == $borrower_id ) {
133 # -------------------------------------------------------------------
134 sub GetPeriodsCount {
135 my $dbh = C4::Context->dbh;
136 my $sth = $dbh->prepare("
137 SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
139 my $res = $sth->fetchrow_hashref;
140 return $res->{'sum'};
143 # -------------------------------------------------------------------
144 sub CheckBudgetParent {
145 my ( $new_parent, $budget ) = @_;
146 my $new_parent_id = $new_parent->{'budget_id'};
147 my $budget_id = $budget->{'budget_id'};
148 my $dbh = C4::Context->dbh;
149 my $parent_id_tmp = $new_parent_id;
151 # check new-parent is not a child (or a child's child ;)
152 my $sth = $dbh->prepare(qq|
153 SELECT budget_parent_id FROM
154 aqbudgets where budget_id = ? | );
156 $sth->execute($parent_id_tmp);
157 my $res = $sth->fetchrow_hashref;
158 if ( $res->{'budget_parent_id'} == $budget_id ) {
161 if ( not defined $res->{'budget_parent_id'} ) {
164 $parent_id_tmp = $res->{'budget_parent_id'};
168 # -------------------------------------------------------------------
169 sub BudgetHasChildren {
170 my ( $budget_id ) = @_;
171 my $dbh = C4::Context->dbh;
172 my $sth = $dbh->prepare(qq|
173 SELECT count(*) as sum FROM aqbudgets
174 WHERE budget_parent_id = ? | );
175 $sth->execute( $budget_id );
176 my $sum = $sth->fetchrow_hashref;
178 return $sum->{'sum'};
181 # -------------------------------------------------------------------
182 sub GetBudgetsPlanCell {
183 my ( $cell, $period, $budget ) = @_;
185 my $dbh = C4::Context->dbh;
186 if ( $cell->{'authcat'} eq 'MONTHS' ) {
187 # get the actual amount
188 $sth = $dbh->prepare( qq|
190 SELECT SUM(ecost) AS actual FROM aqorders
191 WHERE budget_id = ? AND
192 entrydate like "$cell->{'authvalue'}%" |
194 $sth->execute( $cell->{'budget_id'} );
195 } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
196 # get the actual amount
197 $sth = $dbh->prepare( qq|
199 SELECT SUM(ecost) FROM aqorders
200 LEFT JOIN aqorders_items
201 ON (aqorders.ordernumber = aqorders_items.ordernumber)
203 ON (aqorders_items.itemnumber = items.itemnumber)
204 WHERE budget_id = ? AND homebranch = ? | );
206 $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
207 } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
208 # get the actual amount
209 $sth = $dbh->prepare( qq|
211 SELECT SUM( ecost * quantity) AS actual
212 FROM aqorders JOIN biblioitems
213 ON (biblioitems.biblionumber = aqorders.biblionumber )
214 WHERE aqorders.budget_id = ? and itemtype = ? |
216 $sth->execute( $cell->{'budget_id'},
217 $cell->{'authvalue'} );
219 # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
221 # get the actual amount
222 $sth = $dbh->prepare( qq|
224 SELECT SUM(ecost * quantity) AS actual
226 JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
227 WHERE aqorders.budget_id = ? AND
228 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
229 (aqbudgets.sort2_authcat = ? AND sort2 =?)) |
231 $sth->{TraceLevel} = 2;
232 $sth->execute( $cell->{'budget_id'},
233 $budget->{'sort1_authcat'},
234 $cell->{'authvalue'},
235 $budget->{'sort2_authcat'},
239 $actual = $sth->fetchrow_array;
241 # get the estimated amount
242 my $sth = $dbh->prepare( qq|
244 SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
245 WHERE budget_period_id = ? AND
250 $sth->execute( $cell->{'budget_period_id'},
251 $cell->{'budget_id'},
252 $cell->{'authvalue'},
257 my $res = $sth->fetchrow_hashref;
258 # my $display = $res->{'display'};
259 my $estimated = $res->{'estimated'};
262 return $actual, $estimated;
265 # -------------------------------------------------------------------
267 my ( $budget_plan, $budget_period_id, $authcat ) = @_;
268 my $dbh = C4::Context->dbh;
269 foreach my $buds (@$budget_plan) {
270 my $lines = $buds->{lines};
271 my $sth = $dbh->prepare( qq|
272 DELETE FROM aqbudgets_planning
273 WHERE budget_period_id = ? AND
277 #delete a aqplan line of cells, then insert new cells,
278 # these could be UPDATES rather than DEL/INSERTS...
279 $sth->execute( $budget_period_id, $lines->[0]{budget_id} , $authcat );
281 foreach my $cell (@$lines) {
282 my $sth = $dbh->prepare( qq|
284 INSERT INTO aqbudgets_planning
286 budget_period_id = ?,
288 estimated_amount = ?,
292 $cell->{'budget_id'},
293 $cell->{'budget_period_id'},
295 $cell->{'estimated_amount'},
296 $cell->{'authvalue'},
302 # -------------------------------------------------------------------
304 my ($budget_id) = @_;
305 my $dbh = C4::Context->dbh;
306 my $sth = $dbh->prepare(qq|
307 SELECT SUM(ecost * quantity ) AS sum FROM aqorders
308 WHERE budget_id = ? AND
309 datecancellationprinted IS NULL
312 $sth->execute($budget_id);
313 my $sum = $sth->fetchrow_array;
314 # $sum = sprintf "%.2f", $sum;
318 # -------------------------------------------------------------------
319 sub GetBudgetPermDropbox {
322 $labels{'0'} = 'None';
323 $labels{'1'} = 'Owner';
324 $labels{'2'} = 'Library';
325 my $radio = CGI::scrolling_list(
326 -name => 'budget_permission',
327 -values => [ '0', '1', '2' ],
335 # -------------------------------------------------------------------
336 sub GetAuthcatDropbox {
337 my ($name, $default ) = @_;
338 my @authorised_values;
340 my $dbh = C4::Context->dbh;
341 my $sth = $dbh->prepare(qq|
342 SELECT distinct(category)
343 FROM authorised_values WHERE category LIKE 'Asort%'
348 push @authorised_values, '';
349 while (my $value = $sth->fetchrow_array) {
350 push @authorised_values, $value;
353 my $budget_authcat_dropbox = CGI::scrolling_list(
355 -values => \@authorised_values,
358 -default => $default,
363 return $budget_authcat_dropbox;
366 # -------------------------------------------------------------------
367 sub GetBudgetAuthCats {
368 my ($budget_period_id) = shift;
369 # now, populate the auth_cats_loop used in the budget planning button
370 # we must retrieve all auth values used by at least one budget
371 my $dbh = C4::Context->dbh;
372 my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
373 $sth->execute($budget_period_id);
375 while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
376 $authcats{$sort1_authcat}=1;
377 $authcats{$sort2_authcat}=1;
380 foreach (sort keys %authcats) {
381 push @auth_cats_loop,{ authcat => $_ };
383 return \@auth_cats_loop;
386 # -------------------------------------------------------------------
387 sub GetAuthvalueDropbox {
388 my ( $name, $authcat, $default ) = @_;
389 my @authorised_values;
392 my $dbh = C4::Context->dbh;
393 my $sth = $dbh->prepare(
394 "SELECT authorised_value,lib
395 FROM authorised_values
399 $sth->execute( $authcat );
401 push @authorised_values, '';
402 while (my ($value, $lib) = $sth->fetchrow_array) {
403 push @authorised_values, $value;
404 $authorised_lib{$value} = $lib;
407 return 0 if keys(%authorised_lib) == 0;
409 my $budget_authvalue_dropbox = CGI::scrolling_list(
410 -values => \@authorised_values,
411 -labels => \%authorised_lib,
412 -default => $default,
420 return $budget_authvalue_dropbox
423 # -------------------------------------------------------------------
424 sub GetBudgetPeriodsDropbox {
425 my ($budget_period_id) = @_;
428 my ($active, $periods) = GetBudgetPeriods();
429 foreach my $r (@$periods) {
430 $labels{"$r->{budget_period_id}"} = $r->{budget_period_description};
431 push @values, $r->{budget_period_id};
434 # if no buget_id is passed then its an add
435 my $budget_period_dropbox = CGI::scrolling_list(
436 -name => 'budget_period_id',
438 -default => $budget_period_id ? $budget_period_id : $active,
442 return $budget_period_dropbox;
445 # -------------------------------------------------------------------
446 sub GetBudgetPeriods {
447 my $dbh = C4::Context->dbh;
448 my $sth = $dbh->prepare(qq|
451 ORDER BY budget_period_startdate, budget_period_enddate |
456 while (my $data = $sth->fetchrow_hashref) {
457 if ($data->{'budget_period_active'} == 1) {
458 $active = $data->{'budget_period_id'};
460 push(@results, $data);
463 return ($active, \@results);
466 # -------------------------------------------------------------------
467 sub GetBudgetPeriod {
468 my ($budget_period_id) = @_;
469 my $dbh = C4::Context->dbh;
470 ## $total = number of records linked to the record that must be deleted
472 ## get information about the record that will be deleted
474 if ($budget_period_id gt 0) {
475 $sth = $dbh->prepare( qq|
478 WHERE budget_period_id=? |
480 $sth->execute($budget_period_id);
481 } else { # ACTIVE BUDGET
482 $sth = $dbh->prepare(qq|
485 WHERE budget_period_active=1 |
489 my $data = $sth->fetchrow_hashref;
494 # -------------------------------------------------------------------
495 sub DelBudgetPeriod() {
496 my ($budget_period_id) = @_;
497 my $dbh = C4::Context->dbh;
498 ; ## $total = number of records linked to the record that must be deleted
501 ## get information about the record that will be deleted
502 my $sth = $dbh->prepare(qq|
503 SELECT budget_period_id
504 , budget_period_startdate
505 , budget_period_enddate
506 , budget_period_amount
508 , budget_period_description
510 WHERE budget_period_id=? |
512 $sth->execute($budget_period_id);
513 my $data = $sth->fetchrow_hashref;
517 # -------------------------------------------------------------------
518 sub ModBudgetPeriod() {
519 my ($budget_period_id) = @_;
520 my $dbh = C4::Context->dbh
521 ; ## $total = number of records linked to the record that must be deleted my $total = 0;
523 ## get information about the record that will be deleted
524 my $sth = $dbh->prepare("
525 SELECT budget_period_id
526 , budget_period_startdate
527 , budget_period_enddate
528 , budget_period_amount
530 , budget_period_description
532 WHERE budget_period_id=?;"
534 $sth->execute($budget_period_id);
535 my $data = $sth->fetchrow_hashref;
539 # -------------------------------------------------------------------
540 sub GetBudgetHierarchy {
541 my ($budget_period_id, $branchcode, $owner) = @_;
543 my $dbh = C4::Context->dbh;
547 JOIN aqbudgetperiods USING (budget_period_id)
548 WHERE budget_period_active=1 |;
549 # show only period X if requested
550 if ($budget_period_id) {
551 $query .= "AND aqbudgets.budget_period_id = ?";
552 push @bind_params, $budget_period_id;
554 # show only budgets owned by me, my branch or everyone
557 $query .= " AND (budget_owner_id = ? OR budget_branchcode = ? OR (budget_branchcode IS NULL AND budget_owner_id IS NULL))";
558 push @bind_params, $owner;
559 push @bind_params, $branchcode;
561 $query .= ' AND budget_owner_id = ? OR budget_owner_id IS NULL';
562 push @bind_params, $owner;
566 $query .= " AND (budget_branchcode =? or budget_branchcode is NULL)";
567 push @bind_params, $branchcode;
570 my $sth = $dbh->prepare($query);
571 $sth->execute(@bind_params);
572 my $results = $sth->fetchall_arrayref({});
577 foreach my $r (@res) {
580 $r->{depth} = '0' if !defined $r->{budget_parent_id};
581 foreach my $r2 (@res) {
582 if (defined $r2->{budget_parent_id}
583 && $r2->{budget_parent_id} == $r->{budget_id}) {
584 push @child, $r2->{budget_id};
585 $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
588 $r->{child} = \@child if scalar @child > 0; # add the child
589 $depth_cnt++ if !defined $r->{'depth'};
591 last if ($depth_cnt == 0 || $i == 100);
595 # look for top parents 1st
597 my ($i, $depth_count) = 0;
600 foreach my $r (@res) {
601 if ($r->{depth} == $depth_count) {
602 $children++ if (ref $r->{child} eq 'ARRAY');
604 # find the parent id element_id and insert it after
607 if ($depth_count > 0) {
610 my $depth = $r->{depth} * 2;
611 my $space = pack "A[$depth]";
612 $r->{budget_code_indent} = $space . $r->{budget_code};
613 $r->{budget_name_indent} = $space . $r->{budget_name};
614 foreach my $r3 (@sort) {
615 if ($r3->{budget_id} == $r->{budget_parent_id}) {
622 $r->{budget_code_indent} = $r->{budget_code};
623 $r->{budget_name_indent} = $r->{budget_name};
626 if (defined $parent) {
627 splice @sort, ($parent + 1), 0, $r;
634 } # --------------foreach
636 last if $children == 0;
639 # add budget-percent and allocation, and flags for html-template
640 foreach my $r (@sort) {
641 my $subs_href = $r->{'child'};
642 my @subs_arr = @$subs_href if defined $subs_href;
644 my $moo = $r->{'budget_code_indent'};
645 $moo =~ s/\ /\ \;/g;
646 $r->{'budget_code_indent'} = $moo;
648 my $moo = $r->{'budget_name_indent'};
649 $moo =~ s/\ /\ \;/g;
650 $r->{'budget_name_indent'} = $moo;
652 $r->{'budget_spent'} = GetBudgetSpent( $r->{'budget_id'} );
654 $r->{'budget_amount_total'} = $r->{'budget_amount'} + $r->{'budget_amount_sublevel'} ;
659 foreach my $sub (@subs_arr) {
660 my $sub_budget = GetBudget($sub);
662 $r->{budget_spent_sublevel} += GetBudgetSpent( $sub_budget->{'budget_id'} );
663 $unalloc_count += $sub_budget->{'budget_amount'} + $sub_budget->{'budget_amount_sublevel'};
666 $r->{budget_unalloc_sublevel} = $r->{'budget_amount_sublevel'} - $unalloc_count;
668 if ( scalar @subs_arr == 0 && $r->{budget_amount_sublevel} > 0 ) {
669 $r->{warn_no_subs} = 1;
675 # -------------------------------------------------------------------
678 my $dbh = C4::Context->dbh;
680 INSERT INTO aqbudgets
682 budget_period_id = ?,
683 budget_parent_id = ?,
685 budget_branchcode = ?,
687 budget_amount_sublevel = ?,
694 budget_permission = ?
696 my $sth = $dbh->prepare($query);
698 $budget->{'budget_code'} ? $budget->{'budget_code'} : undef,
699 $budget->{'budget_period_id'} ? $budget->{'budget_period_id'} : undef,
700 $budget->{'budget_parent_id'} ? $budget->{'budget_parent_id'} : undef,
701 $budget->{'budget_name'} ? $budget->{'budget_name'} : undef,
702 $budget->{'budget_branchcode'} ? $budget->{'budget_branchcode'} : undef,
703 $budget->{'budget_amount'} ? $budget->{'budget_amount'} : undef,
704 $budget->{'budget_amount_sublevel'} ? $budget->{'budget_amount_sublevel'} : undef,
705 $budget->{'budget_encumb'} ? $budget->{'budget_encumb'} : undef,
706 $budget->{'budget_expend'} ? $budget->{'budget_expend'} : undef,
707 $budget->{'budget_notes'} ? $budget->{'budget_notes'} : undef,
708 $budget->{'sort1_authcat'} ? $budget->{'sort1_authcat'} : undef,
709 $budget->{'sort2_authcat'} ? $budget->{'sort2_authcat'} : undef,
710 $budget->{'budget_owner_id'} ? $budget->{'budget_owner_id'} : undef,
711 $budget->{'budget_permission'} ? $budget->{'budget_permission'} : undef,
716 # -------------------------------------------------------------------
719 my $dbh = C4::Context->dbh;
723 budget_period_id = ?,
724 budget_parent_id = ?,
726 budget_branchcode = ?,
728 budget_amount_sublevel = ?,
735 budget_permission = ?
739 my $sth = $dbh->prepare($query);
741 $budget->{'budget_code'} ? $budget->{'budget_code'} : undef,
742 $budget->{'budget_period_id'} ? $budget->{'budget_period_id'} : undef,
743 $budget->{'budget_parent_id'} ? $budget->{'budget_parent_id'} : undef,
744 $budget->{'budget_name'} ? $budget->{'budget_name'} : undef,
745 $budget->{'budget_branchcode'} ? $budget->{'budget_branchcode'} : undef,
746 $budget->{'budget_amount'} ? $budget->{'budget_amount'} : undef,
747 $budget->{'budget_amount_sublevel'} ? $budget->{'budget_amount_sublevel'} : undef,
748 $budget->{'budget_encumb'} ? $budget->{'budget_encumb'} : undef,
749 $budget->{'budget_expend'} ? $budget->{'budget_expend'} : undef,
750 $budget->{'budget_notes'} ? $budget->{'budget_notes'} : undef,
751 $budget->{'sort1_authcat'} ? $budget->{'sort1_authcat'} : undef,
752 $budget->{'sort2_authcat'} ? $budget->{'sort2_authcat'} : undef,
753 $budget->{'budget_owner_id'} ? $budget->{'budget_owner_id'} : undef,
754 $budget->{'budget_permission'} ? $budget->{'budget_permission'} : undef,
755 $budget->{'budget_id'},
760 # -------------------------------------------------------------------
762 my ($budget_id) = @_;
763 my $dbh = C4::Context->dbh;
764 my $sth = $dbh->prepare("delete from aqbudgets where budget_id=?");
765 my $rc = $sth->execute($budget_id);
772 =head2 FUNCTIONS ABOUT BUDGETS
782 &GetBudget($budget_id);
784 get a specific budget
790 # -------------------------------------------------------------------
792 my ( $budget_id ) = @_;
793 my $dbh = C4::Context->dbh;
800 my $sth = $dbh->prepare($query);
801 $sth->execute( $budget_id );
802 my $result = $sth->fetchrow_hashref;
810 &GetBudget($budget_id);
818 # -------------------------------------------------------------------
821 my $dbh = C4::Context->dbh;
822 my $q = "SELECT * from aqbudgets";
826 $sth = $dbh->prepare($q);
829 $q = "select budget_period_id from aqbudgetperiods where budget_period_active = 1 ";
830 $sth = $dbh->prepare($q);
832 $row = $sth->fetchrow_hashref();
833 $q = "select * from aqbudgets WHERE budget_period_id =? ";
834 $sth = $dbh->prepare($q);
835 $sth->execute( $row->{'budget_period_id'} );
837 my $results = $sth->fetchall_arrayref( {} );
842 # -------------------------------------------------------------------
846 @currencies = &GetCurrencies;
848 Returns the list of all known currencies.
850 C<$currencies> is a array; its elements are references-to-hash, whose
851 keys are the fields from the currency table in the Koha database.
856 my $dbh = C4::Context->dbh;
861 my $sth = $dbh->prepare($query);
864 while ( my $data = $sth->fetchrow_hashref ) {
865 push( @results, $data );
871 # -------------------------------------------------------------------
874 my $dbh = C4::Context->dbh;
876 SELECT * FROM currency where active = '1' ";
877 my $sth = $dbh->prepare($query);
879 my $r = $sth->fetchrow_hashref;
886 &ModCurrencies($currency, $newrate);
888 Sets the exchange rate for C<$currency> to be C<$newrate>.
893 my ( $currency, $rate ) = @_;
894 my $dbh = C4::Context->dbh;
899 my $sth = $dbh->prepare($query);
900 $sth->execute( $rate, $currency );
903 # -------------------------------------------------------------------
905 =head3 ConvertCurrency
907 $foreignprice = &ConvertCurrency($currency, $localprice);
909 Converts the price C<$localprice> to foreign currency C<$currency> by
910 dividing by the exchange rate, and returns the result.
912 If no exchange rate is found,e is one
917 sub ConvertCurrency {
918 my ( $currency, $price ) = @_;
919 my $dbh = C4::Context->dbh;
925 my $sth = $dbh->prepare($query);
926 $sth->execute($currency);
927 my $cur = ( $sth->fetchrow_array() )[0];
931 return ( $price / $cur );
934 END { } # module clean-up code here (global destructor)
943 Koha Developement team <info@koha.org>