Initial commit
[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::Page qw/generate/;
12
13 use Fcntl qw/:flock/;
14 use File::Copy qw/cp/;
15 use IO::File;
16 use Time::HiRes qw/time/;
17 use Try::Tiny;
18 use YAML::Any qw/LoadFile DumpFile/;
19 use Log::Log4perl qw/get_logger/;
20
21 ##################################################
22
23 sub 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
33 sub safe_can {
34 my ($type, $sub, $name) = @_;
35
36 safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
37 }
38
39 sub 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
52 sub process{
53 my $dir = $_[0];
54
55 chdir $dir;
56 mkdir "in";
57 for (<*>) {
58 cp $_, "in" unless $_ eq 'in' || $_ eq 'pidfile';
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};
121 $meta->{date} = time;
122 $meta->{results} = \@full_results if scalar @full_results;
123 DumpFile "meta.yml", $meta;
124 for (<*>) {
125 unlink $_ unless $_ eq 'in' || $_ eq 'meta.yml';
126 }
127 chdir '../..';
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';
132 $logmeta->{last}++;
133 rename $dir, 'log/' . $logmeta->{last};
134 generate 'log/' . $logmeta->{last} . '/index.htm';
135 DumpFile 'log/meta.yml', $logmeta;
136 undef $logmetafh;
137 generate 'log/index.html'
138 }
139
140 sub run{
141 Log::Log4perl->init('log.conf');
142 watch 'jobs', \&process;
143 }
144
145 1;
146 __END__
147 # Below is stub documentation for your module. You'd better edit it!
148
149 =head1 NAME
150
151 Gruntmaster::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
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
162 unedited.
163
164 Blah blah blah.
165
166
167 =head1 SEE ALSO
168
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
172 standards.
173
174 If you have a mailing list set up for your module, mention it here.
175
176 If you have a web site set up for your module, mention it here.
177
178 =head1 AUTHOR
179
180 Marius Gavrilescu, E<lt>marius@E<gt>
181
182 =head1 COPYRIGHT AND LICENSE
183
184 Copyright (C) 2013 by Marius Gavrilescu
185
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.
189
190
191 =cut
This page took 0.06185 seconds and 4 git commands to generate.