From 4ac8b0e29dab65a664169f66a5f89e925725c07f Mon Sep 17 00:00:00 2001
From: Martin Mares <mj@ucw.cz>
Date: Mon, 31 Oct 2011 13:00:23 +0100
Subject: [PATCH] Let bq display (an approximation of) active locks

---
 bq               | 11 ++++++++++-
 lib/BEX/Queue.pm | 35 +++++++++++++++++++++++++++++++----
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/bq b/bq
index 55ef177..e35528a 100755
--- a/bq
+++ b/bq
@@ -27,11 +27,17 @@ AMEN
 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
 my $queue = BEX::Queue->new($queue_name);
 
+if ($queue->is_locked(undef, undef)) {
+	print "### Queue lock present\n\n";
+}
+
 my %jobs = ();
 my %machs = ();
 my %subj = ();
 my %stat = ();
+my %mach_locked = ();
 for my $m (@machines) {
+	$mach_locked{$m} = $queue->is_locked($m, undef);
 	for my $j ($queue->scan($m)) {
 		push @{$jobs{$j}}, $m;
 		push @{$machs{$m}}, $j;
@@ -44,12 +50,15 @@ for my $m (@machines) {
 		} else {
 			$stat{$m}{$j} = '';
 		}
+		if ($mach_locked{$m} || $queue->is_locked($m, $j)) {
+			$stat{$m}{$j} .= ' [LOCKED]';
+		}
 	}
 }
 
 if ($by_host) {
 	for my $m (sort keys %machs) {
-		print "$m\n";
+		print "$m", ($mach_locked{$m} ? ' [LOCKED]' : ''), "\n";
 		for my $j (@{$machs{$m}}) {
 			print "\t$j", $subj{$j}, $stat{$m}{$j}, "\n";
 		}
diff --git a/lib/BEX/Queue.pm b/lib/BEX/Queue.pm
index 4735497..0e4cfd9 100644
--- a/lib/BEX/Queue.pm
+++ b/lib/BEX/Queue.pm
@@ -158,21 +158,35 @@ sub write_job_status($$$$) {
 	close S;
 }
 
+sub lock_name($$$) {
+	my ($queue, $machine, $jid) = @_;
+	my $lock = $queue->{'Name'};
+	if (defined $jid) {
+		$lock .= "/hosts/$machine/$jid.lock";
+	} elsif (defined $machine) {
+		$lock .= "/hosts/$machine/lock";
+	} else {
+		$lock .= '/lock';
+	}
+}
+
 # Whenever we want to run a job on a machine, we must obtain a lock;
 # at most one lock can be held at a time by a single BEX::Queue object.
 # See the description of locking schemes in BEX::Config.
 sub lock($$$) {
 	my ($queue, $machine, $jid) = @_;
-	my $lock = $queue->{'Name'};
+	my $lock;
 	given ($BEX::Config::locking_scheme) {
-		when ('queue') { $lock .= '/lock'; }
+		when ('queue') {
+			$lock = lock_name($queue, undef, undef);
+		}
 		when ('host') {
 			defined($machine) or return 1;
-			$lock .= "/hosts/$machine/lock";
+			$lock = lock_name($queue, $machine, undef);
 		}
 		when ('job') {
 			defined($machine) && defined($jid) or return 1;
-			$lock .= "/hosts/$machine/$jid.lock";
+			$lock = lock_name($queue, $machine, $jid);
 		}
 		when ('none') { return 1; }
 		default { die "Invalid BEX::Config::locking_scheme"; }
@@ -201,4 +215,17 @@ sub unlock($) {
 	delete $queue->{'LockName'};
 }
 
+# Unsafe (does not check fcntl, only existence of a lock file), but should be enough for bq
+sub is_locked($$$) {
+	my ($queue, $machine, $jid) = @_;
+	given ($BEX::Config::locking_scheme) {
+		# Shortcuts
+		when ('host') { return unless defined $machine; }
+		when ('jid') { return unless defined $jid; }
+		when ('none') { return; }
+	}
+	my $lock = lock_name($queue, $machine, $jid);
+	return -f $lock;
+}
+
 42;
-- 
2.39.5