X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBudgets.pm;h=882172f05e5de7992e64a5859be699b18fda4cae;hb=3c8c0591e2344ba6e44df16319b47065d23d652e;hp=d516a12dc24dd635b6b16741ad667aa36a27108f;hpb=408543294e69797d7258621e26b83736474caac8;p=srvgit

diff --git a/C4/Budgets.pm b/C4/Budgets.pm
index d516a12dc2..882172f05e 100644
--- a/C4/Budgets.pm
+++ b/C4/Budgets.pm
@@ -28,12 +28,14 @@ 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,19 +43,22 @@ BEGIN {
         &DelBudget
         &GetBudgetSpent
         &GetBudgetOrdered
+        &GetBudgetName
         &GetPeriodsCount
         &GetChildBudgetsSpent
 
+        &GetBudgetUsers
+        &ModBudgetUsers
+        &CanUserUseBudget
+        &CanUserModifyBudget
+
 	    &GetBudgetPeriod
         &GetBudgetPeriods
         &ModBudgetPeriod
         &AddBudgetPeriod
 	    &DelBudgetPeriod
 
-	    &GetBudgetPeriodsDropbox
-        &GetBudgetSortDropbox
         &GetAuthvalueDropbox
-        &GetBudgetPermDropbox
 
         &ModBudgetPlan
 
@@ -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;
 }
 
 # -------------------------------------------------------------------
@@ -374,61 +403,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;
 }
 
 # -------------------------------------------------------------------
@@ -491,7 +499,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)|;
                         
@@ -604,17 +612,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;
@@ -666,11 +672,60 @@ 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 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);
+
+gets the total spent of the level and sublevels of $budget_id
 
 =cut
 
@@ -693,20 +748,196 @@ 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 ) {
+            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;
+}
+
 # -------------------------------------------------------------------
 
 =head2 GetCurrencies
@@ -796,37 +1027,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;