Let bq display (an approximation of) active locks

diff --git a/bq b/bq
index 55ef17728984fe8ffdc67199ca8f04731df44a04..e35528a0a9a380dc5df20c86b6e1139f9389f06f 100755 (executable)
--- 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 473549751aa52db4306be334cb55a7dec1b381bd..0e4cfd9bb9599c3ea5300a45d22a3f51f81c9ac1 100644 (file)
--- 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;