+package Gruntmaster::Daemon;
+
+use 5.014000;
+use strict;
+use warnings;
+
+our $VERSION = '0.001';
+
+use Gruntmaster::Daemon::Constants qw/ERR/;
+use Gruntmaster::Daemon::Base qw/watch/;
+use Gruntmaster::Page qw/generate/;
+
+use Fcntl qw/:flock/;
+use File::Copy qw/cp/;
+use IO::File;
+use Time::HiRes qw/time/;
+use Try::Tiny;
+use YAML::Any qw/LoadFile DumpFile/;
+use Log::Log4perl qw/get_logger/;
+
+##################################################
+
+sub safe_can_nodie {
+ my ($type, $sub, $name) = @_;
+
+ return unless $name =~ /^\w+$/;
+ no strict 'refs';
+ my $pkg = __PACKAGE__ . "::${type}::${name}";
+ eval "require $pkg" or get_logger->warn("Error while requiring $pkg: $@");
+ $pkg->can($sub);
+}
+
+sub safe_can {
+ my ($type, $sub, $name) = @_;
+
+ safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
+}
+
+sub prepare_files{
+ my ($dir, $meta) = @_;
+
+ for my $file (values $meta->{files}) {
+ my ($format, $name) = @{$file}{qw/format name/};
+
+ my $prepare = safe_can Format => prepare => $format;
+ $file->{run} = safe_can Format => run => $format;
+ die "No such file: '$name'" unless -e $name;
+ $prepare->($name);
+ }
+}
+
+sub process{
+ my $dir = $_[0];
+
+ chdir $dir;
+ mkdir "in";
+ for (<*>) {
+ cp $_, "in" unless $_ eq 'in' || $_ eq 'pidfile';
+ }
+
+ my @results;
+ my @full_results = ();
+ my $meta = {};
+ try {
+ $meta = LoadFile "meta.yml";
+ if (exists $meta->{problem}) {
+ my $problem = $meta->{problem};
+ die "No such problem: $problem" unless -d "../../pb/$problem";
+ for (<../../pb/$problem/*>) {
+ cp $_, '.' unless $_ eq "../../pb/$problem/meta.yml"
+ }
+
+ my $pbmeta = LoadFile "../../pb/$problem/meta.yml";
+ $meta = {%$meta, %$pbmeta};
+ }
+
+ my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/;
+
+ $generator = safe_can Generator => generate => $generator;
+ $runner = safe_can Runner => run => $runner;
+ $judge = safe_can Judge => judge => $judge;
+
+ prepare_files $dir, $meta;
+ for my $test (1 .. $testcnt) {
+ my $start_time = time;
+ my $result;
+ try {
+ $generator->($test, $meta);
+ $result = $runner->($test, $meta);
+ } catch {
+ $result = $_;
+ unless (ref $result) {
+ chomp $result;
+ $result = [ERR, $result];
+ }
+ };
+
+ if (ref $result) {
+ get_logger->trace("Test $test result is " . $result->[1]);
+ push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time}
+ } else {
+ get_logger->trace("Test $test result is $result");
+ push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time}
+ }
+ push @results, $result;
+ last if $meta->{judge} eq 'Absolute' && ref $result
+ }
+
+ my %results = $judge->(@results);
+ $meta->{$_} = $results{$_} for keys %results;
+ } catch {
+ s,(.*) at .*,$1,;
+ chomp;
+ $meta->{result} = -1;
+ $meta->{result_text} = $_;
+ };
+
+ # Clean up
+ get_logger->info("Job result: " . $meta->{result_text});
+ delete $meta->{files}{$_}{run} for keys $meta->{files};
+ $meta->{date} = time;
+ $meta->{results} = \@full_results if scalar @full_results;
+ DumpFile "meta.yml", $meta;
+ for (<*>) {
+ unlink $_ unless $_ eq 'in' || $_ eq 'meta.yml';
+ }
+ chdir '../..';
+ mkdir 'log' unless -d 'log';
+ IO::File->new('>log/meta.yml')->close unless -f 'log/meta.yml';
+ flock my $logmetafh = IO::File->new('<log/meta.yml'), LOCK_EX;
+ my $logmeta = LoadFile 'log/meta.yml';
+ $logmeta->{last}++;
+ rename $dir, 'log/' . $logmeta->{last};
+ generate 'log/' . $logmeta->{last} . '/index.htm';
+ DumpFile 'log/meta.yml', $logmeta;
+ undef $logmetafh;
+ generate 'log/index.html'
+}
+
+sub run{
+ Log::Log4perl->init('log.conf');
+ watch 'jobs', \&process;
+}
+
+1;
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Gruntmaster::Daemon - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+ use Gruntmaster::Daemon;
+ blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+
+=head1 SEE ALSO
+
+Mention other useful documentation such as the documentation of
+related modules or operating system documentation (such as man pages
+in UNIX), or any relevant external documentation such as RFCs or
+standards.
+
+If you have a mailing list set up for your module, mention it here.
+
+If you have a web site set up for your module, mention it here.
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@E<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2013 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.18.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
projects / gruntmaster-daemon.git / commitdiff