X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=005bba8d176629a9c015c7ce9117a3670a5da066;hb=08c2668ee218e162af099de7dffa724624e04ac5;hp=ddb65cc8f62f4131e6237ccbb5f165e383c8514a;hpb=d347b15163a86f6c40e587469da61eb9d4d3efed;p=koha.git diff --git a/C4/Budgets.pm b/C4/Budgets.pm index ddb65cc8f6..005bba8d17 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,25 +40,29 @@ 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 @@ -71,19 +77,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 @@ -130,6 +131,10 @@ sub CheckBudgetParentPerm { return 0; } +sub AddBudgetPeriod { + my ($budgetperiod) = @_; + return InsertInTable("aqbudgetperiods",$budgetperiod); +} # ------------------------------------------------------------------- sub GetPeriodsCount { my $dbh = C4::Context->dbh; @@ -174,7 +179,6 @@ sub BudgetHasChildren { WHERE budget_parent_id = ? | ); $sth->execute( $budget_id ); my $sum = $sth->fetchrow_hashref; - $sth->finish; return $sum->{'sum'}; } @@ -228,7 +232,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'}, @@ -239,7 +242,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 @@ -304,14 +307,30 @@ 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(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; +} + +# ------------------------------------------------------------------- +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 - datecancellationprinted IS NULL + quantityreceived = 0 AND + datecancellationprinted IS NULL |); $sth->execute($budget_id); my $sum = $sth->fetchrow_array; -# $sum = sprintf "%.2f", $sum; return $sum; } @@ -323,6 +342,7 @@ sub GetBudgetPermDropbox { $labels{'1'} = 'Owner'; $labels{'2'} = 'Library'; my $radio = CGI::scrolling_list( + -id => 'budget_permission', -name => 'budget_permission', -values => [ '0', '1', '2' ], -default => $perm, @@ -332,37 +352,6 @@ sub GetBudgetPermDropbox { 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 ($budget_period_id) = shift; @@ -444,25 +433,9 @@ sub GetBudgetPeriodsDropbox { # ------------------------------------------------------------------- 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) = @_; @@ -471,7 +444,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 @@ -487,12 +460,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 @@ -500,40 +472,17 @@ 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); } # ------------------------------------------------------------------- @@ -543,30 +492,30 @@ sub GetBudgetHierarchy { my $dbh = C4::Context->dbh; my $query = qq| SELECT aqbudgets.* - FROM aqbudgets - JOIN aqbudgetperiods USING (budget_period_id) - WHERE budget_period_active=1 |; + FROM aqbudgets |; # show only period X if requested + my @where_strings; 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({}); @@ -593,8 +542,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) { @@ -608,9 +557,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; @@ -622,7 +570,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 { @@ -645,13 +593,13 @@ sub GetBudgetHierarchy { $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 ; @@ -660,101 +608,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); } # ------------------------------------------------------------------- @@ -763,35 +633,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 @@ -803,47 +660,52 @@ sub GetBudget { return $result; } -=head3 GetBudgets - -=over 4 +=head2 GetBudgets -&GetBudget($budget_id); + &GetBudgets($filter, $order_by); gets all budgets -=back +=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; +} + +=head2 GetChildBudgetsSpent + + &GetChildBudgetsSpent($budget-id); + +gets the total spent of the level and sublevels of $budget_id =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. @@ -864,7 +726,6 @@ sub GetCurrencies { while ( my $data = $sth->fetchrow_hashref ) { push( @results, $data ); } - $sth->finish; return @results; } @@ -877,11 +738,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); @@ -902,15 +762,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 @@ -931,15 +790,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