X-Git-Url: http://mj.ucw.cz/gitweb/?a=blobdiff_plain;f=lib%2Fbin%2Fbex-prun;h=5c1c93b866f1f858b6775e05b645810987eec493;hb=383a0f4cdc5f698041df99ab2bcf87fc5a33d772;hp=162fc8a2946473180fc984eefdd8dec79d5c99cc;hpb=8a590a8d71ee7581277ec89e391168169f5a0d3b;p=bex.git

diff --git a/lib/bin/bex-prun b/lib/bin/bex-prun
index 162fc8a..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>] [[!]<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($) {