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 162fc8a2946473180fc984eefdd8dec79d5c99cc..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 <$_>");
@@ -205,6 +209,7 @@ 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}--;
@@ -217,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}--;
@@ -260,7 +266,7 @@ sub place_slot($) {
 
        my $pri = $state_to_pri{$host_state{$s->{'Host'}}};
        my ($best, $besti);
-       my $bestpri = -1;
+       my $bestpri = 99;
        for my $i (0..$nrows-1) {
                my $r = $by_row[$i];
                if (!defined $r) {
@@ -269,23 +275,29 @@ sub place_slot($) {
                        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 == -1
+                       # Trick: $best must be defined, as otherwise $bestpri == 99
                        $best = $r;
                        $besti = $i;
                        $bestpri = $rpri;
                }
        }
 
-       if ($best) {
-               delete $best->{'Row'};
+       if (defined $besti) {
+               if ($best) {
+                       print STDERR "I: Replacing ", $best->{'Host'}, " (pri $bestpri)\n";
+                       delete $best->{'Row'};
+               }
+               print STDERR "I: Allocated ", $s->{'Host'}, " \@$besti (pri $pri)\n";
+               $s->{'Row'} = $besti;
+               $by_row[$besti] = $s;
+       } else {
+               print STDERR "I: No place for ", $s->{'Host'}, " (pri $pri)\n" if $debug;
        }
-       $s->{'Row'} = $besti;
-       $by_row[$besti] = $s;
-       return $s;
 }
 
 sub redraw_slot($) {