X-Git-Url: http://mj.ucw.cz/gitweb/?a=blobdiff_plain;f=lib%2Fbin%2Fbex-prun;h=5c1c93b866f1f858b6775e05b645810987eec493;hb=383a0f4cdc5f698041df99ab2bcf87fc5a33d772;hp=63be4798149baf8ba58fa7cfb4c2975c98e93034;hpb=4d99ac785bb07b072c121d8cb0c64cad041c8561;p=bex.git diff --git a/lib/bin/bex-prun b/lib/bin/bex-prun index 63be479..5c1c93b 100755 --- a/lib/bin/bex-prun +++ b/lib/bin/bex-prun @@ -11,6 +11,7 @@ use BEX; my $queue_name; my $text_mode; +my $debug = 0; my $debug_children; sub usage() { @@ -18,7 +19,8 @@ sub usage() { Usage: bex prun [] [[!] ...] Options: - --debug-children Log stdout and stderr to ./debug.log + --debug Log status changes to stderr + --debug-children Log stdout and stderr of child processes to ./debug.log -p, --parallel= Set limit on the number of jobs run in parallel -q, --queue= Run jobs in the given queue --text Use plain-text user interface instead of curses @@ -29,6 +31,7 @@ AMEN GetOptions( "q|queue=s" => \$queue_name, "text!" => \$text_mode, + "debug+" => \$debug, "debug-children!" => \$debug_children, "p|parallel=i" => \$BEX::Config::max_parallel_jobs, "help" => \&usage, @@ -71,7 +74,7 @@ while (keys %running || @machines) { "--queue=" . $queue->{'Name'}, $mach, ); - push @cmd, ">debug.log", "2>&1" if $debug_children; + push @cmd, ">>debug.log", "2>&1" if $debug_children; push @tm, join(" ", @cmd); system @tm; !$? or $ui->update($mach, undef, 'INTERR'); @@ -80,6 +83,7 @@ while (keys %running || @machines) { } $_ = ; chomp; + print STDERR "<< $_\n" if $debug; my ($mach, $jid, $stat) = /^! (\S+) (\S+) (\S+)$/; if (!defined $stat) { $ui->err("Received invalid status message <$_>"); @@ -126,8 +130,8 @@ use Curses; my $C; my $nrows; -my @by_row = (); -my %by_host = (); +my @by_row; +my %by_host; my %host_state; my %host_cnt; @@ -138,6 +142,22 @@ my %job_cnt; my %host_last_fail_job; my %host_last_fail_stat; +my @states; +my %state_to_pri; + +BEGIN { + @by_row = (); + %by_host = (); + @states = qw(unknown ready running done failed); + %state_to_pri = ( + 'unknown' => 0, + 'ready' => 1, + 'done' => 2, + 'failed' => 3, + 'running' => 4, + ); +} + sub new($) { $C = new Curses; start_color; @@ -151,6 +171,7 @@ sub new($) { init_pair(2, COLOR_YELLOW, COLOR_RED); init_pair(3, COLOR_YELLOW, COLOR_BLACK); init_pair(4, COLOR_RED, COLOR_BLACK); + init_pair(5, COLOR_BLUE, COLOR_BLACK); $nrows = $C->getmaxy - 2; if ($BEX::Config::max_parallel_jobs > $nrows) { @@ -159,7 +180,7 @@ sub new($) { %host_state = %host_cnt = (); %job_state = %job_cnt = (); - for my $s ('unknown', 'ready', 'running', 'done', 'failed') { + for my $s (@states) { $host_cnt{$s} = 0; $job_cnt{'*'}{$s} = 0; } @@ -188,11 +209,12 @@ sub err($$) { sub set_host_status($$$) { my ($ui, $mach, $stat) = @_; + print STDERR "H: $mach $stat\n" if $debug; my $prev_stat = $host_state{$mach}; if (defined $prev_stat) { $host_cnt{$prev_stat}--; } else { - for my $s ('unknown', 'ready', 'running', 'done', 'failed') { $job_cnt{$mach}{$s} = 0; } + for my $s (@states) { $job_cnt{$mach}{$s} = 0; } } $host_state{$mach} = $stat; $host_cnt{$stat}++; @@ -200,6 +222,7 @@ sub set_host_status($$$) { sub set_job_status($$$$) { my ($ui, $mach, $jid, $stat) = @_; + print STDERR "J: $mach $jid $stat\n" if $debug; my $prev_stat = $job_state{$mach}{$jid} // 'unknown'; $job_cnt{$mach}{$prev_stat}--; $job_cnt{'*'}{$prev_stat}--; @@ -227,41 +250,60 @@ sub refresh_status($) { sub get_slot($) { my ($mach) = @_; - my $s; - if (defined ($s = $by_host{$mach})) { - delete $s->{'Gone'}; - } else { - my ($best, $besti); - for my $i (0..$nrows-1) { - my $r = $by_row[$i]; - if (!defined $r) { - $besti = $i; - $best = undef; - last; - } elsif ($r->{'Gone'} && (!$best || $best->{'Gone'} > $r->{'Gone'})) { - $besti = $i; - $best = $r; - } + my $s = $by_host{$mach}; + if (!defined $s) { + $s = $by_host{$mach} = { 'Host' => $mach }; + } + return $s; +} + +my $place_counter; + +sub place_slot($) { + my ($s) = @_; + $s->{'LastUpdate'} = $place_counter++; + return $s if defined $s->{'Row'}; + + my $pri = $state_to_pri{$host_state{$s->{'Host'}}}; + my ($best, $besti); + my $bestpri = 99; + for my $i (0..$nrows-1) { + my $r = $by_row[$i]; + if (!defined $r) { + $besti = $i; + $best = undef; + last; + } + my $rpri = $state_to_pri{$host_state{$r->{'Host'}}}; + print STDERR "I: ... considering ", $r->{'Host'}, " (pri $rpri, lu ", $r->{'LastUpdate'}, ")\n" if $debug > 1; + next if $rpri > $pri; + + if ($rpri < $bestpri || + $rpri == $bestpri && $r->{'LastUpdate'} < $best->{'LastUpdate'}) { + # Trick: $best must be defined, as otherwise $bestpri == 99 + $best = $r; + $besti = $i; + $bestpri = $rpri; } + } + + if (defined $besti) { if ($best) { - delete $by_host{$best->{'Host'}}; + print STDERR "I: Replacing ", $best->{'Host'}, " (pri $bestpri)\n"; + delete $best->{'Row'}; } - $s->{'Host'} = $mach; + print STDERR "I: Allocated ", $s->{'Host'}, " \@$besti (pri $pri)\n"; $s->{'Row'} = $besti; - $by_host{$mach} = $s; $by_row[$besti] = $s; + } else { + print STDERR "I: No place for ", $s->{'Host'}, " (pri $pri)\n" if $debug; } - return $s; -} - -my $gone_counter = 1; -sub delete_slot($) { - my ($s) = @_; - $s->{'Gone'} = $gone_counter++; } sub redraw_slot($) { my ($s) = @_; + my $r = $s->{'Row'} // return; + $r++; my $mach = $s->{'Host'}; my $stat = $s->{'Status'} // "?"; my $jid = $s->{'Job'} // ""; @@ -280,7 +322,6 @@ sub redraw_slot($) { $C->bkgdset(0); } } - my $r = $s->{'Row'} + 1; $C->addstr($r, 0, sprintf("%-20.20s", $mach)); if ($jcnt->{'failed'}) { $C->bkgdset(COLOR_PAIR(4)); @@ -293,7 +334,7 @@ sub redraw_slot($) { $C->addstr(sprintf("%3dD %3dW", $jcnt->{'done'}, $jcnt->{'ready'})); if ($stat eq 'DONE') { if (defined $host_last_fail_stat{$mach}) { - $C->bkgdset(COLOR_PAIR(4)); + $C->bkgdset(($host_last_fail_stat{$mach} eq 'NOPING') ? COLOR_PAIR(5) : COLOR_PAIR(4)); $C->addstr(sprintf(" %-8s %s", $host_last_fail_stat{$mach}, $queue->job_name($host_last_fail_job{$mach}))); } } else { @@ -306,7 +347,6 @@ sub redraw_slot($) { sub update($$$$) { my ($ui, $mach, $jid, $stat) = @_; - my $s = get_slot($mach); given ($stat) { when ('READY') { # Pseudo-state generated internally @@ -350,9 +390,10 @@ sub update($$$$) { $ui->err("Received unknown job status $stat"); } } + my $s = get_slot($mach); $s->{'Job'} = $jid; $s->{'Status'} = $stat; + place_slot($s); redraw_slot($s); - if ($stat eq 'DONE') { delete_slot($s); } $ui->refresh_status; }