bex prun: Squashed uninitialized var warning

[bex.git] / lib / bin / bex-prun

diff --git a/lib/bin/bex-prun b/lib/bin/bex-prun
index 685c8be0b06d4e065c168fa623e785f2deeb44cf..5c1c93b866f1f858b6775e05b645810987eec493 100755 (executable)
--- 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>] [[!]<machine-or-class> ...]
 
 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=<n>     Set limit on the number of jobs run in parallel
 -q, --queue=<name>     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) {
        }
        $_ = <FIFO>;
        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;
@@ -160,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;
        }
@@ -189,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}++;
@@ -201,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}--;
@@ -228,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'} // "";
@@ -281,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));
@@ -307,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
@@ -351,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;
 }