Refactor Format
[gruntmaster-daemon.git] / lib / Gruntmaster / Daemon.pm
CommitLineData
5c5cd38a
MG
1package Gruntmaster::Daemon;
2
3use 5.014000;
4use strict;
5use warnings;
6
7our $VERSION = '0.001';
8
9use Gruntmaster::Daemon::Constants qw/ERR/;
10use Gruntmaster::Daemon::Base qw/watch/;
ddceb393 11use Gruntmaster::Daemon::Format qw/mkrun/;
5c5cd38a
MG
12use Gruntmaster::Page qw/generate/;
13
14use Fcntl qw/:flock/;
15use File::Copy qw/cp/;
16use IO::File;
17use Time::HiRes qw/time/;
18use Try::Tiny;
19use YAML::Any qw/LoadFile DumpFile/;
20use Log::Log4perl qw/get_logger/;
21
22##################################################
23
24sub safe_can_nodie {
25 my ($type, $sub, $name) = @_;
26
27 return unless $name =~ /^\w+$/;
28 no strict 'refs';
29 my $pkg = __PACKAGE__ . "::${type}::${name}";
30 eval "require $pkg" or get_logger->warn("Error while requiring $pkg: $@");
31 $pkg->can($sub);
32}
33
34sub safe_can {
35 my ($type, $sub, $name) = @_;
36
37 safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
38}
39
ddceb393
MG
40sub prepare{
41 my $name = $_[0];
42 my $basename = fileparse $name, qr/\.[^.]*/;
43 get_logger->trace("Preparing file $name...");
44
45 open my $devnull, devnull;
46 open my $errors, '>>compile-error';
47 my $ret = open3 $devnull, $errors, undef, 'gruntmaster-compile', CPP => $basename, $name;
48 waitpid $ret, 0;
49 close $devnull;
50 close $errors;
51 die 'Compile error' if $?
52}
53
5c5cd38a
MG
54sub prepare_files{
55 my ($dir, $meta) = @_;
56
57 for my $file (values $meta->{files}) {
58 my ($format, $name) = @{$file}{qw/format name/};
59
ddceb393 60 $file->{run} = mkrun($format);
5c5cd38a 61 die "No such file: '$name'" unless -e $name;
ddceb393 62 prepare $name;
5c5cd38a
MG
63 }
64}
65
66sub process{
67 my $dir = $_[0];
68
69 chdir $dir;
70 mkdir "in";
71 for (<*>) {
1fc8d024 72 cp $_, "in" unless $_ eq 'in';
5c5cd38a
MG
73 }
74
75 my @results;
76 my @full_results = ();
77 my $meta = {};
78 try {
79 $meta = LoadFile "meta.yml";
80 if (exists $meta->{problem}) {
81 my $problem = $meta->{problem};
82 die "No such problem: $problem" unless -d "../../pb/$problem";
83 for (<../../pb/$problem/*>) {
84 cp $_, '.' unless $_ eq "../../pb/$problem/meta.yml"
85 }
86
87 my $pbmeta = LoadFile "../../pb/$problem/meta.yml";
88 $meta = {%$meta, %$pbmeta};
89 }
90
91 my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/;
92
93 $generator = safe_can Generator => generate => $generator;
94 $runner = safe_can Runner => run => $runner;
95 $judge = safe_can Judge => judge => $judge;
96
97 prepare_files $dir, $meta;
98 for my $test (1 .. $testcnt) {
99 my $start_time = time;
100 my $result;
101 try {
102 $generator->($test, $meta);
103 $result = $runner->($test, $meta);
104 } catch {
105 $result = $_;
106 unless (ref $result) {
107 chomp $result;
108 $result = [ERR, $result];
109 }
110 };
111
112 if (ref $result) {
113 get_logger->trace("Test $test result is " . $result->[1]);
114 push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time}
115 } else {
116 get_logger->trace("Test $test result is $result");
117 push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time}
118 }
119 push @results, $result;
120 last if $meta->{judge} eq 'Absolute' && ref $result
121 }
122
123 my %results = $judge->(@results);
124 $meta->{$_} = $results{$_} for keys %results;
125 } catch {
126 s,(.*) at .*,$1,;
127 chomp;
128 $meta->{result} = -1;
129 $meta->{result_text} = $_;
130 };
131
132 # Clean up
133 get_logger->info("Job result: " . $meta->{result_text});
5c5cd38a
MG
134 $meta->{results} = \@full_results if scalar @full_results;
135 DumpFile "meta.yml", $meta;
136 for (<*>) {
fe185d88 137 unlink $_ unless $_ eq 'in' || $_ eq 'meta.yml' || ($_ eq 'compile-error' && -s);
5c5cd38a
MG
138 }
139 chdir '../..';
fee71502
MG
140 my $log = exists $meta->{contest} ? "ct/$meta->{contest}/log" : 'log';
141 mkdir $log unless -d $log;
142 IO::File->new(">$log/meta.yml")->close unless -f "$log/meta.yml";
143 flock my $logmetafh = IO::File->new("<$log/meta.yml"), LOCK_EX;
144 my $logmeta = LoadFile "$log/meta.yml";
5c5cd38a 145 $logmeta->{last}++;
fee71502
MG
146 rename $dir, "$log/$logmeta->{last}";
147 generate "$log/$logmeta->{last}/index.html";
148 DumpFile "$log/meta.yml", $logmeta;
5c5cd38a 149 undef $logmetafh;
fee71502 150 generate "$log/index.html"
5c5cd38a
MG
151}
152
153sub run{
154 Log::Log4perl->init('log.conf');
155 watch 'jobs', \&process;
156}
157
1581;
159__END__
160# Below is stub documentation for your module. You'd better edit it!
161
162=head1 NAME
163
164Gruntmaster::Daemon - Perl extension for blah blah blah
165
166=head1 SYNOPSIS
167
168 use Gruntmaster::Daemon;
169 blah blah blah
170
171=head1 DESCRIPTION
172
173Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
174author of the extension was negligent enough to leave the stub
175unedited.
176
177Blah blah blah.
178
179
180=head1 SEE ALSO
181
182Mention other useful documentation such as the documentation of
183related modules or operating system documentation (such as man pages
184in UNIX), or any relevant external documentation such as RFCs or
185standards.
186
187If you have a mailing list set up for your module, mention it here.
188
189If you have a web site set up for your module, mention it here.
190
191=head1 AUTHOR
192
193Marius Gavrilescu, E<lt>marius@E<gt>
194
195=head1 COPYRIGHT AND LICENSE
196
197Copyright (C) 2013 by Marius Gavrilescu
198
199This library is free software; you can redistribute it and/or modify
200it under the same terms as Perl itself, either Perl version 5.18.1 or,
201at your option, any later version of Perl 5 you may have available.
202
203
204=cut
This page took 0.021139 seconds and 4 git commands to generate.