File Coverage

File:C4/Budgets.pm
Coverage:7.3%

linestmtbrancondsubtimecode
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
20
6
6
6
6
43504
110
295
use strict;
21#use warnings; FIXME - Bug 2505
22
6
6
6
6
510
83
153
use C4::Context;
23
6
6
6
6
450
54
441
use C4::Dates qw(format_date format_date_in_iso);
24
6
6
6
6
866
54
2077
use C4::SQLHelper qw<:all>;
25
6
6
6
6
83
45
569
use C4::Debug;
26
27
6
6
6
6
172
24
835
use vars qw($VERSION @ISA @EXPORT);
28
29BEGIN {
30        # set the version for version checking
31
6
6
27
        $VERSION = 3.01;
32
6
51
        require Exporter;
33
6
78
        @ISA = qw(Exporter);
34
6
24820
        @EXPORT = qw(
35
36        &GetBudget
37        &GetBudgets
38        &GetBudgetHierarchy
39            &AddBudget
40        &ModBudget
41        &DelBudget
42        &GetBudgetSpent
43        &GetBudgetOrdered
44        &GetPeriodsCount
45        &GetChildBudgetsSpent
46
47            &GetBudgetPeriod
48        &GetBudgetPeriods
49        &ModBudgetPeriod
50        &AddBudgetPeriod
51            &DelBudgetPeriod
52
53        &GetAuthvalueDropbox
54
55        &ModBudgetPlan
56
57        &GetCurrency
58        &GetCurrencies
59        &ModCurrencies
60        &ConvertCurrency
61
62                &GetBudgetsPlanCell
63        &AddBudgetPlanValue
64        &GetBudgetAuthCats
65        &BudgetHasChildren
66        &CheckBudgetParent
67        &CheckBudgetParentPerm
68
69        &HideCols
70        &GetCols
71        );
72}
73
74# ----------------------------BUDGETS.PM-----------------------------";
75
76
77 - 79
=head1 FUNCTIONS ABOUT BUDGETS

