bq

   1 #!/usr/bin/perl
   2 # Batch EXecutor 2.0 -- Show Queued Jobs
   3 # (c) 2011 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7 use Getopt::Long;
   8 use POSIX;
   9
  10 use lib 'lib';
  11 use BEX;
  12
  13 my $op_by_job;
  14 my $op_by_host;
  15 my $op_rm;
  16 my $op_move_to;
  17
  18 my $queue_name;
  19 my $given_job;
  20
  21 GetOptions(
  22         "by-job!" => \$op_by_job,
  23         "h|by-host!" => \$op_by_host,
  24         "rm!" => \$op_rm,
  25         "move-to=s" => \$op_move_to,
  26         "j|job=s" => \$given_job,
  27         "q|queue=s" => \$queue_name,
  28 ) or die <<AMEN ;
  29 Usage: bq [<options and actions>] [[!]<machine-or-class> ...]
  30
  31 Actions:
  32     --by-job            Show jobs sorted by job ID (default)
  33 -h, --by-host           Show jobs sorted by host
  34     --rm                Remove jobs from the queue
  35     --move-to=<queue>   Move jobs to a different queue
  36
  37 Options:
  38 -j, --job=<id>          Act on the specified job (default: on all)
  39 -q, --queue=<name>      Act on the given queue
  40 AMEN
  41
  42 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
  43 my $queue = BEX::Queue->new($queue_name);
  44
  45 # Select jobs
  46 my %jobs = ();
  47 my %machs = ();
  48 for my $m (@machines) {
  49         for my $j ($queue->scan($m)) {
  50                 if (defined $given_job) {
  51                         next if $j ne $given_job;
  52                 }
  53                 push @{$jobs{$j}}, $m;
  54                 push @{$machs{$m}}, $j;
  55         }
  56 }
  57
  58 sub do_ls();
  59 sub do_rm();
  60 sub do_move_to();
  61
  62 my $ops = 0 + defined($op_by_host) + defined($op_by_job) + defined($op_rm) + defined($op_move_to);
  63 if ($ops > 1) { die "Multiple actions are not allowed\n"; }
  64
  65 if ($op_rm) { do_rm(); }
  66 elsif (defined $op_move_to) { do_move_to(); }
  67 else { do_ls(); }
  68 exit 0;
  69
  70 sub do_ls()
  71 {
  72         my %stat = ();
  73         my %mach_locked = ();
  74         for my $m (keys %machs) {
  75                 $mach_locked{$m} = $queue->is_locked($m, undef);
  76                 for my $j (@{$machs{$m}}) {
  77                         my $st = $queue->read_job_status($m, $j);
  78                         if (defined($st->{'Time'}) && defined($st->{'Status'})) {
  79                                 $stat{$m}{$j} = ' [' . $st->{'Status'} . ' on ' .
  80                                                 POSIX::strftime('%Y-%m-%d', localtime $st->{'Time'}) . ']';
  81                         } else {
  82                                 $stat{$m}{$j} = '';
  83                         }
  84                         if ($mach_locked{$m} || $queue->is_locked($m, $j)) {
  85                                 $stat{$m}{$j} .= ' [LOCKED]';
  86                         }
  87                 }
  88         }
  89
  90         if ($queue->is_locked(undef, undef)) {
  91                 print "### Queue lock present\n\n";
  92         }
  93
  94         if ($op_by_host) {
  95                 for my $m (sort keys %machs) {
  96                         print "$m", ($mach_locked{$m} ? ' [LOCKED]' : ''), "\n";
  97                         for my $j (@{$machs{$m}}) {
  98                                 print "\t" . $queue->job_name($j) . $stat{$m}{$j}, "\n";
  99                         }
 100                 }
 101         } else {
 102                 for my $j (sort keys %jobs) {
 103                         print $queue->job_name($j), "\n";
 104                         for my $m (sort @{$jobs{$j}}) {
 105                                 print "\t$m", $stat{$m}{$j}, "\n";
 106                         }
 107                 }
 108         }
 109 }
 110
 111 sub do_rm()
 112 {
 113         my $err = 0;
 114         for my $m (sort keys %machs) {
 115                 for my $j (sort @{$machs{$m}}) {
 116                         if (!$queue->lock($m, $j)) {
 117                                 print STDERR "Cannot remove $m:", $queue->job_name($j), ", it is locked\n";
 118                                 $err = 1;
 119                         } else {
 120                                 $queue->update_job_status($m, $j, 'REMOVED');
 121                                 $queue->remove($m, $j);
 122                                 print "Removed $m:", $queue->job_name($j), "\n";
 123                         }
 124                 }
 125         }
 126         $queue->unlock;
 127         exit $err;
 128 }
 129
 130 sub do_move_to()
 131 {
 132         my $err = 0;
 133         my $dest = BEX::Queue->new($op_move_to);
 134         $dest->{'Name'} ne $queue->{'Name'} or die "Moving to the same queue is not permitted\n";
 135         for my $j (sort keys %jobs) {
 136                 my $job = BEX::Job->new_from_file($queue->job_file($j));
 137                 for my $m (sort @{$jobs{$j}}) {
 138                         if (!$queue->lock($m, $j)) {
 139                                 print STDERR "Cannot move $m:", $queue->job_name($j), ", it is locked\n";
 140                                 $err = 1;
 141                         } else {
 142                                 my $enq = $dest->enqueue($m, $job);
 143                                 if ($enq) {
 144                                         $dest->update_job_status($m, $job->id, 'NEW', 'Moved to this queue');
 145                                 } else {
 146                                         $dest->log($m, $job->id, 'REQUEUE', 'Moved to this queue');
 147                                 }
 148                                 $queue->update_job_status($m, $job->id, 'REMOVED', 'Moved from this queue');
 149                                 $queue->remove($m, $j);
 150                                 print "Moved $m:", $dest->job_name($j);
 151                                 print " (already queued)" if !$enq;
 152                                 print "\n";
 153                         }
 154                 }
 155         }
 156         $queue->unlock;
 157         exit $err;
 158 }