Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

C4/Budgets.pm

Browse source 
replace Bookfund.pm
This commit is contained in:
Paul Poulain 2009-04-28 22:35:25 +02:00 committed by Henri-Damien LAURENT
parent 6ef37b771c
commit ee92f51286
1 changed files with 915 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

915
C4/Budgets.pm Normal file
View file

@ -0,0 +1,915 @@
package C4::Budgets;
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
use strict;
use C4::Context;
use C4::Dates qw(format_date format_date_in_iso);
use C4::Debug;
use vars qw($VERSION @ISA @EXPORT);
BEGIN {
# set the version for version checking
$VERSION = 3.01;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
&GetBudget
&GetBudgets
&GetBudgetHierarchy
&AddBudget
&ModBudget
&DelBudget
&GetBudgetSpent
&GetPeriodsCount
&GetBudgetPeriod
&GetBudgetPeriods
&ModBudgetPeriod
&DelBudgetPeriod
&GetBudgetPeriodsDropbox
&GetBudgetSortDropbox
&GetAuthcatDropbox
&GetAuthvalueDropbox
&GetBudgetPermDropbox
&ModBudgetPlan
&GetCurrency
&GetCurrencies
&ModCurrencies
&ConvertCurrency
&GetBudgetsPlanCell
&AddBudgetPlanValue
&GetBudgetAuthCats
&BudgetHasChildren
&CheckBudgetParent
&CheckBudgetParentPerm
);
}
# ----------------------------BUDGETS.PM-----------------------------";
sub CheckBudgetParentPerm {
my ( $budget, $borrower_id ) = @_;
my $depth = $budget->{depth};
my $parent_id = $budget->{budget_parent_id};
while ($depth) {
my $parent = GetBudget($parent_id);
$parent_id = $parent->{budget_parent_id};
if ( $parent->{budget_owner_id} == $borrower_id ) {
return 1;
}
$depth--
}
return 0;
}
# -------------------------------------------------------------------
sub GetPeriodsCount {
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("
SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
$sth->execute();
my $res = $sth->fetchrow_hashref;
return $res->{'sum'};
}
# -------------------------------------------------------------------
sub CheckBudgetParent {
my ( $new_parent, $budget ) = @_;
my $new_parent_id = $new_parent->{'budget_id'};
my $budget_id = $budget->{'budget_id'};
my $dbh = C4::Context->dbh;
my $parent_id_tmp = $new_parent_id;
# check new-parent is not a child (or a child's child ;)
my $sth = $dbh->prepare(qq|
SELECT budget_parent_id FROM
aqbudgets where budget_id = ? | );
while (1) {
$sth->execute($parent_id_tmp);
my $res = $sth->fetchrow_hashref;
if ( $res->{'budget_parent_id'} == $budget_id ) {
return 1;
}
if ( not defined $res->{'budget_parent_id'} ) {
return 0;
}
$parent_id_tmp = $res->{'budget_parent_id'};
}
}
# -------------------------------------------------------------------
sub BudgetHasChildren {
my ( $budget_id ) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(qq|
SELECT count(*) as sum FROM aqbudgets
WHERE budget_parent_id = ? | );
$sth->execute( $budget_id );
my $sum = $sth->fetchrow_hashref;
$sth->finish;
return $sum->{'sum'};
}
# -------------------------------------------------------------------
sub GetBudgetsPlanCell {
my ( $cell, $period, $budget ) = @_;
my ($actual, $sth);
my $dbh = C4::Context->dbh;
if ( $cell->{'authcat'} eq 'MONTHS' ) {
# get the actual amount
$sth = $dbh->prepare( qq|
SELECT SUM(ecost) AS actual FROM aqorders
WHERE budget_id = ? AND
entrydate like "$cell->{'authvalue'}%" |
);
$sth->execute( $cell->{'budget_id'} );
} elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
# get the actual amount
$sth = $dbh->prepare( qq|
SELECT SUM(ecost) FROM aqorders
LEFT JOIN aqorders_items
ON (aqorders.ordernumber = aqorders_items.ordernumber)
LEFT JOIN items
ON (aqorders_items.itemnumber = items.itemnumber)
WHERE budget_id = ? AND homebranch = ? | );
$sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
} elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
# get the actual amount
$sth = $dbh->prepare( qq|
SELECT SUM( ecost * quantity) AS actual
FROM aqorders JOIN biblioitems
ON (biblioitems.biblionumber = aqorders.biblionumber )
WHERE aqorders.budget_id = ? and itemtype = ? |
);
$sth->execute( $cell->{'budget_id'},
$cell->{'authvalue'} );
}
# ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
else {
# get the actual amount
$sth = $dbh->prepare( qq|
SELECT SUM(ecost * quantity) AS actual
FROM aqorders
JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
WHERE aqorders.budget_id = ? AND
((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
(aqbudgets.sort2_authcat = ? AND sort2 =?)) |
);
$sth->{TraceLevel} = 2;
$sth->execute( $cell->{'budget_id'},
$budget->{'sort1_authcat'},
$cell->{'authvalue'},
$budget->{'sort2_authcat'},
$cell->{'authvalue'}
);
}
$actual = $sth->fetchrow_array;
# get the estimated amount
my $sth = $dbh->prepare( qq|
SELECT estimated_amount AS estimated FROM aqbudgets_planning
WHERE budget_period_id = ? AND
budget_id = ? AND
authvalue = ? AND
authcat = ? |
);
$sth->execute( $cell->{'budget_period_id'},
$cell->{'budget_id'},
$cell->{'authvalue'},
$cell->{'authcat'},
);
my $estimated = $sth->fetchrow_array;
return $actual, $estimated;
}
# -------------------------------------------------------------------
sub ModBudgetPlan {
my ( $budget_plan, $budget_period_id, $authcat ) = @_;
my $dbh = C4::Context->dbh;
foreach my $buds (@$budget_plan) {
my $lines = $buds->{lines};
my $sth = $dbh->prepare( qq|
DELETE FROM aqbudgets_planning
WHERE budget_period_id = ? AND
budget_id = ? AND
authcat = ? |
);
#delete a aqplan line of cells, then insert new cells,
# these could be UPDATES rather than DEL/INSERTS...
$sth->execute( $budget_period_id, $lines->[0]{budget_id} , $authcat );
foreach my $cell (@$lines) {
my $sth = $dbh->prepare( qq|
INSERT INTO aqbudgets_planning
SET budget_id = ?,
budget_period_id = ?,
authcat = ?,
estimated_amount = ?,
authvalue = ? |
);
$sth->execute(
$cell->{'budget_id'},
$cell->{'budget_period_id'},
$cell->{'authcat'},
$cell->{'estimated_amount'},
$cell->{'authvalue'},
);
}
}
}
# -------------------------------------------------------------------
sub GetBudgetSpent {
my ($budget_id) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(qq|
SELECT SUM(ecost * quantity ) AS sum FROM aqorders
WHERE budget_id = ? AND
datecancellationprinted IS NULL
|);
$sth->execute($budget_id);
my $sum = $sth->fetchrow_array;
# $sum = sprintf "%.2f", $sum;
return $sum;
}
# -------------------------------------------------------------------
sub GetBudgetPermDropbox {
my ($perm) = @_;
my %labels;
$labels{'0'} = 'None';
$labels{'1'} = 'Owner';
$labels{'2'} = 'Library';
my $radio = CGI::scrolling_list(
-name => 'budget_permission',
-values => [ '0', '1', '2' ],
-default => $perm,
-labels => \%labels,
-size => 1,
);
return $radio;
}
# -------------------------------------------------------------------
sub GetAuthcatDropbox {
my ($name, $default ) = @_;
my @authorised_values;
my $value;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(qq|
SELECT distinct(category)
FROM authorised_values WHERE category LIKE 'Asort%'
ORDER BY lib |
);
$sth->execute();
push @authorised_values, '';
while (my $value = $sth->fetchrow_array) {
push @authorised_values, $value;
}
my $budget_authcat_dropbox = CGI::scrolling_list(
-name => $name,
-values => \@authorised_values,
-override => 1,
-size => 1,
-default => $default,
-multiple => 0,
-tabindex => 1,
-id => $name,
);
return $budget_authcat_dropbox;
}
# -------------------------------------------------------------------
sub GetBudgetAuthCats {
my @auth_cats;
my $value;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(
"SELECT distinct(category)
FROM authorised_values where category like 'Asort%'
ORDER BY category"
);
$sth->execute();
while ( my $value = $sth->fetchrow_array ) {
push @auth_cats, $value;
}
my @loop_data = (); # initialize an array to hold your loop
while (@auth_cats) {
my %row_data; # get a fresh hash for the row data
$row_data{authcat} = shift @auth_cats;
push( @loop_data, \%row_data );
}
return @loop_data;
}
# -------------------------------------------------------------------
sub GetAuthvalueDropbox {
my ( $name, $authcat, $default ) = @_;
my @authorised_values;
my %authorised_lib;
my $value;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(
"SELECT authorised_value,lib
FROM authorised_values
WHERE category = ?
ORDER BY lib"
);
$sth->execute( $authcat );
push @authorised_values, '';
while (my ($value, $lib) = $sth->fetchrow_array) {
push @authorised_values, $value;
$authorised_lib{$value} = $lib;
}
return 0 if keys(%authorised_lib) == 0;
my $budget_authvalue_dropbox = CGI::scrolling_list(
-values => \@authorised_values,
-labels => \%authorised_lib,
-default => $default,
-override => 1,
-size => 1,
-multiple => 0,
-name => $name,
-id => $name,
);
return $budget_authvalue_dropbox
}
# -------------------------------------------------------------------
sub GetBudgetPeriodsDropbox {
my ($budget_period_id) = @_;
my %labels;
my @values;
my ($active, $periods) = GetBudgetPeriods();
foreach my $r (@$periods) {
$labels{"$r->{budget_period_id}"} = $r->{budget_period_description};
push @values, $r->{budget_period_id};
}
# if no buget_id is passed then its an add
my $budget_period_dropbox = CGI::scrolling_list(
-name => 'budget_period_id',
-values => \@values,
-default => $budget_period_id ? $budget_period_id : $active,
-size => 1,
-labels => \%labels,
);
return $budget_period_dropbox;
}
# -------------------------------------------------------------------
sub GetBudgetPeriods {
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(qq|
SELECT *
FROM aqbudgetperiods
ORDER BY budget_period_startdate, budget_period_enddate |
);
$sth->execute();
my @results;
my $active;
while (my $data = $sth->fetchrow_hashref) {
if ($data->{'budget_period_active'} == 1) {
$active = $data->{'budget_period_id'};
}
push(@results, $data);
}
$sth->finish;
return ($active, \@results);
}
# -------------------------------------------------------------------
sub GetBudgetPeriod {
my ($budget_period_id) = @_;
my $dbh = C4::Context->dbh;
## $total = number of records linked to the record that must be deleted
my $total = 0;
## get information about the record that will be deleted
my $sth;
if ($budget_period_id gt 0) {
$sth = $dbh->prepare( qq|
SELECT *
FROM aqbudgetperiods
WHERE budget_period_id=? |
);
$sth->execute($budget_period_id);
} else { # ACTIVE BUDGET
$sth = $dbh->prepare(qq|
SELECT *
FROM aqbudgetperiods
WHERE budget_period_active=1 |
);
$sth->execute();
}
my $data = $sth->fetchrow_hashref;
$sth->finish;
return $data;
}
# -------------------------------------------------------------------
sub DelBudgetPeriod() {
my ($budget_period_id) = @_;
my $dbh = C4::Context->dbh;
; ## $total = number of records linked to the record that must be deleted
my $total = 0;
## get information about the record that will be deleted
my $sth = $dbh->prepare(qq|
SELECT budget_period_id
, budget_period_startdate
, budget_period_enddate
, budget_period_amount
, budget_period_ref
, budget_period_description
FROM aqbudgetperiods
WHERE budget_period_id=? |
);
$sth->execute($budget_period_id);
my $data = $sth->fetchrow_hashref;
$sth->finish;
}
# -------------------------------------------------------------------
sub ModBudgetPeriod() {
my ($budget_period_id) = @_;
my $dbh = C4::Context->dbh
; ## $total = number of records linked to the record that must be deleted my $total = 0;
## get information about the record that will be deleted
my $sth = $dbh->prepare("
SELECT budget_period_id
, budget_period_startdate
, budget_period_enddate
, budget_period_amount
, budget_period_ref
, budget_period_description
FROM aqbudgetperiods
WHERE budget_period_id=?;"
);
$sth->execute($budget_period_id);
my $data = $sth->fetchrow_hashref;
$sth->finish;
}
# -------------------------------------------------------------------
sub GetBudgetHierarchy {
my ($budget_period_id, $branchcode, $owner) = @_;
my @bind_params;
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT *
FROM aqbudgets
WHERE budget_period_id = ? |;
push @bind_params, $budget_period_id;
# show only budgets owned by me, my branch or everyone
if ($owner) {
if ($branchcode) {
$query .= " AND (budget_owner_id = ? OR budget_branchcode = ? OR (budget_branchcode IS NULL AND budget_owner_id IS NULL))";
push @bind_params, $owner;
push @bind_params, $branchcode;
} else {
$query .= ' AND budget_owner_id = ?';
push @bind_params, $owner;
}
} else {
if ($branchcode) {
$query .= " AND (budget_branchcode =? or budget_branchcode is NULL)";
push @bind_params, $branchcode;
}
}
warn "Q : $query";
my $sth = $dbh->prepare($query);
$sth->execute(@bind_params);
my $results = $sth->fetchall_arrayref({});
my @res = @$results;
my $i = 0;
while (1) {
my $depth_cnt = 0;
foreach my $r (@res) {
my @child;
# look for children
$r->{depth} = '0' if !defined $r->{budget_parent_id};
foreach my $r2 (@res) {
if (defined $r2->{budget_parent_id}
&& $r2->{budget_parent_id} == $r->{budget_id}) {
push @child, $r2->{budget_id};
$r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
}
}
$r->{child} = \@child if scalar @child > 0; # add the child
$depth_cnt++ if !defined $r->{'depth'};
}
last if ($depth_cnt == 0 || $i == 100);
$i++;
}
# look for top parents 1st
my @sort;
my ($i, $depth_count) = 0;
while (1) {
my $children = 0;
foreach my $r (@res) {
if ($r->{depth} == $depth_count) {
$children++ if (ref $r->{child} eq 'ARRAY');
# find the parent id element_id and insert it after
my $i2 = 0;
my $parent;
if ($depth_count > 0) {
# add indent
my $depth = $r->{depth} * 2;
my $space = pack "A[$depth]";
$r->{budget_code_indent} = $space . $r->{budget_code};
$r->{budget_name_indent} = $space . $r->{budget_name};
foreach my $r3 (@sort) {
if ($r3->{budget_id} == $r->{budget_parent_id}) {
$parent = $i2;
last;
}
$i2++;
}
} else {
$r->{budget_code_indent} = $r->{budget_code};
$r->{budget_name_indent} = $r->{budget_name};
}
if (defined $parent) {
splice @sort, ($parent + 1), 0, $r;
} else {
push @sort, $r;
}
}
$i++;
} # --------------foreach
$depth_count++;
last if $children == 0;
}
# add budget-percent and allocation, and flags for html-template
foreach my $r (@sort) {
my $subs_href = $r->{'child'};
my @subs_arr = @$subs_href if defined $subs_href;
my $moo = $r->{'budget_code_indent'};
$moo =~ s/\ /\&nbsp\;/g;
$r->{'budget_code_indent'} = $moo;
my $moo = $r->{'budget_name_indent'};
$moo =~ s/\ /\&nbsp\;/g;
$r->{'budget_name_indent'} = $moo;
$r->{'budget_spent'} = GetBudgetSpent( $r->{'budget_id'} );
# $budget->{'budget_alloc'} = sprintf( "%.2f", $budget->{'budget_alloc'} - $budget->{'budget_amount alloc'} );
# $budget->{'budget_alloc'} = sprintf( "%.2f", $budget->{'budget_alloc'} );
$r->{'budget_amount_total'} = $r->{'budget_amount'} + $r->{'budget_amount_sublevel'} ;
# $r->{budget_alloc} = $r->{'budget_amount'} - $r->{'budget_amount_sublevel'} ;
# $r->{'budget_amount_sublevel'} ;
# foreach sub-levels
my $unalloc_count ;
foreach my $sub (@subs_arr) {
my $sub_budget = GetBudget($sub);
# $r->{budget_spent_sublevel} += $bud->{'budget_amount'} ;
$r->{budget_spent_sublevel} += GetBudgetSpent( $sub_budget->{'budget_id'} );
$unalloc_count += $sub_budget->{'budget_amount'} + $sub_budget->{'budget_amount_sublevel'};
}
$r->{budget_unalloc_sublevel} = $r->{'budget_amount_sublevel'} - $unalloc_count;
# (($r->{'budget_amount'} - $r->{'budget_alloc'}) / $r->{'budget_amount'}) * 100;
=c
# my $percent = $r->{'budget_amount'} ? ( $r->{'budget_alloc'} / $r->{'budget_amount'} ) * 100 : 0;
# my $spent_percent = ( $r->{'budget_spent'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
# (($r->{'budget_amount'} - $r->{'budget_alloc'}) / $r->{'budget_amount'}) * 100;
# my $percent = ( $r->{'budget_alloc'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
# my $spent_percent = ( $r->{'budget_spent'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
if ($percent == 0) {
$r->{budget_alloc_none} = 1;
} elsif ($percent == 100) {
$r->{budget_alloc_full} = 1
} else {
$r->{budget_alloc_percent} = sprintf("%00d", $percent);
}
=cut
if ( scalar @subs_arr == 0 && $r->{budget_amount_sublevel} > 0 ) {
$r->{warn_no_subs} = 1;
}
}
return \@sort;
}
# -------------------------------------------------------------------
sub AddBudget {
my ($budget) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
INSERT INTO aqbudgets
SET budget_code = ?,
budget_period_id = ?,
budget_parent_id = ?,
budget_name = ?,
budget_branchcode = ?,
budget_amount = ?,
budget_amount_sublevel = ?,
budget_encumb = ?,
budget_expend = ?,
budget_notes = ?,
sort1_authcat = ?,
sort2_authcat = ?,
budget_owner_id = ?,
budget_permission = ?
|;
my $sth = $dbh->prepare($query);
$sth->execute(
$budget->{'budget_code'} ? $budget->{'budget_code'} : undef,
$budget->{'budget_period_id'} ? $budget->{'budget_period_id'} : undef,
$budget->{'budget_parent_id'} ? $budget->{'budget_parent_id'} : undef,
$budget->{'budget_name'} ? $budget->{'budget_name'} : undef,
$budget->{'budget_branchcode'} ? $budget->{'budget_branchcode'} : undef,
$budget->{'budget_amount'} ? $budget->{'budget_amount'} : undef,
$budget->{'budget_amount_sublevel'} ? $budget->{'budget_amount_sublevel'} : undef,
$budget->{'budget_encumb'} ? $budget->{'budget_encumb'} : undef,
$budget->{'budget_expend'} ? $budget->{'budget_expend'} : undef,
$budget->{'budget_notes'} ? $budget->{'budget_notes'} : undef,
$budget->{'sort1_authcat'} ? $budget->{'sort1_authcat'} : undef,
$budget->{'sort2_authcat'} ? $budget->{'sort2_authcat'} : undef,
$budget->{'budget_owner_id'} ? $budget->{'budget_owner_id'} : undef,
$budget->{'budget_permission'} ? $budget->{'budget_permission'} : undef,
);
$sth->finish;
}
# -------------------------------------------------------------------
sub ModBudget {
my ($budget) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
UPDATE aqbudgets
SET budget_code = ?,
budget_period_id = ?,
budget_parent_id = ?,
budget_name = ?,
budget_branchcode = ?,
budget_amount = ?,
budget_amount_sublevel = ?,
budget_encumb = ?,
budget_expend = ?,
budget_notes = ?,
sort1_authcat = ?,
sort2_authcat = ?,
budget_owner_id = ?,
budget_permission = ?
WHERE budget_id = ?
|;
my $sth = $dbh->prepare($query);
$sth->execute(
$budget->{'budget_code'} ? $budget->{'budget_code'} : undef,
$budget->{'budget_period_id'} ? $budget->{'budget_period_id'} : undef,
$budget->{'budget_parent_id'} ? $budget->{'budget_parent_id'} : undef,
$budget->{'budget_name'} ? $budget->{'budget_name'} : undef,
$budget->{'budget_branchcode'} ? $budget->{'budget_branchcode'} : undef,
$budget->{'budget_amount'} ? $budget->{'budget_amount'} : undef,
$budget->{'budget_amount_sublevel'} ? $budget->{'budget_amount_sublevel'} : undef,
$budget->{'budget_encumb'} ? $budget->{'budget_encumb'} : undef,
$budget->{'budget_expend'} ? $budget->{'budget_expend'} : undef,
$budget->{'budget_notes'} ? $budget->{'budget_notes'} : undef,
$budget->{'sort1_authcat'} ? $budget->{'sort1_authcat'} : undef,
$budget->{'sort2_authcat'} ? $budget->{'sort2_authcat'} : undef,
$budget->{'budget_owner_id'} ? $budget->{'budget_owner_id'} : undef,
$budget->{'budget_permission'} ? $budget->{'budget_permission'} : undef,
$budget->{'budget_id'},
);
$sth->finish;
}
# -------------------------------------------------------------------
sub DelBudget {
my ($budget_id) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("delete from aqbudgets where budget_id=?");
my $rc = $sth->execute($budget_id);
$sth->finish;
return $rc;
}
=back
=head2 FUNCTIONS ABOUT BUDGETS
=over 2
=cut
=head3 GetBudget
=over 4
&GetBudget($budget_id);
get a specific budget
=back
=cut
# -------------------------------------------------------------------
sub GetBudget {
my ( $budget_id ) = @_;
my $dbh = C4::Context->dbh;
my $query;
my $query = "
SELECT *
FROM aqbudgets
WHERE budget_id=?
";
my $sth = $dbh->prepare($query);
$sth->execute( $budget_id );
my $result = $sth->fetchrow_hashref;
return $result;
}
=head3 GetBudgets
=over 4
&GetBudget($budget_id);
gets all budgets
=back
=cut
# -------------------------------------------------------------------
sub GetBudgets {
my ($active) = @_;
my $dbh = C4::Context->dbh;
my $q = "SELECT * from aqbudgets";
my $row;
my $sth;
unless ($active) {
$sth = $dbh->prepare($q);
$sth->execute();
} else {
$q = "select budget_period_id from aqbudgetperiods where budget_period_active = 1 ";
$sth = $dbh->prepare($q);
$sth->execute();
$row = $sth->fetchrow_hashref();
$q = "select * from aqbudgets WHERE budget_period_id =? ";
$sth = $dbh->prepare($q);
$sth->execute( $row->{'budget_period_id'} );
}
my $results = $sth->fetchall_arrayref( {} );
$sth->finish;
return $results;
}
# -------------------------------------------------------------------
=head3 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
sub GetCurrencies {
my $dbh = C4::Context->dbh;
my $query = "
SELECT *
FROM currency
";
my $sth = $dbh->prepare($query);
$sth->execute;
my @results = ();
while ( my $data = $sth->fetchrow_hashref ) {
push( @results, $data );
}
$sth->finish;
return @results;
}
# -------------------------------------------------------------------
sub GetCurrency {
my $dbh = C4::Context->dbh;
my $query = "
SELECT * FROM currency where active = '1' ";
my $sth = $dbh->prepare($query);
$sth->execute;
my $r = $sth->fetchrow_hashref;
$sth->finish;
return $r;
}
=head3 ModCurrencies
&ModCurrencies($currency, $newrate);
Sets the exchange rate for C<$currency> to be C<$newrate>.
=cut
sub ModCurrencies {
my ( $currency, $rate ) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
UPDATE currency
SET rate=?
WHERE currency=? |;
my $sth = $dbh->prepare($query);
$sth->execute( $rate, $currency );
}
# -------------------------------------------------------------------
=head3 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
sub ConvertCurrency {
my ( $currency, $price ) = @_;
my $dbh = C4::Context->dbh;
my $query = "
SELECT rate
FROM currency
WHERE currency=?
";
my $sth = $dbh->prepare($query);
$sth->execute($currency);
my $cur = ( $sth->fetchrow_array() )[0];
unless ($cur) {
$cur = 1;
}
return ( $price / $cur );
}
END { } # module clean-up code here (global destructor)
1;
__END__
=back
=head1 AUTHOR
Koha Developement team <info@koha.org>
=cut