From ee92f5128689ba2bd4f7a632634b1918615c05d0 Mon Sep 17 00:00:00 2001 From: Paul Poulain Date: Tue, 28 Apr 2009 22:35:25 +0200 Subject: [PATCH] C4/Budgets.pm replace Bookfund.pm --- C4/Budgets.pm | 915 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 915 insertions(+) create mode 100644 C4/Budgets.pm diff --git a/C4/Budgets.pm b/C4/Budgets.pm new file mode 100644 index 0000000000..106a61cafa --- /dev/null +++ b/C4/Budgets.pm @@ -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/\ /\ \;/g; + $r->{'budget_code_indent'} = $moo; + + my $moo = $r->{'budget_name_indent'}; + $moo =~ s/\ /\ \;/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 + +=cut -- 2.39.2