=cut
80
81sub HideCols {
82
0
0
    my ( $authcat, @hide_cols ) = @_;
83
0
    my $dbh = C4::Context->dbh;
84
85
0
    my $sth1 = $dbh->prepare(
86        qq|
87        UPDATE aqbudgets_planning SET display = 0
88        WHERE authcat = ?
89        AND authvalue = ? |
90    );
91
0
    foreach my $authvalue (@hide_cols) {
92# $sth1->{TraceLevel} = 3;
93
0
        $sth1->execute( $authcat, $authvalue );
94    }
95}
96
97sub GetCols {
98
0
0
    my ( $authcat, $authvalue ) = @_;
99
100
0
    my $dbh = C4::Context->dbh;
101
0
    my $sth = $dbh->prepare(
102        qq|
103        SELECT count(display) as cnt from aqbudgets_planning
104        WHERE authcat = ?
105        AND authvalue = ? and display = 0 |
106    );
107
108# $sth->{TraceLevel} = 3;
109
0
    $sth->execute( $authcat, $authvalue );
110
0
    my $res = $sth->fetchrow_hashref;
111
112
0
0
    return $res->{cnt} > 0 ? 0: 1
113
114}
115
116sub CheckBudgetParentPerm {
117
0
0
    my ( $budget, $borrower_id ) = @_;
118
0
    my $depth = $budget->{depth};
119
0
    my $parent_id = $budget->{budget_parent_id};
120
0
    while ($depth) {
121
0
        my $parent = GetBudget($parent_id);
122
0
        $parent_id = $parent->{budget_parent_id};
123
0
0
        if ( $parent->{budget_owner_id} == $borrower_id ) {
124
0
            return 1;
125        }
126
0
        $depth--
127    }
128
0
    return 0;
129}
130
131sub AddBudgetPeriod {
132
0
0
    my ($budgetperiod) = @_;
133
0
        return InsertInTable("aqbudgetperiods",$budgetperiod);
134}
135# -------------------------------------------------------------------
136sub GetPeriodsCount {
137
0
0
    my $dbh = C4::Context->dbh;
138
0
    my $sth = $dbh->prepare("
139        SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
140
0
    $sth->execute();
141
0
    my $res = $sth->fetchrow_hashref;
142
0
    return $res->{'sum'};
143}
144
145# -------------------------------------------------------------------
146sub CheckBudgetParent {
147
0
0
    my ( $new_parent, $budget ) = @_;
148
0
    my $new_parent_id = $new_parent->{'budget_id'};
149
0
    my $budget_id = $budget->{'budget_id'};
150
0
    my $dbh = C4::Context->dbh;
151
0
    my $parent_id_tmp = $new_parent_id;
152
153    # check new-parent is not a child (or a child's child ;)
154
0
    my $sth = $dbh->prepare(qq|
155        SELECT budget_parent_id FROM
156            aqbudgets where budget_id = ? | );
157
0
    while (1) {
158
0
        $sth->execute($parent_id_tmp);
159
0
        my $res = $sth->fetchrow_hashref;
160
0
0
        if ( $res->{'budget_parent_id'} == $budget_id ) {
161
0
            return 1;
162        }
163
0
0
        if ( not defined $res->{'budget_parent_id'} ) {
164
0
            return 0;
165        }
166
0
        $parent_id_tmp = $res->{'budget_parent_id'};
167    }
168}
169
170# -------------------------------------------------------------------
171sub BudgetHasChildren {
172
0
0
    my ( $budget_id ) = @_;
173
0
    my $dbh = C4::Context->dbh;
174
0
    my $sth = $dbh->prepare(qq|
175       SELECT count(*) as sum FROM aqbudgets
176        WHERE budget_parent_id = ? | );
177
0
    $sth->execute( $budget_id );
178
0
    my $sum = $sth->fetchrow_hashref;
179
0
    return $sum->{'sum'};
180}
181
182# -------------------------------------------------------------------
183sub GetBudgetsPlanCell {
184
0
0
    my ( $cell, $period, $budget ) = @_;
185
0
    my ($actual, $sth);
186
0
    my $dbh = C4::Context->dbh;
187
0
0
0
0
    if ( $cell->{'authcat'} eq 'MONTHS' ) {
188        # get the actual amount
189
0
        $sth = $dbh->prepare( qq|
190
191            SELECT SUM(ecost) AS actual FROM aqorders
192                WHERE budget_id = ? AND
193                entrydate like "$cell->{'authvalue'}%" |
194        );
195
0
        $sth->execute( $cell->{'budget_id'} );
196    } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
197        # get the actual amount
198
0
        $sth = $dbh->prepare( qq|
199
200            SELECT SUM(ecost) FROM aqorders
201                LEFT JOIN aqorders_items
202                ON (aqorders.ordernumber = aqorders_items.ordernumber)
203                LEFT JOIN items
204                ON (aqorders_items.itemnumber = items.itemnumber)
205                WHERE budget_id = ? AND homebranch = ? | );
206
207
0
        $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
208    } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
209        # get the actual amount
210
0
        $sth = $dbh->prepare( qq|
211
212            SELECT SUM( ecost * quantity) AS actual
213                FROM aqorders JOIN biblioitems
214                ON (biblioitems.biblionumber = aqorders.biblionumber )
215                WHERE aqorders.budget_id = ? and itemtype = ? |
216        );
217
0
        $sth->execute( $cell->{'budget_id'},
218                        $cell->{'authvalue'} );
219    }
220    # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
221    else {
222        # get the actual amount
223
0
        $sth = $dbh->prepare( qq|
224
225        SELECT SUM(ecost * quantity) AS actual
226            FROM aqorders
227            JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
228            WHERE aqorders.budget_id = ? AND
229                ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
230                (aqbudgets.sort2_authcat = ? AND sort2 =?)) |
231        );
232
0
        $sth->execute( $cell->{'budget_id'},
233                        $budget->{'sort1_authcat'},
234                        $cell->{'authvalue'},
235                        $budget->{'sort2_authcat'},
236                        $cell->{'authvalue'}
237        );
238    }
239
0
    $actual = $sth->fetchrow_array;
240
241    # get the estimated amount
242
0
    $sth = $dbh->prepare( qq|
243
244        SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
245            WHERE budget_period_id = ? AND
246                budget_id = ? AND
247                authvalue = ? AND
248                authcat = ? |
249    );
250
0
    $sth->execute( $cell->{'budget_period_id'},
251                    $cell->{'budget_id'},
252                    $cell->{'authvalue'},
253                    $cell->{'authcat'},
254    );
255
256
257
0
    my $res = $sth->fetchrow_hashref;
258  # my $display = $res->{'display'};
259
0
    my $estimated = $res->{'estimated'};
260
261
262
0
    return $actual, $estimated;
