X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=a6487738515f0309c977a6c6b7379e309bc70cf3;hb=4f9ee9a6b8d1c84d4ff9894998f0f9a8904201fa;hp=088275676e18a223b3b448b23a33dca358776cbb;hpb=b06a289173d0f2e299b0c8652d59d47dc196062c;p=koha.git diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 088275676e..a648773851 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -28,7 +28,7 @@ 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( @@ -41,19 +41,22 @@ BEGIN { &DelBudget &GetBudgetSpent &GetBudgetOrdered + &GetBudgetName &GetPeriodsCount &GetChildBudgetsSpent + &GetBudgetUsers + &ModBudgetUsers + &CanUserUseBudget + &CanUserModifyBudget + &GetBudgetPeriod &GetBudgetPeriods &ModBudgetPeriod &AddBudgetPeriod &DelBudgetPeriod - &GetBudgetPeriodsDropbox - &GetBudgetSortDropbox &GetAuthvalueDropbox - &GetBudgetPermDropbox &ModBudgetPlan @@ -307,14 +310,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 +341,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; } # ------------------------------------------------------------------- @@ -374,61 +401,40 @@ 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; - } + my ( $authcat, $default ) = @_; + my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; + my $dbh = C4::Context->dbh; - 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 $query = qq{ + SELECT * + FROM authorised_values + }; + $query .= qq{ + LEFT JOIN authorised_values_branches ON ( id = av_id ) + } if $branch_limit; + $query .= qq{ + WHERE category = ? + }; + $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit; + $query .= " GROUP BY lib ORDER BY category, lib, lib_opac"; + my $sth = $dbh->prepare($query); + $sth->execute( $authcat, $branch_limit ? $branch_limit : () ); - 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}; - } + my $option_list = []; + my @authorised_values = ( q{} ); + while (my $av = $sth->fetchrow_hashref) { + push @{$option_list}, { + value => $av->{authorised_value}, + label => $av->{lib}, + default => ($default eq $av->{authorised_value}), + }; + } - # 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; } # ------------------------------------------------------------------- @@ -487,17 +493,15 @@ sub ModBudgetPeriod { # ------------------------------------------------------------------- sub GetBudgetHierarchy { - my ($budget_period_id, $branchcode, $owner) = @_; - my @bind_params; - my $dbh = C4::Context->dbh; - my $query = qq| - SELECT aqbudgets.* + 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 - LEFT JOIN aqbudgetperiods - ON aqbudgetperiods.budget_period_id=aqbudgets.budget_period_id |; + JOIN aqbudgetperiods USING (budget_period_id)|; + my @where_strings; - # Pick out the active ones - push @where_strings, 'aqbudgetperiods.budget_period_active=1'; # show only period X if requested if ($budget_period_id) { push @where_strings," aqbudgets.budget_period_id = ?"; @@ -506,8 +510,9 @@ sub GetBudgetHierarchy { # show only budgets owned by me, my branch or everyone if ($owner) { if ($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); + 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 { push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") '; push @bind_params, $owner; @@ -591,7 +596,10 @@ 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; @@ -664,11 +672,11 @@ sub GetBudget { return $result; } -=head2 GetBudgets +=head2 GetChildBudgetsSpent - &GetBudgets($filter, $order_by); + &GetChildBudgetsSpent($budget-id); -gets all budgets +gets the total spent of the level and sublevels of $budget_id =cut @@ -691,20 +699,174 @@ sub GetChildBudgetsSpent { return $total_spent; } -=head2 GetChildBudgetsSpent +=head2 GetBudgets - &GetChildBudgetsSpent($budget-id); + &GetBudgets($filter, $order_by); -gets the total spent of the level and sublevels of $budget_id +gets all budgets =cut # ------------------------------------------------------------------- sub GetBudgets { - my ($filters,$orderby) = @_; + my $filters = shift; + my $orderby = shift || 'budget_name'; return SearchInTable("aqbudgets",$filters, $orderby, undef,undef, undef, "wide"); } +=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 + && $budget->{budget_owner_id} + && $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; + } + + # 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; + } + } + + 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; +} + # ------------------------------------------------------------------- =head2 GetCurrencies