# Batch EXecutor 2.0
# (c) 2011 Martin Mares <mj@ucw.cz>

use strict;
use warnings;

use BEX::Config;

package BEX;

use IO::File;

use POSIX;

my $log_file;

sub log($) {
	$log_file //= new IO::File '>>log' or die "Cannot open log: $!";
	print $log_file POSIX::strftime("%Y-%m-%d %H:%M:%S ", localtime), $_[0], "\n";
}

package BEX::Job;

use POSIX;

our $job_cnt = 0;

sub new($;$) {
	my ($class, $id) = @_;
	my $job = { };
	bless $job;
	if (defined $id) {
		$job->{'ID'} = $id;
	} else {
		$job_cnt++;
		$job->{'ID'} = POSIX::strftime("%Y%m%d-%H%M%S-$$-$job_cnt", localtime);
	}
	$job->{'Subject'} = '(no subject)';
	return $job;
}

sub new_from_file($$;$) {
	my ($class, $file, $header_only) = @_;
	my $job = { };
	open T, '<', $file or die "Cannot open $file: $!";
	while (<T>) {
		chomp;
		/^$/ and last;
		/^([A-Z][A-Za-z0-9-]*):\s*(.*)/ or die "Cannot load $file: Header syntax error";
		!defined $job->{$1} or die "Cannot load $file: Header $1 re-defined";
		$job->{$1} = $2;
	}
	if (!$header_only) {
		my @cmds = <T>;
		$job->{'body'} = join("", @cmds);
	}
	close T;
	$job->{'Subject'} //= '?';
	$job->{'ID'} or die "Cannot load $file: Missing ID";
	return bless $job;
}

sub attr($$;$) {
	my ($job, $attr, $val) = @_;
	$job->{$attr} = $val if defined $val;
	return $job->{$attr};
}

sub dump($) {
	my ($job) = @_;
	for my $k (sort keys %$job) {
		print "$k: ", $job->{$k}, "\n";
	}
}

sub save($;$) {
	my ($job, $fn) = @_;
	-d "tmp" or mkdir "tmp" or die "Cannot create directory tmp: $!";
	$fn //= 'tmp/t-' . $job->{'ID'};
	open T, '>', $fn or die "Cannot create $fn: $!";
	for my $k (sort grep { /^[A-Z]/ } keys %$job) {
		print T "$k: ", $job->{$k}, "\n";
	}
	print T "\n";
	print T $job->{'body'} if defined $job->{'body'};
	close T;
	return $fn;
}

package BEX::Queue;

sub new($;$) {
	my ($class, $name) = @_;
	$name //= 'queue';
	-d $name or die "Queue directory $name does not exist\n";
	for my $d ("hosts", "jobs") {
		-d "$name/$d" or mkdir "$name/$d" or die "Cannot create directory $name/$d: $!";
	}
	my $queue = {
		'Name' => $name,
		'MetaCache' => {},
	};
	return bless $queue;
}

sub host_dir($$) {
	my ($queue, $machine) = @_;
	return $queue->{'Name'} . '/hosts/' . $machine;
}

sub queue_file($$) {
	my ($queue, $machine, $jid) = @_;
	return $queue->host_dir($machine) . '/q-' . $jid;
}

sub status_file($$) {
	my ($queue, $machine, $jid) = @_;
	return $queue->host_dir($machine) . '/s-' . $jid;
}

sub temp_file($$) {
	my ($queue, $machine, $jid) = @_;
	return $queue->host_dir($machine) . '/t-' . $jid;
}

sub job_file($$) {
	my ($queue, $jid) = @_;
	return $queue->{'Name'} . '/jobs/j-' . $jid;
}

sub enqueue($$$) {
	my ($queue, $machine, $job) = @_;
	my $qf = $queue->queue_file($machine, $job->{'ID'});
	if (-f $qf) { return 0; }
	my $fn = $queue->job_file($job->{'ID'});
	-f $fn or $job->save($fn);
	my $dir = $queue->host_dir($machine);
	-d $dir or mkdir $dir or die "Cannot create directory $dir: $!";
	symlink "../../jobs/j-" . $job->{'ID'}, $qf or die "Cannot create $qf: $!";
	return 1;
}

sub scan($$) {
	my ($queue, $machine) = @_;
	my @list = ();
	if (opendir D, $queue->host_dir($machine)) {
		while ($_ = readdir D) {
			s/^q-// or next;
			push @list, $_;
		}
		closedir D;
	}
	return @list;
}

sub remove($$) {
	my ($queue, $machine, $jid) = @_;
	unlink $queue->queue_file($machine, $jid);
	unlink $queue->status_file($machine, $jid);
	unlink $queue->temp_file($machine, $jid);
}

sub job_metadata($$) {
	my ($queue, $jid) = @_;
	my $cache = $queue->{'MetaCache'};
	if (!defined $cache->{$jid}) {
		$cache->{$jid} = BEX::Job->new_from_file($queue->job_file($jid), 1);
	}
	return $cache->{$jid};
}

sub read_job_status($$$) {
	my ($queue, $machine, $jid) = @_;
	my %s = ();
	my $sf = $queue->status_file($machine, $jid);
	if (open S, '<', $sf) {
		while (<S>) {
			chomp;
			/^(\w+):\s*(.*)/ or die "Parse error in $sf";
			$s{$1} = $2;
		}
		close S;
	}
	return \%s;
}

sub write_job_status($$$$) {
	my ($queue, $machine, $jid, $stat) = @_;
	my $sf = $queue->status_file($machine, $jid);
	open S, '>', $sf or die "Cannot create $sf: $!";
	for my $k (sort keys %$stat) {
		print S "$k: ", $stat->{$k}, "\n";
	}
	close S;
}

42;
