X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=7c867e0aabdea5a5a3170845bfd3b4635e1c71d2;hb=d0b2d72e0b5506643ad01b9bfe9eaae860b9b5d3;hp=d2a5b761b2f6fceed80ae046f482e5f95d675fdd;hpb=521bb9654dd87078adc03def1f5cccfc1c80102d;p=koha_gimpoz diff --git a/C4/Budgets.pm b/C4/Budgets.pm index d2a5b761b2..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,24 +40,26 @@ BEGIN { &ModBudget &DelBudget &GetBudgetSpent + &GetBudgetOrdered &GetPeriodsCount + &GetChildBudgetsSpent &GetBudgetPeriod &GetBudgetPeriods &ModBudgetPeriod + &AddBudgetPeriod &DelBudgetPeriod - &GetBudgetPeriodsDropbox - &GetBudgetSortDropbox &GetAuthvalueDropbox - &GetBudgetPermDropbox &ModBudgetPlan + &GetCurrency &GetCurrencies &ModCurrencies &ConvertCurrency - &GetBudgetsPlanCell + + &GetBudgetsPlanCell &AddBudgetPlanValue &GetBudgetAuthCats &BudgetHasChildren @@ -70,19 +74,14 @@ BEGIN { # ----------------------------BUDGETS.PM-----------------------------"; +=head1 FUNCTIONS ABOUT BUDGETS + +=cut + sub HideCols { my ( $authcat, @hide_cols ) = @_; my $dbh = C4::Context->dbh; -=c - my $sth = $dbh->prepare( - qq| - UPDATE aqbudgets_planning - SET display = 1 where authcat = ? | - ); - $sth->execute( $authcat ); -=cut - my $sth1 = $dbh->prepare( qq| UPDATE aqbudgets_planning SET display = 0 @@ -129,6 +128,10 @@ sub CheckBudgetParentPerm { return 0; } +sub AddBudgetPeriod { + my ($budgetperiod) = @_; + return InsertInTable("aqbudgetperiods",$budgetperiod); +} # ------------------------------------------------------------------- sub GetPeriodsCount { my $dbh = C4::Context->dbh; @@ -173,7 +176,6 @@ sub BudgetHasChildren { WHERE budget_parent_id = ? | ); $sth->execute( $budget_id ); my $sum = $sth->fetchrow_hashref; - $sth->finish; return $sum->{'sum'}; } @@ -227,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'}, @@ -238,7 +239,7 @@ sub GetBudgetsPlanCell { $actual = $sth->fetchrow_array; # get the estimated amount - my $sth = $dbh->prepare( qq| + $sth = $dbh->prepare( qq| SELECT estimated_amount AS estimated, display FROM aqbudgets_planning WHERE budget_period_id = ? AND @@ -303,32 +304,31 @@ 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 GetBudgetOrdered { + 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 + quantityreceived = 0 AND + datecancellationprinted IS NULL + |); + + $sth->execute($budget_id); + my $sum = $sth->fetchrow_array; + return $sum; } # ------------------------------------------------------------------- @@ -353,84 +353,34 @@ sub GetBudgetAuthCats { # ------------------------------------------------------------------- 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) = @_; @@ -439,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 @@ -455,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 @@ -468,73 +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 aqbudgets.* - FROM aqbudgets - JOIN aqbudgetperiods USING (budget_period_id) - WHERE budget_period_active=1 |; + 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) { - $query .= "AND aqbudgets.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 = ? OR budget_owner_id IS NULL'; + 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; } } + $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({}); @@ -561,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) { @@ -576,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; @@ -590,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 { @@ -607,19 +535,22 @@ 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'} ); - $r->{'budget_amount_total'} = $r->{'budget_amount'} + $r->{'budget_amount_sublevel'} ; + $r->{'budget_amount_total'} = $r->{'budget_amount'}; # foreach sub-levels my $unalloc_count ; @@ -628,101 +559,23 @@ sub GetBudgetHierarchy { my $sub_budget = GetBudget($sub); $r->{budget_spent_sublevel} += GetBudgetSpent( $sub_budget->{'budget_id'} ); - $unalloc_count += $sub_budget->{'budget_amount'} + $sub_budget->{'budget_amount_sublevel'}; + $unalloc_count += $sub_budget->{'budget_amount'}; } - - $r->{budget_unalloc_sublevel} = $r->{'budget_amount_sublevel'} - $unalloc_count; - - 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); } # ------------------------------------------------------------------- @@ -731,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 @@ -771,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 -=back +# ------------------------------------------------------------------- +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; +} + +=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. @@ -832,7 +677,6 @@ sub GetCurrencies { while ( my $data = $sth->fetchrow_hashref ) { push( @results, $data ); } - $sth->finish; return @results; } @@ -845,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); @@ -870,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 @@ -899,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