Implemented `bq --rm' and `bq --move-to'

diff --git a/NOTES b/NOTES
index 9f3dc17de0e975b8750cad95af1685c8884c53f1..ee84961285689704ea2b066a2d975891c962e6be 100644 (file)
--- a/NOTES
+++ b/NOTES
@@ -56,6 +56,7 @@ OK            Job finished successfully (this is usually not seen in the queue, since
 FAILED         Job failed to execute (i.e., it returned a non-zero exit code)
 INTERR         Internal error of BEX (e.g., failed to read job prolog file)
 PREPFAIL       Preparatory commands failed (i.e., those present in Prep header field)
 FAILED         Job failed to execute (i.e., it returned a non-zero exit code)
 INTERR         Internal error of BEX (e.g., failed to read job prolog file)
 PREPFAIL       Preparatory commands failed (i.e., those present in Prep header field)

+REMOVED                Job removed from the queue (behavior similar to OK)

 
 These are present only in log files and messages sent over status FIFO:
 
 
 These are present only in log files and messages sent over status FIFO:
 

diff --git a/TODO b/TODO
index e6fca02d2e93777661a3479c72b2cadfdb49e3f8..ea1dfba6b4b3f1ef1e6e1c35e728190bfd6a825c 100644 (file)
--- a/TODO
+++ b/TODO
@@ -3,3 +3,4 @@
 - bprun --curses
 - Terminology: machine vs. host
 - Detector of orphans (unused queue dirs, jobs on non-existent machines, non-queued jobs)
 - bprun --curses
 - Terminology: machine vs. host
 - Detector of orphans (unused queue dirs, jobs on non-existent machines, non-queued jobs)

+- use job->name

diff --git a/bq b/bq
index 9be29ab965c21fa7c9516d5a8a97d9f58d8b6fd7..478b68384218a52232fcc84b9e9cea4bbc71d511 100755 (executable)
--- a/bq
+++ b/bq
@@ -10,77 +10,147 @@ use POSIX;
 use lib 'lib';
 use BEX;
 
 use lib 'lib';
 use BEX;
 

-my $by_host;
+my $op_by_job;
+my $op_by_host;
+my $op_rm;
+my $op_move_to;
+

 my $queue_name;
 my $given_job;
 
 GetOptions(
 my $queue_name;
 my $given_job;
 
 GetOptions(

-       "h|by-host!" => \$by_host,
+       "by-job!" => \$op_by_job,
+       "h|by-host!" => \$op_by_host,
+       "rm!" => \$op_rm,
+       "move-to=s" => \$op_move_to,

        "j|job=s" => \$given_job,
        "q|queue=s" => \$queue_name,
 ) or die <<AMEN ;
        "j|job=s" => \$given_job,
        "q|queue=s" => \$queue_name,
 ) or die <<AMEN ;

-Usage: bq [<options>] [[!]<machine-or-class> ...]
+Usage: bq [<options and actions>] [[!]<machine-or-class> ...]
+
+Actions:
+    --by-job           Show jobs sorted by job ID (default)
+-h, --by-host          Show jobs sorted by host
+    --rm               Remove jobs from the queue
+    --move-to=<queue>  Move jobs to a different queue

 
 Options:
 
 Options:

--h, --by-host          Show jobs sorted by host (default: by job)
--j, --job=<id>         Show only instances of the specified job
--q, --queue=<name>     Show jobs in the given queue
+-j, --job=<id>         Act on the specified job (default: on all)
+-q, --queue=<name>     Act on the given queue

 AMEN
 
 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
 my $queue = BEX::Queue->new($queue_name);
 
 AMEN
 
 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
 my $queue = BEX::Queue->new($queue_name);
 

+# Select jobs

 my %jobs = ();
 my %machs = ();
 my %jobs = ();
 my %machs = ();

-my %subj = ();
-my %stat = ();
-my %mach_locked = ();

 for my $m (@machines) {
 for my $m (@machines) {

-       $mach_locked{$m} = $queue->is_locked($m, undef);

        for my $j ($queue->scan($m)) {
                if (defined $given_job) {
                        next if $j ne $given_job;
                }
                push @{$jobs{$j}}, $m;
                push @{$machs{$m}}, $j;
        for my $j ($queue->scan($m)) {
                if (defined $given_job) {
                        next if $j ne $given_job;
                }
                push @{$jobs{$j}}, $m;
                push @{$machs{$m}}, $j;

-               my $job = $queue->job_metadata($j);
-               $subj{$j} = ' (' . $job->{'Subject'} . ')';
-

        }
 }
 
        }
 }
 

-# Read status of each job
-for my $m (keys %machs) {
-       for my $j (@{$machs{$m}}) {
-               my $st = $queue->read_job_status($m, $j);
-               if (defined($st->{'Time'}) && defined($st->{'Status'})) {
-                       $stat{$m}{$j} = ' [' . $st->{'Status'} . ' on ' .
-                                       POSIX::strftime('%Y-%m-%d', localtime $st->{'Time'}) . ']';
-               } else {
-                       $stat{$m}{$j} = '';
-               }
-               if ($mach_locked{$m} || $queue->is_locked($m, $j)) {
-                       $stat{$m}{$j} .= ' [LOCKED]';
+sub do_ls();
+sub do_rm();
+sub do_move_to();
+
+my $ops = 0 + defined($op_by_host) + defined($op_by_job) + defined($op_rm) + defined($op_move_to);
+if ($ops > 1) { die "Multiple actions are not allowed\n"; }
+
+if ($op_rm) { do_rm(); }
+elsif (defined $op_move_to) { do_move_to(); }
+else { do_ls(); }
+exit 0;
+
+sub do_ls()
+{
+       my %stat = ();
+       my %mach_locked = ();
+       for my $m (keys %machs) {
+               $mach_locked{$m} = $queue->is_locked($m, undef);
+               for my $j (@{$machs{$m}}) {
+                       my $st = $queue->read_job_status($m, $j);
+                       if (defined($st->{'Time'}) && defined($st->{'Status'})) {
+                               $stat{$m}{$j} = ' [' . $st->{'Status'} . ' on ' .
+                                               POSIX::strftime('%Y-%m-%d', localtime $st->{'Time'}) . ']';
+                       } else {
+                               $stat{$m}{$j} = '';
+                       }
+                       if ($mach_locked{$m} || $queue->is_locked($m, $j)) {
+                               $stat{$m}{$j} .= ' [LOCKED]';
+                       }

                }
        }
                }
        }

-}

 
 

-if ($queue->is_locked(undef, undef)) {
-       print "### Queue lock present\n\n";
+       if ($queue->is_locked(undef, undef)) {
+               print "### Queue lock present\n\n";
+       }
+
+       if ($op_by_host) {
+               for my $m (sort keys %machs) {
+                       print "$m", ($mach_locked{$m} ? ' [LOCKED]' : ''), "\n";
+                       for my $j (@{$machs{$m}}) {
+                               print "\t" . $queue->job_name($j) . $stat{$m}{$j}, "\n";
+                       }
+               }
+       } else {
+               for my $j (sort keys %jobs) {
+                       print $queue->job_name($j), "\n";
+                       for my $m (sort @{$jobs{$j}}) {
+                               print "\t$m", $stat{$m}{$j}, "\n";
+                       }
+               }
+       }

 }
 
 }
 

-if ($by_host) {
+sub do_rm()
+{
+       my $err = 0;

        for my $m (sort keys %machs) {
        for my $m (sort keys %machs) {

-               print "$m", ($mach_locked{$m} ? ' [LOCKED]' : ''), "\n";
-               for my $j (@{$machs{$m}}) {
-                       print "\t$j", $subj{$j}, $stat{$m}{$j}, "\n";
+               for my $j (sort @{$machs{$m}}) {
+                       if (!$queue->lock($m, $j)) {
+                               print STDERR "Cannot remove $m:", $queue->job_name($j), ", it is locked\n";
+                               $err = 1;
+                       } else {
+                               $queue->log($m, $j, 'REMOVED');
+                               $queue->write_job_status($m, $j, { 'Time' => time, 'Status' => 'REMOVED' });
+                               $queue->remove($m, $j);
+                               print "Removed $m:", $queue->job_name($j), "\n";
+                       }

                }
        }
                }
        }

-} else {
+       $queue->unlock;
+       exit $err;
+}
+
+sub do_move_to()
+{
+       my $err = 0;
+       my $dest = BEX::Queue->new($op_move_to);
+       $dest->{'Name'} ne $queue->{'Name'} or die "Moving to the same queue is not permitted\n";

        for my $j (sort keys %jobs) {
        for my $j (sort keys %jobs) {

-               print $j, $subj{$j}, "\n";
+               my $job = BEX::Job->new_from_file($queue->job_file($j));

                for my $m (sort @{$jobs{$j}}) {
                for my $m (sort @{$jobs{$j}}) {

-                       print "\t$m", $stat{$m}{$j}, "\n";
+                       if (!$queue->lock($m, $j)) {
+                               print STDERR "Cannot move $m:", $queue->job_name($j), ", it is locked\n";
+                               $err = 1;
+                       } else {
+                               my $enq = $dest->enqueue($m, $job);
+                               $dest->write_job_status($m, $job->id, { 'Time' => time, 'Status' => 'NEW', 'Message' => 'Moved to this queue' });
+                               $queue->log($m, $j, 'REMOVED', "Moved to another queue");
+                               $queue->write_job_status($m, $j, { 'Time' => time, 'Status' => 'REMOVED', 'Message' => 'Moved to another queue' });
+                               $queue->remove($m, $j);
+                               print "Moved $m:", $queue->job_name($j);
+                               print " (already queued)" if !$enq;
+                               print "\n";
+                       }

                }
        }
                }
        }

+       $queue->unlock;
+       exit $err;

 }
 }

diff --git a/lib/BEX/Job.pm b/lib/BEX/Job.pm
index b0add1b3fe1f37bc1789af28f5e8d74f6a7a563e..d040f1a08652307675a2ce1395a75c1338d91e85 100644 (file)
--- a/lib/BEX/Job.pm
+++ b/lib/BEX/Job.pm
@@ -56,6 +56,14 @@ sub id($) {
        return $_[0]->{'ID'};
 }
 
        return $_[0]->{'ID'};
 }
 

