X-Git-Url: http://mj.ucw.cz/gitweb/?a=blobdiff_plain;f=lib%2FBEX.pm;h=579eff29454858a4ebbc636bca41a2529acb6551;hb=b2ffb3f4b552585446246fe76fa7526e62e58197;hp=7d7f99c5bb5d4da949d12466419990ca23f90ce0;hpb=672acfe6ec2d1115615076665685ffd00e7f6c43;p=bex.git

diff --git a/lib/BEX.pm b/lib/BEX.pm
index 7d7f99c..579eff2 100644
--- a/lib/BEX.pm
+++ b/lib/BEX.pm
@@ -4,195 +4,10 @@
 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/' . $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) . '/' . $jid . '.job';
-}
-
-sub status_file($$) {
-	my ($queue, $machine, $jid) = @_;
-	return $queue->host_dir($machine) . '/' . $jid . '.stat';
-}
-
-sub temp_file($$) {
-	my ($queue, $machine, $jid) = @_;
-	return $queue->host_dir($machine) . '/' . $jid . '.tmp';
-}
-
-sub job_file($$) {
-	my ($queue, $jid) = @_;
-	return $queue->{'Name'} . '/jobs/' . $jid. '.job';
-}
-
-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/' . $job->{'ID'} . '.job', $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) {
-			/^\./ and next;
-			s{\.job}{} 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;
-}
+use BEX::Config;
+use BEX::Job;
+use BEX::Queue;
 
 42;