X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=7c867e0aabdea5a5a3170845bfd3b4635e1c71d2;hb=26bee7eee7d3e4602bc5e757278f600224fcbdf5;hp=106a61cafade249714749fe80eca60b804993eee;hpb=ee92f5128689ba2bd4f7a632634b1918615c05d0;p=koha_gimpoz diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 106a61cafa..7c867e0aab 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -13,13 +13,15 @@ package C4::Budgets; # 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 +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +#use warnings; FIXME - Bug 2505 use C4::Context; use C4::Dates qw(format_date format_date_in_iso); +use C4::SQLHelper qw<:all>; use C4::Debug; use vars qw($VERSION @ISA @EXPORT); @@ -38,34 +40,79 @@ BEGIN { &ModBudget &DelBudget &GetBudgetSpent + &GetBudgetOrdered &GetPeriodsCount + &GetChildBudgetsSpent &GetBudgetPeriod &GetBudgetPeriods &ModBudgetPeriod + &AddBudgetPeriod &DelBudgetPeriod - &GetBudgetPeriodsDropbox - &GetBudgetSortDropbox - &GetAuthcatDropbox &GetAuthvalueDropbox - &GetBudgetPermDropbox &ModBudgetPlan + &GetCurrency &GetCurrencies &ModCurrencies &ConvertCurrency - &GetBudgetsPlanCell + + &GetBudgetsPlanCell &AddBudgetPlanValue &GetBudgetAuthCats &BudgetHasChildren &CheckBudgetParent &CheckBudgetParentPerm + + &HideCols + &GetCols ); } # ----------------------------BUDGETS.PM-----------------------------"; + + +=head1 FUNCTIONS ABOUT BUDGETS + +=cut + +sub HideCols { + my ( $authcat, @hide_cols ) = @_; + my $dbh = C4::Context->dbh; + + my $sth1 = $dbh->prepare( + qq| + UPDATE aqbudgets_planning SET display = 0 + WHERE authcat = ? + AND authvalue = ? | + ); + foreach my $authvalue (@hide_cols) { +# $sth1->{TraceLevel} = 3; + $sth1->execute( $authcat, $authvalue ); + } +} + +sub GetCols { + my ( $authcat, $authvalue ) = @_; + + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + qq| + SELECT count(display) as cnt from aqbudgets_planning + WHERE authcat = ? + AND authvalue = ? and display = 0 | + ); + +# $sth->{TraceLevel} = 3; + $sth->execute( $authcat, $authvalue ); + my $res = $sth->fetchrow_hashref; + + return $res->{cnt} > 0 ? 0: 1 + +} + sub CheckBudgetParentPerm { my ( $budget, $borrower_id ) = @_; my $depth = $budget->{depth}; @@ -81,6 +128,10 @@ sub CheckBudgetParentPerm { return 0; } +sub AddBudgetPeriod { + my ($budgetperiod) = @_; + return InsertInTable("aqbudgetperiods",$budgetperiod); +} # ------------------------------------------------------------------- sub GetPeriodsCount { my $dbh = C4::Context->dbh; @@ -125,7 +176,6 @@ sub BudgetHasChildren { WHERE budget_parent_id = ? | ); $sth->execute( $budget_id ); my $sum = $sth->fetchrow_hashref; - $sth->finish; return $sum->{'sum'}; } @@ -179,7 +229,6 @@ sub GetBudgetsPlanCell { ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR (aqbudgets.sort2_authcat = ? AND sort2 =?)) | ); - $sth->{TraceLevel} = 2; $sth->execute( $cell->{'budget_id'}, $budget->{'sort1_authcat'}, $cell->{'authvalue'}, @@ -190,9 +239,9 @@ sub GetBudgetsPlanCell { $actual = $sth->fetchrow_array; # get the estimated amount - my $sth = $dbh->prepare( qq| + $sth = $dbh->prepare( qq| - SELECT estimated_amount AS estimated FROM aqbudgets_planning + SELECT estimated_amount AS estimated, display FROM aqbudgets_planning WHERE budget_period_id = ? AND budget_id = ? AND authvalue = ? AND @@ -203,7 +252,13 @@ sub GetBudgetsPlanCell { $cell->{'authvalue'}, $cell->{'authcat'}, ); - my $estimated = $sth->fetchrow_array; + + + my $res = $sth->fetchrow_hashref; + # my $display = $res->{'display'}; + my $estimated = $res->{'estimated'}; + + return $actual, $estimated; } @@ -249,168 +304,83 @@ sub GetBudgetSpent { my ($budget_id) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare(qq| - SELECT SUM(ecost * quantity ) AS sum FROM aqorders + SELECT SUM( COALESCE(unitprice, ecost) * quantity ) AS sum FROM aqorders WHERE budget_id = ? AND - datecancellationprinted IS NULL + quantityreceived > 0 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; +sub GetBudgetOrdered { + my ($budget_id) = @_; 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; - } + SELECT SUM(ecost * quantity) AS sum FROM aqorders + WHERE budget_id = ? AND + quantityreceived = 0 AND + datecancellationprinted IS NULL + |); - 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; + $sth->execute($budget_id); + my $sum = $sth->fetchrow_array; + return $sum; } # ------------------------------------------------------------------- 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 ($budget_period_id) = shift; + # now, populate the auth_cats_loop used in the budget planning button + # we must retrieve all auth values used by at least one budget + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?"); + $sth->execute($budget_period_id); + my %authcats; + while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) { + $authcats{$sort1_authcat}=1; + $authcats{$sort2_authcat}=1; } - 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 ); + my @auth_cats_loop; + foreach (sort keys %authcats) { + push @auth_cats_loop,{ authcat => $_ }; } - return @loop_data; + return \@auth_cats_loop; } # ------------------------------------------------------------------- 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, + my ( $authcat, $default ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + 'SELECT authorised_value,lib FROM authorised_values + WHERE category = ? ORDER BY lib' ); + $sth->execute( $authcat ); + my $option_list = []; + my @authorised_values = ( q{} ); + while (my ($value, $lib) = $sth->fetchrow_array) { + push @{$option_list}, { + value => $value, + label => $lib, + default => ($default eq $value), + }; + } - 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; + if ( @{$option_list} ) { + return $option_list; + } + return; } # ------------------------------------------------------------------- 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); + my ($filters,$orderby) = @_; + return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide"); } - # ------------------------------------------------------------------- sub GetBudgetPeriod { my ($budget_period_id) = @_; @@ -419,7 +389,7 @@ sub GetBudgetPeriod { my $total = 0; ## get information about the record that will be deleted my $sth; - if ($budget_period_id gt 0) { + if ($budget_period_id) { $sth = $dbh->prepare( qq| SELECT * FROM aqbudgetperiods @@ -435,12 +405,11 @@ sub GetBudgetPeriod { $sth->execute(); } my $data = $sth->fetchrow_hashref; - $sth->finish; return $data; } # ------------------------------------------------------------------- -sub DelBudgetPeriod() { +sub DelBudgetPeriod{ my ($budget_period_id) = @_; my $dbh = C4::Context->dbh; ; ## $total = number of records linked to the record that must be deleted @@ -448,69 +417,53 @@ sub DelBudgetPeriod() { ## 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 + DELETE FROM aqbudgetperiods WHERE budget_period_id=? | ); - $sth->execute($budget_period_id); - my $data = $sth->fetchrow_hashref; - $sth->finish; + return $sth->execute($budget_period_id); } # ------------------------------------------------------------------- -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 ModBudgetPeriod { + my ($budget_period_information) = @_; + return UpdateInTable("aqbudgetperiods",$budget_period_information); } # ------------------------------------------------------------------- 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; + my ( $budget_period_id, $branchcode, $owner ) = @_; + my @bind_params; + my $dbh = C4::Context->dbh; + my $query = qq| + SELECT aqbudgets.*, aqbudgetperiods.budget_period_active + FROM aqbudgets + JOIN aqbudgetperiods USING (budget_period_id)|; + + my @where_strings; + # show only period X if requested + if ($budget_period_id) { + push @where_strings," aqbudgets.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; + push @where_strings, + 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="")))}; + push @bind_params, ( $owner, $branchcode ); } else { - $query .= ' AND budget_owner_id = ?'; + push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") '; push @bind_params, $owner; } } else { if ($branchcode) { - $query .= " AND (budget_branchcode =? or budget_branchcode is NULL)"; + push @where_strings," (budget_branchcode =? or budget_branchcode is NULL)"; push @bind_params, $branchcode; } } - warn "Q : $query"; + $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings; + $debug && warn $query,join(",",@bind_params); my $sth = $dbh->prepare($query); $sth->execute(@bind_params); my $results = $sth->fetchall_arrayref({}); @@ -537,8 +490,8 @@ sub GetBudgetHierarchy { } # look for top parents 1st - my @sort; - my ($i, $depth_count) = 0; + my (@sort, $depth_count); + ($i, $depth_count) = 0; while (1) { my $children = 0; foreach my $r (@res) { @@ -552,9 +505,8 @@ sub GetBudgetHierarchy { # 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}; + $r->{budget_code_indent} = $r->{budget_code}; + $r->{budget_name_indent} = $r->{budget_name}; foreach my $r3 (@sort) { if ($r3->{budget_id} == $r->{budget_parent_id}) { $parent = $i2; @@ -566,7 +518,7 @@ sub GetBudgetHierarchy { $r->{budget_code_indent} = $r->{budget_code}; $r->{budget_name_indent} = $r->{budget_name}; } - + if (defined $parent) { splice @sort, ($parent + 1), 0, $r; } else { @@ -583,148 +535,47 @@ sub GetBudgetHierarchy { # 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 @subs_arr = (); + if ( defined $subs_href ) { + @subs_arr = @{$subs_href}; + } my $moo = $r->{'budget_code_indent'}; $moo =~ s/\ /\ \;/g; $r->{'budget_code_indent'} = $moo; - my $moo = $r->{'budget_name_indent'}; + $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'} ; + $r->{'budget_amount_total'} = $r->{'budget_amount'}; # 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); + $unalloc_count += $sub_budget->{'budget_amount'}; } -=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; + my ($budget) = @_; + return InsertInTable("aqbudgets",$budget); } # ------------------------------------------------------------------- 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; + return UpdateInTable("aqbudgets",$budget); } # ------------------------------------------------------------------- @@ -733,35 +584,22 @@ sub DelBudget { 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 +=head2 GetBudget -&GetBudget($budget_id); + &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 @@ -773,47 +611,52 @@ sub GetBudget { return $result; } -=head3 GetBudgets +=head2 GetChildBudgetsSpent -=over 4 + &GetChildBudgetsSpent($budget-id); -&GetBudget($budget_id); +gets the total spent of the level and sublevels of $budget_id -gets all budgets +=cut + +# ------------------------------------------------------------------- +sub GetChildBudgetsSpent { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT * + FROM aqbudgets + WHERE budget_parent_id=? + "; + my $sth = $dbh->prepare($query); + $sth->execute( $budget_id ); + my $result = $sth->fetchall_arrayref({}); + my $total_spent = GetBudgetSpent($budget_id); + if ($result){ + $total_spent += GetChildBudgetsSpent($_->{"budget_id"}) foreach @$result; + } + return $total_spent; +} -=back +=head2 GetBudgets + + &GetBudgets($filter, $order_by); + +gets all budgets =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; + my ($filters,$orderby) = @_; + return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide"); } # ------------------------------------------------------------------- -=head3 GetCurrencies +=head2 GetCurrencies -@currencies = &GetCurrencies; + @currencies = &GetCurrencies; Returns the list of all known currencies. @@ -834,7 +677,6 @@ sub GetCurrencies { while ( my $data = $sth->fetchrow_hashref ) { push( @results, $data ); } - $sth->finish; return @results; } @@ -847,11 +689,10 @@ sub GetCurrency { my $sth = $dbh->prepare($query); $sth->execute; my $r = $sth->fetchrow_hashref; - $sth->finish; return $r; } -=head3 ModCurrencies +=head2 ModCurrencies &ModCurrencies($currency, $newrate); @@ -872,15 +713,14 @@ sub ModCurrencies { # ------------------------------------------------------------------- -=head3 ConvertCurrency +=head2 ConvertCurrency -$foreignprice = &ConvertCurrency($currency, $localprice); + $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. +If no exchange rate is found, e is one to one. =cut @@ -901,15 +741,44 @@ sub ConvertCurrency { return ( $price / $cur ); } +=head2 _columns + +returns an array containing fieldname followed by PRI as value if PRIMARY Key + +=cut + +sub _columns(;$) { + my $tablename=shift||"aqbudgets"; + return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from $tablename",{Columns=>[1,4]})}; +} + +sub _filter_fields{ + my $budget=shift; + my $tablename=shift; + my @keys; + my @values; + my %columns= _columns($tablename); + #Filter Primary Keys of table + my $elements=join "|",grep {$columns{$_} ne "PRI"} keys %columns; + foreach my $field (grep {/\b($elements)\b/} keys %$budget){ + $$budget{$field}=format_date_in_iso($$budget{$field}) if ($field=~/date/ && $$budget{$field} !~C4::Dates->regexp("iso")); + my $strkeys= " $field = ? "; + if ($field=~/branch/){ + $strkeys="( $strkeys OR $field='' OR $field IS NULL) "; + } + push @values, $$budget{$field}; + push @keys, $strkeys; + } + return (\@keys,\@values); +} + END { } # module clean-up code here (global destructor) 1; __END__ -=back - =head1 AUTHOR -Koha Developement team +Koha Development Team =cut