X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=30b9079810e0a4940d8a4ab1d80d3d0bd019836b;hb=4458ac5764126049d95e115adeacd1f335efdb8f;hp=98e5d632b7be57ad99c53a424f488b6ee736dba8;hpb=8f21144fb154b68747d004eecca53fe84a020f22;p=koha_fer diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 98e5d632b7..30b9079810 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -20,20 +20,20 @@ package C4::Budgets; 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 Koha::Database; use C4::Debug; - use vars qw($VERSION @ISA @EXPORT); BEGIN { # set the version for version checking - $VERSION = 3.01; + $VERSION = 3.07.00.049; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( &GetBudget + &GetBudgetByOrderNumber + &GetBudgetByCode &GetBudgets &GetBudgetHierarchy &AddBudget @@ -41,8 +41,15 @@ BEGIN { &DelBudget &GetBudgetSpent &GetBudgetOrdered + &GetBudgetName &GetPeriodsCount - &GetChildBudgetsSpent + GetBudgetHierarchySpent + GetBudgetHierarchyOrdered + + &GetBudgetUsers + &ModBudgetUsers + &CanUserUseBudget + &CanUserModifyBudget &GetBudgetPeriod &GetBudgetPeriods @@ -50,11 +57,6 @@ BEGIN { &AddBudgetPeriod &DelBudgetPeriod - &GetBudgetPeriodsDropbox - &GetBudgetSortDropbox - &GetAuthvalueDropbox - &GetBudgetPermDropbox - &ModBudgetPlan &GetCurrency @@ -133,7 +135,10 @@ sub CheckBudgetParentPerm { sub AddBudgetPeriod { my ($budgetperiod) = @_; - return InsertInTable("aqbudgetperiods",$budgetperiod); + return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate}); + + my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod'); + return $resultset->create($budgetperiod)->id; } # ------------------------------------------------------------------- sub GetPeriodsCount { @@ -307,14 +312,24 @@ 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 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; } @@ -328,28 +343,42 @@ 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; } -# ------------------------------------------------------------------- -sub GetBudgetPermDropbox { - my ($perm) = @_; - my %labels; - $labels{'0'} = 'None'; - $labels{'1'} = 'Owner'; - $labels{'2'} = 'Library'; - my $radio = CGI::scrolling_list( - -id => 'budget_permission', - -name => 'budget_permission', - -values => [ '0', '1', '2' ], - -default => $perm, - -labels => \%labels, - -size => 1, - ); - return $radio; +=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; } # ------------------------------------------------------------------- @@ -373,68 +402,13 @@ 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, - ); - - 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 ($filters,$orderby) = @_; - return SearchInTable("aqbudgetperiods",$filters, $orderby, undef,undef, undef, "wide"); + + my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod'); + $rs = $rs->search( $filters, { order_by => $orderby } ); + $rs->result_class('DBIx::Class::ResultClass::HashRefInflator'); + return [ $rs->all ]; } # ------------------------------------------------------------------- sub GetBudgetPeriod { @@ -481,8 +455,12 @@ sub DelBudgetPeriod{ # ------------------------------------------------------------------- sub ModBudgetPeriod { - my ($budget_period_information) = @_; - return UpdateInTable("aqbudgetperiods",$budget_period_information); + my ($budget_period) = @_; + my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period); + return unless($result); + + $result = $result->update($budget_period); + return $result->in_storage; } # ------------------------------------------------------------------- @@ -491,7 +469,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)|; @@ -587,50 +565,34 @@ sub GetBudgetHierarchy { 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 = (); - if ( defined $subs_href ) { - @subs_arr = @{$subs_href}; - } - - my $moo = $r->{'budget_code_indent'}; - $moo =~ s/\ /\ \;/g; - $r->{'budget_code_indent'} = $moo; - - $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'}; - - # 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'}; - } - } - return \@sort; + foreach my $budget (@sort) { + $budget->{budget_spent} = GetBudgetSpent( $budget->{budget_id} ); + $budget->{budget_ordered} = GetBudgetOrdered( $budget->{budget_id} ); + $budget->{total_spent} = GetBudgetHierarchySpent( $budget->{budget_id} ); + $budget->{total_ordered} = GetBudgetHierarchyOrdered( $budget->{budget_id} ); + } + return \@sort; } # ------------------------------------------------------------------- sub AddBudget { my ($budget) = @_; - return InsertInTable("aqbudgets",$budget); + return unless ($budget); + + my $resultset = Koha::Database->new()->schema->resultset('Aqbudget'); + return $resultset->create($budget)->id; } # ------------------------------------------------------------------- sub ModBudget { my ($budget) = @_; - return UpdateInTable("aqbudgets",$budget); + my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget); + return unless($result); + + $result = $result->update($budget); + return $result->in_storage; } # ------------------------------------------------------------------- @@ -666,33 +628,103 @@ sub GetBudget { return $result; } -=head2 GetChildBudgetsSpent +=head2 GetBudgetByOrderNumber - &GetChildBudgetsSpent($budget-id); + &GetBudgetByOrderNumber($ordernumber); -gets the total spent of the level and sublevels of $budget_id +get a specific budget by order number =cut # ------------------------------------------------------------------- -sub GetChildBudgetsSpent { - my ( $budget_id ) = @_; +sub GetBudgetByOrderNumber { + my ( $ordernumber ) = @_; my $dbh = C4::Context->dbh; my $query = " - SELECT * - FROM aqbudgets - WHERE budget_parent_id=? + SELECT aqbudgets.* + FROM aqbudgets, aqorders + WHERE ordernumber=? + AND aqorders.budget_id = aqbudgets.budget_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; + $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 GetBudgetHierarchySpent + + my $spent = GetBudgetHierarchySpent( $budget_id ); + +Gets the total spent of the level and sublevels of $budget_id + +=cut + +sub GetBudgetHierarchySpent { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + my $children_ids = $dbh->selectcol_arrayref(q| + SELECT budget_id + FROM aqbudgets + WHERE budget_parent_id = ? + |, {}, $budget_id ); + + my $total_spent = GetBudgetSpent( $budget_id ); + for my $child_id ( @$children_ids ) { + $total_spent += GetBudgetHierarchySpent( $child_id ); } return $total_spent; } +=head2 GetBudgetHierarchyOrdered + + my $ordered = GetBudgetHierarchyOrdered( $budget_id ); + +Gets the total ordered of the level and sublevels of $budget_id + +=cut + +sub GetBudgetHierarchyOrdered { + my ( $budget_id ) = @_; + my $dbh = C4::Context->dbh; + my $children_ids = $dbh->selectcol_arrayref(q| + SELECT budget_id + FROM aqbudgets + WHERE budget_parent_id = ? + |, {}, $budget_id ); + + my $total_ordered = GetBudgetOrdered( $budget_id ); + for my $child_id ( @$children_ids ) { + $total_ordered += GetBudgetHierarchyOrdered( $child_id ); + } + return $total_ordered; +} + =head2 GetBudgets &GetBudgets($filter, $order_by); @@ -703,8 +735,188 @@ gets all budgets # ------------------------------------------------------------------- sub GetBudgets { - my ($filters,$orderby) = @_; - return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide"); + my ($filters, $orderby) = @_; + $orderby = 'budget_name' unless($orderby); + + my $rs = Koha::Database->new()->schema->resultset('Aqbudget'); + $rs = $rs->search( $filters, { order_by => $orderby } ); + $rs->result_class('DBIx::Class::ResultClass::HashRefInflator'); + return [ $rs->all ]; +} + +=head2 GetBudgetUsers + + my @borrowernumbers = &GetBudgetUsers($budget_id); + +Return the list of borrowernumbers linked to a budget + +=cut + +sub GetBudgetUsers { + my ($budget_id) = @_; + + my $dbh = C4::Context->dbh; + my $query = qq{ + SELECT borrowernumber + FROM aqbudgetborrowers + WHERE budget_id = ? + }; + my $sth = $dbh->prepare($query); + $sth->execute($budget_id); + + my @borrowernumbers; + while (my ($borrowernumber) = $sth->fetchrow_array) { + push @borrowernumbers, $borrowernumber + } + + return @borrowernumbers; +} + +=head2 ModBudgetUsers + + &ModBudgetUsers($budget_id, @borrowernumbers); + +Modify the list of borrowernumbers linked to a budget + +=cut + +sub ModBudgetUsers { + my ($budget_id, @budget_users_id) = @_; + + return unless $budget_id; + + my $dbh = C4::Context->dbh; + my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?"; + my $sth = $dbh->prepare($query); + $sth->execute($budget_id); + + $query = qq{ + INSERT INTO aqbudgetborrowers (budget_id, borrowernumber) + VALUES (?,?) + }; + $sth = $dbh->prepare($query); + foreach my $borrowernumber (@budget_users_id) { + next unless $borrowernumber; + $sth->execute($budget_id, $borrowernumber); + } +} + +sub CanUserUseBudget { + my ($borrower, $budget, $userflags) = @_; + + if (not ref $borrower) { + $borrower = C4::Members::GetMember(borrowernumber => $borrower); + } + if (not ref $budget) { + $budget = GetBudget($budget); + } + + return 0 unless ($borrower and $budget); + + if (not defined $userflags) { + $userflags = C4::Auth::getuserflags($borrower->{flags}, + $borrower->{userid}); + } + + unless ($userflags->{superlibrarian} + || (ref $userflags->{acquisition} + && $userflags->{acquisition}->{budget_manage_all}) + || (!ref $userflags->{acquisition} && $userflags->{acquisition})) + { + if (not exists $userflags->{acquisition}) { + return 0; + } + + if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) { + return 0; + } + + # Budget restricted to owner + if ( $budget->{budget_permission} == 1 ) { + if ( $budget->{budget_owner_id} + and $budget->{budget_owner_id} != $borrower->{borrowernumber} ) + { + return 0; + } + } + + # Budget restricted to owner, users and library + 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 + 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; + } + } + } + + return 1; +} + +sub CanUserModifyBudget { + my ($borrower, $budget, $userflags) = @_; + + if (not ref $borrower) { + $borrower = C4::Members::GetMember(borrowernumber => $borrower); + } + if (not ref $budget) { + $budget = GetBudget($budget); + } + + return 0 unless ($borrower and $budget); + + if (not defined $userflags) { + $userflags = C4::Auth::getuserflags($borrower->{flags}, + $borrower->{userid}); + } + + unless ($userflags->{superlibrarian} + || (ref $userflags->{acquisition} + && $userflags->{acquisition}->{budget_manage_all}) + || (!ref $userflags->{acquisition} && $userflags->{acquisition})) + { + if (!CanUserUseBudget($borrower, $budget, $userflags)) { + return 0; + } + + if (ref $userflags->{acquisition} + && !$userflags->{acquisition}->{budget_modify}) { + return 0; + } + } + + return 1; } # ------------------------------------------------------------------- @@ -796,37 +1008,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;