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