← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:51 2015

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