263}
264
265# -------------------------------------------------------------------
266sub ModBudgetPlan {
267
0
0
    my ( $budget_plan, $budget_period_id, $authcat ) = @_;
268
0
    my $dbh = C4::Context->dbh;
269
0
    foreach my $buds (@$budget_plan) {
270
0
        my $lines = $buds->{lines};
271
0
        my $sth = $dbh->prepare( qq|
272                DELETE FROM aqbudgets_planning
273                    WHERE budget_period_id = ? AND
274                            budget_id = ? AND
275                            authcat = ? |
276        );
277    #delete a aqplan line of cells, then insert new cells,
278    # these could be UPDATES rather than DEL/INSERTS...
279
0
        $sth->execute( $budget_period_id, $lines->[0]{budget_id} , $authcat );
280
281
0
        foreach my $cell (@$lines) {
282
0
            my $sth = $dbh->prepare( qq|
283
284                INSERT INTO aqbudgets_planning
285                     SET budget_id = ?,
286                     budget_period_id = ?,
287                     authcat = ?,
288                     estimated_amount = ?,
289                     authvalue = ? |
290            );
291
0
            $sth->execute(
292                            $cell->{'budget_id'},
293                            $cell->{'budget_period_id'},
294                            $cell->{'authcat'},
295                            $cell->{'estimated_amount'},
296                            $cell->{'authvalue'},
297            );
298        }
299    }
300}
301
302# -------------------------------------------------------------------
303sub GetBudgetSpent {
304
0
0
        my ($budget_id) = @_;
305
0
        my $dbh = C4::Context->dbh;
306
0
        my $sth = $dbh->prepare(qq|
307        SELECT SUM( COALESCE(unitprice, ecost) * quantity ) AS sum FROM aqorders
308            WHERE budget_id = ? AND
309            quantityreceived > 0 AND
310            datecancellationprinted IS NULL
311    |);
312
313
0
        $sth->execute($budget_id);
314
0
        my $sum = $sth->fetchrow_array;
315
0
        return $sum;
316}
317
318# -------------------------------------------------------------------
319sub GetBudgetOrdered {
320
0
0
        my ($budget_id) = @_;
321
0
        my $dbh = C4::Context->dbh;
322
0
        my $sth = $dbh->prepare(qq|
323        SELECT SUM(ecost * quantity) AS sum FROM aqorders
324            WHERE budget_id = ? AND
325            quantityreceived = 0 AND
326            datecancellationprinted IS NULL
327    |);
328
329
0
        $sth->execute($budget_id);
330
0
        my $sum = $sth->fetchrow_array;
331
0
        return $sum;
332}
333
334# -------------------------------------------------------------------
335sub GetBudgetAuthCats {
336
0
0
    my ($budget_period_id) = shift;
337    # now, populate the auth_cats_loop used in the budget planning button
338    # we must retrieve all auth values used by at least one budget
339
0
    my $dbh = C4::Context->dbh;
340
0
    my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
341
0
    $sth->execute($budget_period_id);
342
0
    my %authcats;
343
0
    while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
344
0
        $authcats{$sort1_authcat}=1;
345
0
        $authcats{$sort2_authcat}=1;
346    }
347
0
    my @auth_cats_loop;
348
0
    foreach (sort keys %authcats) {
349
0
        push @auth_cats_loop,{ authcat => $_ };
350    }
351
0
    return \@auth_cats_loop;
