#!/usr/bin/perl
# Batch EXecutor 2.0 -- Parallel Execution Using Screen
# (c) 2011 Martin Mares <mj@ucw.cz>

use strict;
use warnings;
use Getopt::Long;
use POSIX;

use lib 'lib';
use BEX;

my $queue_name;
my $text_mode;

GetOptions(
	"q|queue=s" => \$queue_name,
	"text!" => \$text_mode,
) or die <<AMEN ;
Usage: bprun [<options>] [[!]<machine-or-class> ...]

Options:
-q, --queue=<name>	Run jobs in the given queue
    --text		Use textual user interface instead of curses
AMEN

$ENV{'STY'} or die "Please run me under Screen\n";
my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
my $queue = BEX::Queue->new($queue_name);

my $fifo_name = $queue->{'Name'} . '/status-fifo';
unlink $fifo_name;
mkfifo $fifo_name, 0700 or die "Cannot create $fifo_name: $!";
open FIFO, '+<', $fifo_name or die "Cannot open $fifo_name: $!";

my $ui = ($text_mode ? BEX::bprun::text->new : BEX::bprun::curses->new);

my %running = ();
my $max = $BEX::Config::max_parallel_jobs;

while (keys %running || @machines) {
	if (@machines && keys %running < $max) {
		my $mach = shift @machines;
		my @jobs = $queue->scan($mach);
		@jobs or next;
		$ui->update($mach, undef, 'START');
		system 'screen', '-t', $mach, './brun', "--status-fifo=$fifo_name", $mach;
		!$? or $ui->update($mach, undef, 'INTERR');
		$running{$mach} = 'START';
		next;
	}
	$_ = <FIFO>;
	chomp;
	my ($mach, $jid, $stat) = /^! (\S+) (\S+) (\S+)$/;
	if (!defined $stat) {
		$ui->err("Received invalid status message <$_>");
		next;
	}
	if (!defined $running{$mach}) {
		$ui->err("Received status message <$_> for a machine which does not run");
		next;
	}
	$running{$mach} = $stat;
	$ui->update($mach, ($jid eq '-' ? undef : $jid), $stat);
	if ($stat eq 'DONE') {
		delete $running{$mach};
	}
}

close FIFO;
unlink $fifo_name;
$ui->done;

package BEX::bprun::text;

sub new($) {
	return bless {};
}

sub done($) {
}

sub update($$$$) {
	my ($ui, $mach, $jid, $stat) = @_;
	print +($mach // '-'), (defined($jid) ? ":$jid" : ""), " $stat\n";
}

sub err($$) {
	my ($ui, $msg) = @_;
	print STDERR "ERROR: $msg\n";
}

package BEX::bprun::curses;

use Curses;

my $C;

my $nrows;
my @by_row = ();
my %by_host = ();

sub new($) {
	$C = new Curses;
	start_color;
	has_colors && COLORS >= 8 && COLOR_PAIRS >= 8 or die "Your terminal is too dumb for me\n";
	cbreak; noecho;
	$C->intrflush(0);
	$C->keypad(1);
	$C->meta(1);
	$C->clear;
	$nrows = $C->getmaxy - 2;
	if ($BEX::Config::max_parallel_jobs > $nrows) {
		$BEX::Config::max_parallel_jobs = $nrows;
	}
	return bless {};
}

sub done($)
{
	endwin;
}

sub get_slot($) {
	my ($mach) = @_;
	if (defined $by_host{$mach}) {
		return $by_host{$mach};
	}
	my $s = {
		'Host' => $mach,
	};
	my $i = 0;
	while (defined $by_row[$i]) { $i++; }
	$s->{'Row'} = $i;
	$by_row[$i] = $s;
	$by_host{$mach} = $s;
	return $s;
}

sub delete_slot($) {
	my ($s) = @_;
	delete $by_host{$s->{'Host'}};
	$by_row[$s->{'Row'}] = undef;
}

sub redraw_slot($) {
	my ($s) = @_;
	my $mach = $s->{'Host'};
	my $stat = $s->{'Status'} // "?";
	my $jid = $s->{'Job'} // "";
	my $text = sprintf("%-20s %-10s %s", $mach, $stat, $jid);
	$C->addnstr($s->{'Row'}, 0, $text, $C->getmaxx);
	$C->clrtoeol;
	$C->refresh;
}

sub update($$$$) {
	my ($ui, $mach, $jid, $stat) = @_;
	my $s = get_slot($mach);
	$s->{'Job'} = $jid;
	$s->{'Status'} = $stat;
	redraw_slot($s);
	if ($stat eq 'DONE') { delete_slot($s); }
}