]>
iEval git - gruntmaster-daemon.git/blob - lib/Gruntmaster/Daemon.pm
ccf9e4e213f10f88076fec3bd2de6154b5936f34
1 package Gruntmaster
::Daemon
;
7 our $VERSION = '0.001';
9 use Gruntmaster
::Daemon
::Constants qw
/ERR/;
10 use Gruntmaster
::Daemon
::Base qw
/watch/;
11 use Gruntmaster
::Page qw
/generate/;
14 use File
::Copy qw
/cp/;
16 use Time
::HiRes qw
/time/;
18 use YAML
::Any qw
/LoadFile DumpFile/;
19 use Log
::Log4perl qw
/get_logger/;
21 ##################################################
24 my ($type, $sub, $name) = @_;
26 return unless $name =~ /^\w+$/;
28 my $pkg = __PACKAGE__
. "::${type}::${name}";
29 eval "require $pkg" or get_logger
->warn("Error while requiring $pkg: $@");
34 my ($type, $sub, $name) = @_;
36 safe_can_nodie
@_ or get_logger
->logdie("No such \l$type: '$name'");
40 my ($dir, $meta) = @_;
42 for my $file (values $meta->{files
}) {
43 my ($format, $name) = @
{$file}{qw
/format name/};
45 my $prepare = safe_can Format
=> prepare
=> $format;
46 $file->{run
} = safe_can Format
=> run
=> $format;
47 die "No such file: '$name'" unless -e
$name;
58 cp
$_, "in" unless $_ eq 'in';
62 my @full_results = ();
65 $meta = LoadFile
"meta.yml";
66 if (exists $meta->{problem
}) {
67 my $problem = $meta->{problem
};
68 die "No such problem: $problem" unless -d
"../../pb/$problem";
69 for (<../../pb
/$problem/*>) {
70 cp
$_, '.' unless $_ eq "../../pb/$problem/meta.yml"
73 my $pbmeta = LoadFile
"../../pb/$problem/meta.yml";
74 $meta = {%$meta, %$pbmeta};
77 my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw
/files generator runner judge testcnt/;
79 $generator = safe_can Generator
=> generate
=> $generator;
80 $runner = safe_can Runner
=> run
=> $runner;
81 $judge = safe_can Judge
=> judge
=> $judge;
83 prepare_files
$dir, $meta;
84 for my $test (1 .. $testcnt) {
85 my $start_time = time;
88 $generator->($test, $meta);
89 $result = $runner->($test, $meta);
92 unless (ref $result) {
94 $result = [ERR
, $result];
99 get_logger
->trace("Test $test result is " . $result->[1]);
100 push @full_results, {id
=> $test, result
=> $result->[0], result_text
=> $result->[1], time => time - $start_time}
102 get_logger
->trace("Test $test result is $result");
103 push @full_results, {id
=> $test, result
=> 0, result_text
=> $result, time => time - $start_time}
105 push @results, $result;
106 last if $meta->{judge
} eq 'Absolute' && ref $result
109 my %results = $judge->(@results);
110 $meta->{$_} = $results{$_} for keys %results;
114 $meta->{result
} = -1;
115 $meta->{result_text
} = $_;
119 get_logger
->info("Job result: " . $meta->{result_text
});
120 delete $meta->{files
}{$_}{run
} for keys $meta->{files
};
121 $meta->{results
} = \
@full_results if scalar @full_results;
122 DumpFile
"meta.yml", $meta;
124 unlink $_ unless $_ eq 'in' || $_ eq 'meta.yml' || ($_ eq 'compile-error' && -s
);
127 my $log = exists $meta->{contest
} ?
"ct/$meta->{contest}/log" : 'log';
128 mkdir $log unless -d
$log;
129 IO
::File
->new(">$log/meta.yml")->close unless -f
"$log/meta.yml";
130 flock my $logmetafh = IO
::File
->new("<$log/meta.yml"), LOCK_EX
;
131 my $logmeta = LoadFile
"$log/meta.yml";
133 rename $dir, "$log/$logmeta->{last}";
134 generate
"$log/$logmeta->{last}/index.html";
135 DumpFile
"$log/meta.yml", $logmeta;
137 generate
"$log/index.html"
141 Log
::Log4perl
->init('log.conf');
142 watch
'jobs', \
&process
;
147 # Below is stub documentation for your module. You'd better edit it!
151 Gruntmaster::Daemon - Perl extension for blah blah blah
155 use Gruntmaster::Daemon;
160 Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
161 author of the extension was negligent enough to leave the stub
169 Mention other useful documentation such as the documentation of
170 related modules or operating system documentation (such as man pages
171 in UNIX), or any relevant external documentation such as RFCs or
174 If you have a mailing list set up for your module, mention it here.
176 If you have a web site set up for your module, mention it here.
180 Marius Gavrilescu, E<lt>marius@E<gt>
182 =head1 COPYRIGHT AND LICENSE
184 Copyright (C) 2013 by Marius Gavrilescu
186 This library is free software; you can redistribute it and/or modify
187 it under the same terms as Perl itself, either Perl version 5.18.1 or,
188 at your option, any later version of Perl 5 you may have available.
This page took 0.063063 seconds and 3 git commands to generate.