352}
353
354# -------------------------------------------------------------------
355sub GetAuthvalueDropbox {
356
0
0
    my ( $authcat, $default ) = @_;
357
0
    my $dbh = C4::Context->dbh;
358
0
    my $sth = $dbh->prepare(
359        'SELECT authorised_value,lib FROM authorised_values
360        WHERE category = ? ORDER BY lib'
361    );
362
0
    $sth->execute( $authcat );
363
0
    my $option_list = [];
364
0
    my @authorised_values = ( q{} );
365
0
    while (my ($value, $lib) = $sth->fetchrow_array) {
366
0
0
        push @{$option_list}, {
367            value => $value,
368            label => $lib,
369            default => ($default eq $value),
370        };
371    }
372
373
0
0
0
    if ( @{$option_list} ) {
374
0
        return $option_list;
375    }
376
0
    return;
377}
378
379# -------------------------------------------------------------------
380sub GetBudgetPeriods {
381
0
0
        my ($filters,$orderby) = @_;
382
0
    return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide");
383}
384# -------------------------------------------------------------------
385sub GetBudgetPeriod {
386
0
0
        my ($budget_period_id) = @_;
387
0
        my $dbh = C4::Context->dbh;
388        ## $total = number of records linked to the record that must be deleted
389
0
        my $total = 0;
390        ## get information about the record that will be deleted
391
0
        my $sth;
392
0
0
        if ($budget_period_id) {
393
0
                $sth = $dbh->prepare( qq|
394              SELECT *
395                FROM aqbudgetperiods
396                WHERE budget_period_id=? |
397                );
398
0
                $sth->execute($budget_period_id);
399        } else { # ACTIVE BUDGET
400
0
                $sth = $dbh->prepare(qq|
401                          SELECT *
402                FROM aqbudgetperiods
403                WHERE budget_period_active=1 |
404                );
405
0
                $sth->execute();
406        }
407
0
        my $data = $sth->fetchrow_hashref;
408
0
        return $data;
409}
410
411# -------------------------------------------------------------------
412sub DelBudgetPeriod{
413
0
0
        my ($budget_period_id) = @_;
414
0
        my $dbh = C4::Context->dbh;
415          ; ## $total = number of records linked to the record that must be deleted
416
0
    my $total = 0;
417
418        ## get information about the record that will be deleted
419
0
        my $sth = $dbh->prepare(qq|
420                DELETE
421         FROM aqbudgetperiods
422         WHERE budget_period_id=? |
423        );
424
0
        return $sth->execute($budget_period_id);
425}
426
427# -------------------------------------------------------------------
428sub ModBudgetPeriod {
429
0
0
        my ($budget_period_information) = @_;
430
0
        return UpdateInTable("aqbudgetperiods",$budget_period_information);
431}
432
433# -------------------------------------------------------------------
434sub GetBudgetHierarchy {
435
0
0
    my ( $budget_period_id, $branchcode, $owner ) = @_;
436
0
    my @bind_params;
437
0
    my $dbh = C4::Context->dbh;
438
0
    my $query = qq|
439                    SELECT aqbudgets.*, aqbudgetperiods.budget_period_active
440                    FROM aqbudgets
441                    JOIN aqbudgetperiods USING (budget_period_id)|;
442
443
0
        my @where_strings;
444    # show only period X if requested
445
0
0
    if ($budget_period_id) {
446
0
        push @where_strings," aqbudgets.budget_period_id = ?";
447
0
        push @bind_params, $budget_period_id;
448    }
449        # show only budgets owned by me, my branch or everyone
450
0
0
    if ($owner) {
451
0
0
        if ($branchcode) {
452
0
            push @where_strings,
453            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="")))};
454
0
            push @bind_params, ( $owner, $branchcode );
455        } else {
456
0
            push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
457
0
            push @bind_params, $owner;
458        }
459    } else {
460
0
0
        if ($branchcode) {
461
0
            push @where_strings," (budget_branchcode =? or budget_branchcode is NULL)";
462
0
            push @bind_params, $branchcode;
463        }
464    }
465
0
0
        $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
466
0
0
        $debug && warn $query,join(",",@bind_params);
467
0
        my $sth = $dbh->prepare($query);
468
0
        $sth->execute(@bind_params);
469
0
        my $results = $sth->fetchall_arrayref({});
470
0
        my @res = @$results;
471
0
        my $i = 0;
472
0
        while (1) {
473
0
                my $depth_cnt = 0;
474
0
                foreach my $r (@res) {
475
0
                        my @child;
476                        # look for children
477
0
0
                        $r->{depth} = '0' if !defined $r->{budget_parent_id};
478
0
                        foreach my $r2 (@res) {
479
0
0
0
                                if (defined $r2->{budget_parent_id}
480                                        && $r2->{budget_parent_id} == $r->{budget_id}) {
481
0
                                        push @child, $r2->{budget_id};
482
0
0
                                        $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
483                                }
484                        }
485
0
0
                        $r->{child} = \@child if scalar @child > 0; # add the child
486
0
0
                        $depth_cnt++ if !defined $r->{'depth'};
487                }
488
0
0
0
                last if ($depth_cnt == 0 || $i == 100);
489
0
                $i++;
490        }
491
492        # look for top parents 1st
493
0
        my (@sort, $depth_count);
494
0
        ($i, $depth_count) = 0;