+sub name($) {
+       my ($job) = @_;
+       my $name = $job->{'ID'};
+       my $subj = $job->{'Subject'} // "";
+       $name .= " ($subj)" if $subj !~ /^\s*$/;
+       return $name;
+}
+

 sub attr($$;$) {
        my ($job, $attr, $val) = @_;
        $job->{$attr} = $val if defined $val;
 sub attr($$;$) {
        my ($job, $attr, $val) = @_;
        $job->{$attr} = $val if defined $val;

diff --git a/lib/BEX/Queue.pm b/lib/BEX/Queue.pm
index 355f6491b03a67516087031522f14db735790582..b8fb6f166d391a1ec1539ead112fe993fc9b144e 100644 (file)
--- a/lib/BEX/Queue.pm
+++ b/lib/BEX/Queue.pm
@@ -103,9 +103,9 @@ sub scan($$) {
        return sort @list;
 }
 
        return sort @list;
 }
 

-sub remove($$) {
-       my ($queue, $machine, $jid) = @_;
-       if ($BEX::Config::keep_history) {
+sub remove($$;$) {
+       my ($queue, $machine, $jid, $force_remove) = @_;
+       if ($BEX::Config::keep_history && !$force_remove) {

                my $s = $queue->{'Name'} . '/hosts/' . $machine;
                my $d = $queue->{'Name'} . '/history/' . $machine;
                File::Path::mkpath($d);
                my $s = $queue->{'Name'} . '/hosts/' . $machine;
                my $d = $queue->{'Name'} . '/history/' . $machine;
                File::Path::mkpath($d);


@@ -133,6 +133,11 @@ sub job_metadata($$) {
        return $cache->{$jid};
 }
 
        return $cache->{$jid};
 }
 

+sub job_name($$) {
+       my ($queue, $jid) = @_;
+       return $queue->job_metadata($jid)->name;
+}
+

 sub read_job_status($$$) {
        my ($queue, $machine, $jid) = @_;
        my %s = ();
 sub read_job_status($$$) {
        my ($queue, $machine, $jid) = @_;
        my %s = ();