2 # Batch EXecutor 3.0 -- Parallel Execution Using Screen
3 # (c) 2011-2012 Martin Mares <mj@ucw.cz>
13 my $screen_session = 'BEX';
17 "q|queue=s" => \$queue_name,
18 "session=s" => \$screen_session,
19 "text!" => \$text_mode,
21 Usage: bex prun [<options>] [[!]<machine-or-class> ...]
24 -q, --queue=<name> Run jobs in the given queue
25 --session=<name> Job windows should be opened within the given screen
26 session (default: BEX)
27 --text Use textual user interface instead of curses
30 system 'screen', '-S', $screen_session, '-X', 'select', '.';
31 !$? or die "Screen session $screen_session not found\n";
33 my $queue = BEX::Queue->new($queue_name);
34 my $fifo_name = $queue->{'Name'} . '/status-fifo';
36 mkfifo $fifo_name, 0700 or die "Cannot create $fifo_name: $!";
37 open FIFO, '+<', $fifo_name or die "Cannot open $fifo_name: $!";
39 my $ui = ($text_mode ? BEX::bprun::text->new : BEX::bprun::curses->new);
42 for my $mach (BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*')) {
43 my @jobs = $queue->scan($mach);
45 push @machines, $mach;
46 for (@jobs) { $ui->update($mach, $_, 'READY'); }
50 my $max = $BEX::Config::max_parallel_jobs;
52 while (keys %running || @machines) {
53 if (@machines && keys %running < $max) {
54 my $mach = shift @machines;
55 $ui->update($mach, undef, 'START');
56 my @scr = ('screen', '-t', $mach);
57 push @scr, '-S', $screen_session if defined $screen_session;
58 push @scr, '-X', 'screen', './brun', "--status-fifo=$fifo_name", $mach;
60 !$? or $ui->update($mach, undef, 'INTERR');
61 $running{$mach} = 'START';
66 my ($mach, $jid, $stat) = /^! (\S+) (\S+) (\S+)$/;
68 $ui->err("Received invalid status message <$_>");
71 if (!defined $running{$mach}) {
72 $ui->err("Received status message <$_> for a machine which does not run");
75 $running{$mach} = $stat;
76 $ui->update($mach, ($jid eq '-' ? undef : $jid), $stat);
77 if ($stat eq 'DONE') {
78 delete $running{$mach};
86 package BEX::bprun::text;
96 my ($ui, $mach, $jid, $stat) = @_;
97 print +($mach // '-'), (defined($jid) ? ":$jid" : ""), " $stat\n";
102 print STDERR "ERROR: $msg\n";
105 package BEX::bprun::curses;
121 my %host_last_fail_job;
122 my %host_last_fail_stat;
127 has_colors && COLORS >= 8 && COLOR_PAIRS >= 8 or die "Your terminal is too dumb for me\n";
133 init_pair(1, COLOR_YELLOW, COLOR_BLUE);
134 init_pair(2, COLOR_YELLOW, COLOR_RED);
135 init_pair(3, COLOR_YELLOW, COLOR_BLACK);
136 init_pair(4, COLOR_RED, COLOR_BLACK);
138 $nrows = $C->getmaxy - 2;
139 if ($BEX::Config::max_parallel_jobs > $nrows) {
140 $BEX::Config::max_parallel_jobs = $nrows;
143 %host_state = %host_cnt = ();
144 %job_state = %job_cnt = ();
145 for my $s ('unknown', 'ready', 'running', 'done', 'failed') {
147 $job_cnt{'*'}{$s} = 0;
157 $C->bkgdset(COLOR_PAIR(1) | A_BOLD);
158 $C->addstr($C->getmaxy-1, 0, "Press any key to quit...");
166 $C->bkgdset(COLOR_PAIR(2) | A_BOLD);
167 $C->addnstr($C->getmaxy-1, 0, "ERROR: $msg", $C->getmaxx);
172 sub set_host_status($$$) {
173 my ($ui, $mach, $stat) = @_;
174 my $prev_stat = $host_state{$mach};
175 if (defined $prev_stat) {
176 $host_cnt{$prev_stat}--;
178 for my $s ('unknown', 'ready', 'running', 'done', 'failed') { $job_cnt{$mach}{$s} = 0; }
180 $host_state{$mach} = $stat;
184 sub set_job_status($$$$) {
185 my ($ui, $mach, $jid, $stat) = @_;
186 my $prev_stat = $job_state{$mach}{$jid} // 'unknown';
187 $job_cnt{$mach}{$prev_stat}--;
188 $job_cnt{'*'}{$prev_stat}--;
189 $job_state{$mach}{$jid} = $stat;
190 $job_cnt{$mach}{$stat}++;
191 $job_cnt{'*'}{$stat}++;
194 sub refresh_status($) {
195 $C->bkgdset(COLOR_PAIR(1) | A_BOLD);
197 sprintf("BEX Hosts: %dR %dD %dE %dW Jobs: %dR %dD %dE %dW",
198 $host_cnt{'running'},
202 $job_cnt{'*'}{'running'},
203 $job_cnt{'*'}{'done'},
204 $job_cnt{'*'}{'failed'},
205 $job_cnt{'*'}{'ready'},
214 if (defined ($s = $by_host{$mach})) {
218 for my $i (0..$nrows-1) {
224 } elsif ($r->{'Gone'} && (!$best || $best->{'Gone'} > $r->{'Gone'})) {
230 delete $by_host{$best->{'Host'}};
232 $s->{'Host'} = $mach;
233 $s->{'Row'} = $besti;
234 $by_host{$mach} = $s;
235 $by_row[$besti] = $s;
240 my $gone_counter = 1;
243 $s->{'Gone'} = $gone_counter++;
248 my $mach = $s->{'Host'};
249 my $stat = $s->{'Status'} // "?";
250 my $jid = $s->{'Job'} // "";
251 my $jname = ($jid eq "" ? "" : $queue->job_name($jid));
252 my $jcnt = $job_cnt{$mach};
253 if ($jcnt->{'running'}) {
254 if ($jcnt->{'failed'}) {
255 $C->bkgdset(COLOR_PAIR(4) | A_BOLD);
257 $C->bkgdset(COLOR_PAIR(3) | A_BOLD);
260 if ($jcnt->{'failed'}) {
261 $C->bkgdset(COLOR_PAIR(4));
266 my $r = $s->{'Row'} + 1;
267 $C->addstr($r, 0, sprintf("%-20.20s", $mach));
268 if ($jcnt->{'failed'}) {
269 $C->bkgdset(COLOR_PAIR(4));
270 $C->addstr(sprintf("%3dE ", $jcnt->{'failed'}));
276 $C->addstr(sprintf("%3dD %3dW", $jcnt->{'done'}, $jcnt->{'ready'}));
277 if ($stat eq 'DONE') {
278 if (defined $host_last_fail_stat{$mach}) {
279 $C->bkgdset(COLOR_PAIR(4));
280 $C->addstr(sprintf(" %-8s %s", $host_last_fail_stat{$mach}, $queue->job_name($host_last_fail_job{$mach})));
283 my $text = sprintf(" %-8s %s", $stat, $jname);
291 my ($ui, $mach, $jid, $stat) = @_;
292 my $s = get_slot($mach);
295 # Pseudo-state generated internally
296 $ui->set_host_status($mach, 'ready');
297 $ui->set_job_status($mach, $jid, 'ready');
300 $ui->set_job_status($mach, $jid, 'done');
302 when (['FAILED', 'INTERR', 'NOPING', 'PREPFAIL']) {
303 $ui->set_job_status($mach, $jid, 'failed');
304 $host_last_fail_job{$mach} = $jid;
305 $host_last_fail_stat{$mach} = $stat;
308 if ($job_cnt{$mach}{'failed'}) {
309 $ui->set_host_status($mach, 'failed');
311 $ui->set_host_status($mach, 'done');
315 $ui->set_host_status($mach, 'running');
316 $ui->set_job_status($mach, $jid, 'running') if defined $jid;
320 $ui->set_job_status($mach, $jid, 'failed');
322 for my $j (keys %{$job_state{$mach}}) {
323 $ui->set_job_status($mach, $jid, 'failed');
325 $ui->set_host_status($mach, 'failed');
326 $host_last_fail_job{$mach} = $jid;
327 $host_last_fail_stat{$mach} = $stat;
330 when (['START', 'PING', 'SEND', 'RUN']) {
333 $ui->err("Received unknown job status $stat");
337 $s->{'Status'} = $stat;
339 if ($stat eq 'DONE') { delete_slot($s); }