X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=c0b6a2bec6f36a970770c071a3176e4817ff415c;hb=d514c21aed640be48dfbc70d3976ec0f865bb370;hp=e9732ac83ac2dbdf65f336f311218727db155913;hpb=203757e353cbbb2add934523fdbd7113c6180207;p=koha_fer diff --git a/C4/Budgets.pm b/C4/Budgets.pm index e9732ac83a..c0b6a2bec6 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -34,6 +34,8 @@ BEGIN { @EXPORT = qw( &GetBudget + &GetBudgetByOrderNumber + &GetBudgetByCode &GetBudgets &GetBudgetHierarchy &AddBudget @@ -41,6 +43,7 @@ BEGIN { &DelBudget &GetBudgetSpent &GetBudgetOrdered + &GetBudgetName &GetPeriodsCount &GetChildBudgetsSpent @@ -55,8 +58,6 @@ BEGIN { &AddBudgetPeriod &DelBudgetPeriod - &GetAuthvalueDropbox - &ModBudgetPlan &GetCurrency @@ -314,9 +315,19 @@ sub GetBudgetSpent { quantityreceived > 0 AND datecancellationprinted IS NULL |); - $sth->execute($budget_id); my $sum = $sth->fetchrow_array; + + $sth = $dbh->prepare(qq| + SELECT SUM(shipmentcost) AS sum + FROM aqinvoices + WHERE shipmentcost_budgetid = ? + AND closedate IS NOT NULL + |); + $sth->execute($budget_id); + my ($shipmentcost_sum) = $sth->fetchrow_array; + $sum += $shipmentcost_sum; + return $sum; } @@ -330,12 +341,44 @@ sub GetBudgetOrdered { quantityreceived = 0 AND datecancellationprinted IS NULL |); - $sth->execute($budget_id); my $sum = $sth->fetchrow_array; + + $sth = $dbh->prepare(qq| + SELECT SUM(shipmentcost) AS sum + FROM aqinvoices + WHERE shipmentcost_budgetid = ? + AND closedate IS NULL + |); + $sth->execute($budget_id); + my ($shipmentcost_sum) = $sth->fetchrow_array; + $sum += $shipmentcost_sum; + return $sum; } +=head2 GetBudgetName + + my $budget_name = &GetBudgetName($budget_id); + +get the budget_name for a given budget_id + +=cut + +sub GetBudgetName { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + qq| + SELECT budget_name + FROM aqbudgets + WHERE budget_id = ? + |); + + $sth->execute($budget_id); + return $sth->fetchrow_array; +} + # ------------------------------------------------------------------- sub GetBudgetAuthCats { my ($budget_period_id) = shift; @@ -357,31 +400,6 @@ sub GetBudgetAuthCats { } # ------------------------------------------------------------------- -sub GetAuthvalueDropbox { - 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), - }; - } - - if ( @{$option_list} ) { - return $option_list; - } - return; -} - -# ------------------------------------------------------------------- sub GetBudgetPeriods { my ($filters,$orderby) = @_; return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide"); @@ -441,7 +459,7 @@ sub GetBudgetHierarchy { my @bind_params; my $dbh = C4::Context->dbh; my $query = qq| - SELECT aqbudgets.*, aqbudgetperiods.budget_period_active + SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description FROM aqbudgets JOIN aqbudgetperiods USING (budget_period_id)|; @@ -554,17 +572,15 @@ sub GetBudgetHierarchy { $r->{'budget_name_indent'} = $moo; $r->{'budget_spent'} = GetBudgetSpent( $r->{'budget_id'} ); + $r->{budget_ordered} = GetBudgetOrdered( $r->{budget_id} ); - $r->{'budget_amount_total'} = $r->{'budget_amount'}; - + $r->{budget_spent_sublevels} = 0; + $r->{budget_ordered_sublevels} = 0; # foreach sub-levels - my $unalloc_count ; - foreach my $sub (@subs_arr) { my $sub_budget = GetBudget($sub); - - $r->{budget_spent_sublevel} += GetBudgetSpent( $sub_budget->{'budget_id'} ); - $unalloc_count += $sub_budget->{'budget_amount'}; + $r->{budget_spent_sublevels} += GetBudgetSpent( $sub_budget->{'budget_id'} ); + $r->{budget_ordered_sublevels} += GetBudgetOrdered($sub); } } return \@sort; @@ -616,6 +632,55 @@ sub GetBudget { return $result; } +=head2 GetBudgetByOrderNumber + + &GetBudgetByOrderNumber($ordernumber); + +get a specific budget by order number + +=cut + +# ------------------------------------------------------------------- +sub GetBudgetByOrderNumber { + my ( $ordernumber ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT aqbudgets.* + FROM aqbudgets, aqorders + WHERE ordernumber=? + AND aqorders.budget_id = aqbudgets.budget_id + "; + my $sth = $dbh->prepare($query); + $sth->execute( $ordernumber ); + my $result = $sth->fetchrow_hashref; + return $result; +} + +=head2 GetBudgetByCode + + my $budget = &GetBudgetByCode($budget_code); + +Retrieve all aqbudgets fields as a hashref for the budget that has +given budget_code + +=cut + +sub GetBudgetByCode { + my ( $budget_code ) = @_; + + my $dbh = C4::Context->dbh; + my $query = qq{ + SELECT * + FROM aqbudgets + WHERE budget_code = ? + ORDER BY budget_id DESC + LIMIT 1 + }; + my $sth = $dbh->prepare( $query ); + $sth->execute( $budget_code ); + return $sth->fetchrow_hashref; +} + =head2 GetChildBudgetsSpent &GetChildBudgetsSpent($budget-id); @@ -653,7 +718,8 @@ gets all budgets # ------------------------------------------------------------------- sub GetBudgets { - my ($filters,$orderby) = @_; + my $filters = shift; + my $orderby = shift || 'budget_name'; return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide"); } @@ -745,30 +811,52 @@ sub CanUserUseBudget { } # Budget restricted to owner - if ($budget->{budget_permission} == 1 - && $budget->{budget_owner_id} - && $budget->{budget_owner_id} != $borrower->{borrowernumber}) { - return 0; + if ( $budget->{budget_permission} == 1 ) { + if ( $budget->{budget_owner_id} + and $budget->{budget_owner_id} != $borrower->{borrowernumber} ) + { + return 0; + } } - my @budget_users = GetBudgetUsers($budget->{budget_id}); - # Budget restricted to owner, users and library - if ($budget->{budget_permission} == 2 - && $budget->{budget_owner_id} - && $budget->{budget_owner_id} != $borrower->{borrowernumber} - && (0 == grep {$borrower->{borrowernumber} == $_} @budget_users) - && defined $budget->{budget_branchcode} - && $budget->{budget_branchcode} ne C4::Context->userenv->{branch}) { - return 0; + elsif ( $budget->{budget_permission} == 2 ) { + my @budget_users = GetBudgetUsers( $budget->{budget_id} ); + + if ( + ( + $budget->{budget_owner_id} + and $budget->{budget_owner_id} != + $borrower->{borrowernumber} + or not $budget->{budget_owner_id} + ) + and ( 0 == grep { $borrower->{borrowernumber} == $_ } + @budget_users ) + and defined $budget->{budget_branchcode} + and $budget->{budget_branchcode} ne + C4::Context->userenv->{branch} + ) + { + return 0; + } } # Budget restricted to owner and users - if ($budget->{budget_permission} == 3 - && $budget->{budget_owner_id} - && $budget->{budget_owner_id} != $borrower->{borrowernumber} - && (0 == grep {$borrower->{borrowernumber} == $_} @budget_users)) { - return 0; + elsif ( $budget->{budget_permission} == 3 ) { + my @budget_users = GetBudgetUsers( $budget->{budget_id} ); + if ( + ( + $budget->{budget_owner_id} + and $budget->{budget_owner_id} != + $borrower->{borrowernumber} + or not $budget->{budget_owner_id} + ) + and ( 0 == grep { $borrower->{borrowernumber} == $_ } + @budget_users ) + ) + { + return 0; + } } } @@ -899,37 +987,6 @@ 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;