← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:24 2013

Filename/usr/share/koha/lib/C4/Budgets.pm
StatementsExecuted 24 statements in 4.00ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.76ms4.69msC4::Budgets::::BEGIN@24C4::Budgets::BEGIN@24
11122µs22µsC4::Budgets::::BEGIN@29C4::Budgets::BEGIN@29
11121µs88µsC4::Budgets::::BEGIN@27C4::Budgets::BEGIN@27
11117µs22µsC4::Budgets::::BEGIN@20C4::Budgets::BEGIN@20
11112µs15µsC4::Budgets::::BEGIN@22C4::Budgets::BEGIN@22
11111µs102µsC4::Budgets::::BEGIN@25C4::Budgets::BEGIN@25
1119µs47µsC4::Budgets::::BEGIN@23C4::Budgets::BEGIN@23
1114µs4µsC4::Budgets::::ENDC4::Budgets::END
0000s0sC4::Budgets::::AddBudgetC4::Budgets::AddBudget
0000s0sC4::Budgets::::AddBudgetPeriodC4::Budgets::AddBudgetPeriod
0000s0sC4::Budgets::::BudgetHasChildrenC4::Budgets::BudgetHasChildren
0000s0sC4::Budgets::::CanUserModifyBudgetC4::Budgets::CanUserModifyBudget
0000s0sC4::Budgets::::CanUserUseBudgetC4::Budgets::CanUserUseBudget
0000s0sC4::Budgets::::CheckBudgetParentC4::Budgets::CheckBudgetParent
0000s0sC4::Budgets::::CheckBudgetParentPermC4::Budgets::CheckBudgetParentPerm
0000s0sC4::Budgets::::ConvertCurrencyC4::Budgets::ConvertCurrency
0000s0sC4::Budgets::::DelBudgetC4::Budgets::DelBudget
0000s0sC4::Budgets::::DelBudgetPeriodC4::Budgets::DelBudgetPeriod
0000s0sC4::Budgets::::GetAuthvalueDropboxC4::Budgets::GetAuthvalueDropbox
0000s0sC4::Budgets::::GetBudgetC4::Budgets::GetBudget
0000s0sC4::Budgets::::GetBudgetAuthCatsC4::Budgets::GetBudgetAuthCats
0000s0sC4::Budgets::::GetBudgetHierarchyC4::Budgets::GetBudgetHierarchy
0000s0sC4::Budgets::::GetBudgetNameC4::Budgets::GetBudgetName
0000s0sC4::Budgets::::GetBudgetOrderedC4::Budgets::GetBudgetOrdered
0000s0sC4::Budgets::::GetBudgetPeriodC4::Budgets::GetBudgetPeriod
0000s0sC4::Budgets::::GetBudgetPeriodsC4::Budgets::GetBudgetPeriods
0000s0sC4::Budgets::::GetBudgetSpentC4::Budgets::GetBudgetSpent
0000s0sC4::Budgets::::GetBudgetUsersC4::Budgets::GetBudgetUsers
0000s0sC4::Budgets::::GetBudgetsC4::Budgets::GetBudgets
0000s0sC4::Budgets::::GetBudgetsPlanCellC4::Budgets::GetBudgetsPlanCell
0000s0sC4::Budgets::::GetChildBudgetsSpentC4::Budgets::GetChildBudgetsSpent
0000s0sC4::Budgets::::GetColsC4::Budgets::GetCols
0000s0sC4::Budgets::::GetCurrenciesC4::Budgets::GetCurrencies
0000s0sC4::Budgets::::GetCurrencyC4::Budgets::GetCurrency
0000s0sC4::Budgets::::GetPeriodsCountC4::Budgets::GetPeriodsCount
0000s0sC4::Budgets::::HideColsC4::Budgets::HideCols
0000s0sC4::Budgets::::ModBudgetC4::Budgets::ModBudget
0000s0sC4::Budgets::::ModBudgetPeriodC4::Budgets::ModBudgetPeriod
0000s0sC4::Budgets::::ModBudgetPlanC4::Budgets::ModBudgetPlan
0000s0sC4::Budgets::::ModBudgetUsersC4::Budgets::ModBudgetUsers
0000s0sC4::Budgets::::ModCurrenciesC4::Budgets::ModCurrencies
0000s0sC4::Budgets::::_columnsC4::Budgets::_columns
0000s0sC4::Budgets::::_filter_fieldsC4::Budgets::_filter_fields
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package 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
20330µs227µs
# spent 22µs (17+5) within C4::Budgets::BEGIN@20 which was called: # once (17µs+5µs) by C4::Output::BEGIN@35 at line 20
use strict;
# spent 22µs making 1 call to C4::Budgets::BEGIN@20 # spent 5µs making 1 call to strict::import
21#use warnings; FIXME - Bug 2505
22330µs218µs
# spent 15µs (12+3) within C4::Budgets::BEGIN@22 which was called: # once (12µs+3µs) by C4::Output::BEGIN@35 at line 22
use C4::Context;
# spent 15µs making 1 call to C4::Budgets::BEGIN@22 # spent 3µs making 1 call to C4::Context::import
23330µs284µs
# spent 47µs (9+38) within C4::Budgets::BEGIN@23 which was called: # once (9µs+38µs) by C4::Output::BEGIN@35 at line 23
use C4::Dates qw(format_date format_date_in_iso);
# spent 47µs making 1 call to C4::Budgets::BEGIN@23 # spent 38µs making 1 call to Exporter::import
243128µs24.97ms
# spent 4.69ms (2.76+1.93) within C4::Budgets::BEGIN@24 which was called: # once (2.76ms+1.93ms) by C4::Output::BEGIN@35 at line 24
use C4::SQLHelper qw<:all>;
# spent 4.69ms making 1 call to C4::Budgets::BEGIN@24 # spent 285µs making 1 call to Exporter::import
25337µs2192µs
# spent 102µs (11+90) within C4::Budgets::BEGIN@25 which was called: # once (11µs+90µs) by C4::Output::BEGIN@35 at line 25
use C4::Debug;
# spent 102µs making 1 call to C4::Budgets::BEGIN@25 # spent 90µs making 1 call to Exporter::import
26
273117µs2155µs
# spent 88µs (21+67) within C4::Budgets::BEGIN@27 which was called: # once (21µs+67µs) by C4::Output::BEGIN@35 at line 27
use vars qw($VERSION @ISA @EXPORT);
# spent 88µs making 1 call to C4::Budgets::BEGIN@27 # spent 67µs making 1 call to vars::import
28
29
# spent 22µs within C4::Budgets::BEGIN@29 which was called: # once (22µs+0s) by C4::Output::BEGIN@35 at line 78
BEGIN {
30 # set the version for version checking
3111µs $VERSION = 3.07.00.049;
321700ns require Exporter;
3319µs @ISA = qw(Exporter);
34111µs @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 );
7813.59ms122µs}
# spent 22µs making 1 call to C4::Budgets::BEGIN@29
79
80# ----------------------------BUDGETS.PM-----------------------------";
81
82
83=head1 FUNCTIONS ABOUT BUDGETS
84
- -
87sub 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
103sub 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
122sub 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
137sub AddBudgetPeriod {
138 my ($budgetperiod) = @_;
139 return InsertInTable("aqbudgetperiods",$budgetperiod);
140}
141# -------------------------------------------------------------------
142sub 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# -------------------------------------------------------------------
152sub 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# -------------------------------------------------------------------
177sub 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# -------------------------------------------------------------------
189sub 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# -------------------------------------------------------------------
272sub 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# -------------------------------------------------------------------
309sub 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# -------------------------------------------------------------------
335sub 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
- -
368sub 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# -------------------------------------------------------------------
383sub 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# -------------------------------------------------------------------
403sub 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# -------------------------------------------------------------------
441sub GetBudgetPeriods {
442 my ($filters,$orderby) = @_;
443 return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide");
444}
445# -------------------------------------------------------------------
446sub 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# -------------------------------------------------------------------
473sub 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# -------------------------------------------------------------------
489sub ModBudgetPeriod {
490 my ($budget_period_information) = @_;
491 return UpdateInTable("aqbudgetperiods",$budget_period_information);
492}
493
494# -------------------------------------------------------------------
495sub 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
631sub AddBudget {
632 my ($budget) = @_;
633 return InsertInTable("aqbudgets",$budget);
634}
635
636# -------------------------------------------------------------------
637sub ModBudget {
638 my ($budget) = @_;
639 return UpdateInTable("aqbudgets",$budget);
640}
641
642# -------------------------------------------------------------------
643sub 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
- -
660# -------------------------------------------------------------------
661sub 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
- -
683# -------------------------------------------------------------------
684sub 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
- -
710# -------------------------------------------------------------------
711sub GetBudgets {
712 my $filters = shift;
713 my $orderby = shift || 'budget_name';
714 return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide");
715}
716
717=head2 GetBudgetUsers
718
- -
725sub GetBudgetUsers {
726 my ($budget_id) = @_;
727
728 my $dbh = C4::Context->dbh;
729 my $query = qq{
730 SELECT borrowernumber
731 FROM aqbudgetborrowers
732 WHERE budget_id = ?
733 };
734 my $sth = $dbh->prepare($query);
735 $sth->execute($budget_id);
736
737 my @borrowernumbers;
738 while (my ($borrowernumber) = $sth->fetchrow_array) {
739 push @borrowernumbers, $borrowernumber
740 }
741
742 return @borrowernumbers;
743}
744
745=head2 ModBudgetUsers
746
- -
753sub ModBudgetUsers {
754 my ($budget_id, @budget_users_id) = @_;
755
756 return unless $budget_id;
757
758 my $dbh = C4::Context->dbh;
759 my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
760 my $sth = $dbh->prepare($query);
761 $sth->execute($budget_id);
762
763 $query = qq{
764 INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
765 VALUES (?,?)
766 };
767 $sth = $dbh->prepare($query);
768 foreach my $borrowernumber (@budget_users_id) {
769 next unless $borrowernumber;
770 $sth->execute($budget_id, $borrowernumber);
771 }
772}
773
774sub CanUserUseBudget {
775 my ($borrower, $budget, $userflags) = @_;
776
777 if (not ref $borrower) {
778 $borrower = C4::Members::GetMember(borrowernumber => $borrower);
779 }
780 if (not ref $budget) {
781 $budget = GetBudget($budget);
782 }
783
784 return 0 unless ($borrower and $budget);
785
786 if (not defined $userflags) {
787 $userflags = C4::Auth::getuserflags($borrower->{flags},
788 $borrower->{userid});
789 }
790
791 unless ($userflags->{superlibrarian}
792 || (ref $userflags->{acquisition}
793 && $userflags->{acquisition}->{budget_manage_all})
794 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
795 {
796 if (not exists $userflags->{acquisition}) {
797 return 0;
798 }
799
800 if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
801 return 0;
802 }
803
804 # Budget restricted to owner
805 if ($budget->{budget_permission} == 1
806 && $budget->{budget_owner_id}
807 && $budget->{budget_owner_id} != $borrower->{borrowernumber}) {
808 return 0;
809 }
810
811 my @budget_users = GetBudgetUsers($budget->{budget_id});
812
813 # Budget restricted to owner, users and library
814 if ($budget->{budget_permission} == 2
815 && $budget->{budget_owner_id}
816 && $budget->{budget_owner_id} != $borrower->{borrowernumber}
817 && (0 == grep {$borrower->{borrowernumber} == $_} @budget_users)
818 && defined $budget->{budget_branchcode}
819 && $budget->{budget_branchcode} ne C4::Context->userenv->{branch}) {
820 return 0;
821 }
822
823 # Budget restricted to owner and users
824 if ($budget->{budget_permission} == 3
825 && $budget->{budget_owner_id}
826 && $budget->{budget_owner_id} != $borrower->{borrowernumber}
827 && (0 == grep {$borrower->{borrowernumber} == $_} @budget_users)) {
828 return 0;
829 }
830 }
831
832 return 1;
833}
834
835sub CanUserModifyBudget {
836 my ($borrower, $budget, $userflags) = @_;
837
838 if (not ref $borrower) {
839 $borrower = C4::Members::GetMember(borrowernumber => $borrower);
840 }
841 if (not ref $budget) {
842 $budget = GetBudget($budget);
843 }
844
845 return 0 unless ($borrower and $budget);
846
847 if (not defined $userflags) {
848 $userflags = C4::Auth::getuserflags($borrower->{flags},
849 $borrower->{userid});
850 }
851
852 unless ($userflags->{superlibrarian}
853 || (ref $userflags->{acquisition}
854 && $userflags->{acquisition}->{budget_manage_all})
855 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
856 {
857 if (!CanUserUseBudget($borrower, $budget, $userflags)) {
858 return 0;
859 }
860
861 if (ref $userflags->{acquisition}
862 && !$userflags->{acquisition}->{budget_modify}) {
863 return 0;
864 }
865 }
866
867 return 1;
868}
869
870# -------------------------------------------------------------------
871
872=head2 GetCurrencies
873
- -
883sub GetCurrencies {
884 my $dbh = C4::Context->dbh;
885 my $query = "
886 SELECT *
887 FROM currency
888 ";
889 my $sth = $dbh->prepare($query);
890 $sth->execute;
891 my @results = ();
892 while ( my $data = $sth->fetchrow_hashref ) {
893 push( @results, $data );
894 }
895 return @results;
896}
897
898# -------------------------------------------------------------------
899
900sub GetCurrency {
901 my $dbh = C4::Context->dbh;
902 my $query = "
903 SELECT * FROM currency where active = '1' ";
904 my $sth = $dbh->prepare($query);
905 $sth->execute;
906 my $r = $sth->fetchrow_hashref;
907 return $r;
908}
909
910=head2 ModCurrencies
911
- -
918sub ModCurrencies {
919 my ( $currency, $rate ) = @_;
920 my $dbh = C4::Context->dbh;
921 my $query = qq|
922 UPDATE currency
923 SET rate=?
924 WHERE currency=? |;
925 my $sth = $dbh->prepare($query);
926 $sth->execute( $rate, $currency );
927}
928
929# -------------------------------------------------------------------
930
931=head2 ConvertCurrency
932
- -
942sub ConvertCurrency {
943 my ( $currency, $price ) = @_;
944 my $dbh = C4::Context->dbh;
945 my $query = "
946 SELECT rate
947 FROM currency
948 WHERE currency=?
949 ";
950 my $sth = $dbh->prepare($query);
951 $sth->execute($currency);
952 my $cur = ( $sth->fetchrow_array() )[0];
953 unless ($cur) {
954 $cur = 1;
955 }
956 return ( $price / $cur );
957}
958
959=head2 _columns
960
- -
965sub _columns(;$) {
966 my $tablename=shift||"aqbudgets";
967 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from $tablename",{Columns=>[1,4]})};
968}
969
970sub _filter_fields{
971 my $budget=shift;
972 my $tablename=shift;
973 my @keys;
974 my @values;
975 my %columns= _columns($tablename);
976 #Filter Primary Keys of table
977 my $elements=join "|",grep {$columns{$_} ne "PRI"} keys %columns;
978 foreach my $field (grep {/\b($elements)\b/} keys %$budget){
979 $$budget{$field}=format_date_in_iso($$budget{$field}) if ($field=~/date/ && $$budget{$field} !~C4::Dates->regexp("iso"));
980 my $strkeys= " $field = ? ";
981 if ($field=~/branch/){
982 $strkeys="( $strkeys OR $field='' OR $field IS NULL) ";
983 }
984 push @values, $$budget{$field};
985 push @keys, $strkeys;
986 }
987 return (\@keys,\@values);
988}
989
99015µs
# spent 4µs within C4::Budgets::END which was called: # once (4µs+0s) by main::RUNTIME at line 0 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
END { } # module clean-up code here (global destructor)
991
99214µs1;
993__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.