Refactor Format
[gruntmaster-daemon.git] / lib / Gruntmaster / Daemon.pm
1 package Gruntmaster::Daemon;
2
3 use 5.014000;
4 use strict;
5 use warnings;
6
7 our $VERSION = '0.001';
8
9 use Gruntmaster::Daemon::Constants qw/ERR/;
10 use Gruntmaster::Daemon::Base qw/watch/;
11 use Gruntmaster::Daemon::Format qw/mkrun/;
12 use Gruntmaster::Page qw/generate/;
13
14 use Fcntl qw/:flock/;
15 use File::Copy qw/cp/;
16 use IO::File;
17 use Time::HiRes qw/time/;
18 use Try::Tiny;
19 use YAML::Any qw/LoadFile DumpFile/;
20 use Log::Log4perl qw/get_logger/;
21
22 ##################################################
23
24 sub 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
34 sub safe_can {
35 my ($type, $sub, $name) = @_;
36
37 safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
38 }
39
40 sub 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
54 sub prepare_files{
55 my ($dir, $meta) = @_;
56
57 for my $file (values $meta->{files}) {
58 my ($format, $name) = @{$file}{qw/format name/};
59
60 $file->{run} = mkrun($format);
61 die "No such file: '$name'" unless -e $name;
62 prepare $name;
63 }
64 }
65
66 sub process{
67 my $dir = $_[0];
68
69 chdir $dir;
70 mkdir "in";
71 for (<*>) {
72 cp $_, "in" unless $_ eq 'in';
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});
134 $meta->{results} = \@full_results if scalar @full_results;
135 DumpFile "meta.yml", $meta;
136 for (<*>) {
137 unlink $_ unless $_ eq 'in' || $_ eq 'meta.yml' || ($_ eq 'compile-error' && -s);
138 }
139 chdir '../..';
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";
145 $logmeta->{last}++;
146 rename $dir, "$log/$logmeta->{last}";
147 generate "$log/$logmeta->{last}/index.html";
148 DumpFile "$log/meta.yml", $logmeta;
149 undef $logmetafh;
150 generate "$log/index.html"
151 }
152
153 sub run{
154 Log::Log4perl->init('log.conf');
155 watch 'jobs', \&process;
156 }
157
158 1;
159 __END__
160 # Below is stub documentation for your module. You'd better edit it!
161
162 =head1 NAME
163
164 Gruntmaster::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
173 Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
174 author of the extension was negligent enough to leave the stub
175 unedited.
176
177 Blah blah blah.
178
179
180 =head1 SEE ALSO
181
182 Mention other useful documentation such as the documentation of
183 related modules or operating system documentation (such as man pages
184 in UNIX), or any relevant external documentation such as RFCs or
185 standards.
186
187 If you have a mailing list set up for your module, mention it here.
188
189 If you have a web site set up for your module, mention it here.
190
191 =head1 AUTHOR
192
193 Marius Gavrilescu, E<lt>marius@E<gt>
194
195 =head1 COPYRIGHT AND LICENSE
196
197 Copyright (C) 2013 by Marius Gavrilescu
198
199 This library is free software; you can redistribute it and/or modify
200 it under the same terms as Perl itself, either Perl version 5.18.1 or,
201 at your option, any later version of Perl 5 you may have available.
202
203
204 =cut
This page took 0.032609 seconds and 4 git commands to generate.