lib/bin/bex-queue

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