495
0
        while (1) {
496
0
                my $children = 0;
497
0
                foreach my $r (@res) {
498
0
0
                        if ($r->{depth} == $depth_count) {
499
0
0
                                $children++ if (ref $r->{child} eq 'ARRAY');
500
501                                # find the parent id element_id and insert it after
502
0
                                my $i2 = 0;
503
0
                                my $parent;
504
0
0
                                if ($depth_count > 0) {
505
506                                        # add indent
507
0
                                        my $depth = $r->{depth} * 2;
508
0
                                        $r->{budget_code_indent} = $r->{budget_code};
509
0
                                        $r->{budget_name_indent} = $r->{budget_name};
510
0
                                        foreach my $r3 (@sort) {
511
0
0
                                                if ($r3->{budget_id} == $r->{budget_parent_id}) {
512
0
                                                        $parent = $i2;
513
0
                                                        last;
514                                                }
515
0
                                                $i2++;
516                                        }
517                                } else {
518
0
                                        $r->{budget_code_indent} = $r->{budget_code};
519
0
                                        $r->{budget_name_indent} = $r->{budget_name};
520                                }
521
522
0
0
                                if (defined $parent) {
523
0
                                        splice @sort, ($parent + 1), 0, $r;
524                                } else {
525
0
                                        push @sort, $r;
526                                }
527                        }
528
529
0
                        $i++;
530                } # --------------foreach
531
0
                $depth_count++;
532
0
0
                last if $children == 0;
533        }
534
535# add budget-percent and allocation, and flags for html-template
536
0
        foreach my $r (@sort) {
537
0
                my $subs_href = $r->{'child'};
538
0
        my @subs_arr = ();
539
0
0
        if ( defined $subs_href ) {
540
0
0
            @subs_arr = @{$subs_href};
541        }
542
543
0
        my $moo = $r->{'budget_code_indent'};
544
0
        $moo =~ s/\ /\&nbsp\;/g;
545
0
        $r->{'budget_code_indent'} = $moo;
546
547
0
        $moo = $r->{'budget_name_indent'};
548
0
        $moo =~ s/\ /\&nbsp\;/g;
549
0
        $r->{'budget_name_indent'} = $moo;
550
551
0
        $r->{'budget_spent'} = GetBudgetSpent( $r->{'budget_id'} );
552
553
0
        $r->{'budget_amount_total'} = $r->{'budget_amount'};
554
555        # foreach sub-levels
556
0
        my $unalloc_count ;
557
558
0
                foreach my $sub (@subs_arr) {
559
0
                        my $sub_budget = GetBudget($sub);
560
561
0
                        $r->{budget_spent_sublevel} += GetBudgetSpent( $sub_budget->{'budget_id'} );
562
0
                        $unalloc_count += $sub_budget->{'budget_amount'};
563                }
564        }
565
0
        return \@sort;
566}
567
568# -------------------------------------------------------------------
569
570sub AddBudget {
571
0
0
    my ($budget) = @_;
572
0
        return InsertInTable("aqbudgets",$budget);
573}
574
575# -------------------------------------------------------------------
576sub ModBudget {
577
0
0
    my ($budget) = @_;
578
0
        return UpdateInTable("aqbudgets",$budget);
579}
580
581# -------------------------------------------------------------------
582sub DelBudget {
583
0
0
        my ($budget_id) = @_;
584
0
        my $dbh = C4::Context->dbh;
585
0
        my $sth = $dbh->prepare("delete from aqbudgets where budget_id=?");
586
0
        my $rc = $sth->execute($budget_id);
587
0
        return $rc;
588}
589
590
591 - 597
=head2 GetBudget

  &GetBudget($budget_id);

get a specific budget

=cut
598
599# -------------------------------------------------------------------
600sub GetBudget {
601
0
0
    my ( $budget_id ) = @_;
602
0
    my $dbh = C4::Context->dbh;
603
0
    my $query = "
604        SELECT *
605        FROM aqbudgets
606        WHERE budget_id=?
607        ";
608
0
    my $sth = $dbh->prepare($query);
609
0
    $sth->execute( $budget_id );
610
0
    my $result = $sth->fetchrow_hashref;
611
0
    return $result;
612}
613
614 - 620
=head2 GetChildBudgetsSpent

  &GetChildBudgetsSpent($budget-id);

gets the total spent of the level and sublevels of $budget_id

=cut
621
622# -------------------------------------------------------------------
623sub GetChildBudgetsSpent {
624
0
0
    my ( $budget_id ) = @_;
625
0
    my $dbh = C4::Context->dbh;
626
0
    my $query = "
627        SELECT *
628        FROM aqbudgets
629        WHERE budget_parent_id=?
630        ";
631
0
    my $sth = $dbh->prepare($query);
632
0
    $sth->execute( $budget_id );
633
0
    my $result = $sth->fetchall_arrayref({});
634
0
    my $total_spent = GetBudgetSpent($budget_id);
635
0
0
    if ($result){
636
0
0
        $total_spent += GetChildBudgetsSpent($_->{"budget_id"}) foreach @$result;
637    }
638
0
    return $total_spent;
639}
640
641 - 647
=head2 GetBudgets

  &GetBudgets($filter, $order_by);

