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