lib/bin/ls

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