gets all budgets

=cut
648
649# -------------------------------------------------------------------
650sub GetBudgets {
651
0
0
    my ($filters,$orderby) = @_;
652
0
    return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide");
653}
654
655# -------------------------------------------------------------------
656
657 - 666
=head2 GetCurrencies

  @currencies = &GetCurrencies;

Returns the list of all known currencies.

C<$currencies> is a array; its elements are references-to-hash, whose
keys are the fields from the currency table in the Koha database.

=cut
667
668sub GetCurrencies {
669
0
0
    my $dbh = C4::Context->dbh;
670
0
    my $query = "
671        SELECT *
672        FROM currency
673    ";
674
0
    my $sth = $dbh->prepare($query);
675
0
    $sth->execute;
676
0
    my @results = ();
677
0
    while ( my $data = $sth->fetchrow_hashref ) {
678
0
        push( @results, $data );
679    }
680
0
    return @results;
681}
682
683# -------------------------------------------------------------------
684
685sub GetCurrency {
686
0
0
    my $dbh = C4::Context->dbh;
687
0
    my $query = "
688        SELECT * FROM currency where active = '1' ";
689
0
    my $sth = $dbh->prepare($query);
690
0
    $sth->execute;
691
0
    my $r = $sth->fetchrow_hashref;
692
0
    return $r;
693}
694
695 - 701
=head2 ModCurrencies

&ModCurrencies($currency, $newrate);

Sets the exchange rate for C<$currency> to be C<$newrate>.

=cut
702
703sub ModCurrencies {
704
0
0
    my ( $currency, $rate ) = @_;
705
0
    my $dbh = C4::Context->dbh;
706
0
    my $query = qq|
707        UPDATE currency
708        SET rate=?
709        WHERE currency=? |;
710
0
    my $sth = $dbh->prepare($query);
711
0
    $sth->execute( $rate, $currency );
712}
713
714# -------------------------------------------------------------------
715
716 - 725
=head2 ConvertCurrency

  $foreignprice = &ConvertCurrency($currency, $localprice);

Converts the price C<$localprice> to foreign currency C<$currency> by
dividing by the exchange rate, and returns the result.

If no exchange rate is found, e is one to one.

=cut
726
727sub ConvertCurrency {
728
0
0
    my ( $currency, $price ) = @_;
729
0
    my $dbh = C4::Context->dbh;
730
0
    my $query = "
731        SELECT rate
732        FROM currency
733        WHERE currency=?
734    ";
735
0
    my $sth = $dbh->prepare($query);
736
0
    $sth->execute($currency);
737
0
    my $cur = ( $sth->fetchrow_array() )[0];
738
0
0
    unless ($cur) {
739
0
        $cur = 1;
740    }
741
0
    return ( $price / $cur );
742}
743
744 - 748
=head2 _columns

returns an array containing fieldname followed by PRI as value if PRIMARY Key

=cut
749
750sub _columns(;$) {
751
0
0
0
        my $tablename=shift||"aqbudgets";
752
0
0
    return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from $tablename",{Columns=>[1,4]})};
753}
754
755sub _filter_fields{
756
0
0
        my $budget=shift;
757
0
        my $tablename=shift;
758
0
    my @keys;
759
0
        my @values;
760
0
        my %columns= _columns($tablename);
761        #Filter Primary Keys of table
762
0
0
    my $elements=join "|",grep {$columns{$_} ne "PRI"} keys %columns;
763
0
0
        foreach my $field (grep {/\b($elements)\b/} keys %$budget){
764
0
0
0
                $$budget{$field}=format_date_in_iso($$budget{$field}) if ($field=~/date/ && $$budget{$field} !~C4::Dates->regexp("iso"));
765
0
                my $strkeys= " $field = ? ";
766
0
0
                if ($field=~/branch/){
767
0
                        $strkeys="( $strkeys OR $field='' OR $field IS NULL) ";
768                }
769
0
                push @values, $$budget{$field};
770
0
                push @keys, $strkeys;
771        }
772
0
        return (\@keys,\@values);
773}
774
775
6
6
722514
END { } # module clean-up code here (global destructor)
776
7771;