Bug 9044: (follow-up) fix merge conflict typo that broke this script
[koha.git] / C4 / Budgets.pm
index 0882756..334e610 100644 (file)
@@ -28,12 +28,13 @@ 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
         &GetBudgets
         &GetBudgetHierarchy
            &AddBudget
@@ -41,19 +42,22 @@ BEGIN {
         &DelBudget
         &GetBudgetSpent
         &GetBudgetOrdered
+        &GetBudgetName
         &GetPeriodsCount
         &GetChildBudgetsSpent
 
+        &GetBudgetUsers
+        &ModBudgetUsers
+        &CanUserUseBudget
+        &CanUserModifyBudget
+
            &GetBudgetPeriod
         &GetBudgetPeriods
         &ModBudgetPeriod
         &AddBudgetPeriod
            &DelBudgetPeriod
 
-           &GetBudgetPeriodsDropbox
-        &GetBudgetSortDropbox
         &GetAuthvalueDropbox
-        &GetBudgetPermDropbox
 
         &ModBudgetPlan
 
@@ -307,14 +311,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 +342,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 +402,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 +494,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 +511,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 +597,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/\ /\&nbsp\;/g;
@@ -664,11 +673,35 @@ sub GetBudget {
     return $result;
 }
 
-=head2 GetBudgets
+=head2 GetBudgetByOrderNumber
 
-  &GetBudgets($filter, $order_by);
+  &GetBudgetByOrderNumber($ordernumber);
 
-gets all budgets
+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 GetChildBudgetsSpent
+
+  &GetChildBudgetsSpent($budget-id);
+
+gets the total spent of the level and sublevels of $budget_id
 
 =cut
 
@@ -691,20 +724,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