]>
Commit | Line | Data |
---|---|---|
1 | package Gruntmaster::Page; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Exporter/; | |
7 | our @EXPORT_OK = qw/generate _generate/; | |
8 | ||
9 | use Fcntl qw/:flock/; | |
10 | use File::Basename qw/fileparse/; | |
11 | use File::Path qw/make_path/; | |
12 | use File::Slurp qw/write_file/; | |
13 | use IO::Compress::Gzip qw/gzip/; | |
14 | use IO::File; | |
15 | use Gruntmaster::Data qw/PUBLISH/; | |
16 | ||
17 | our $VERSION = '0.001'; | |
18 | our @generators; | |
19 | ||
20 | use constant LANGUAGES => [ 'en' ]; | |
21 | use constant CONTENT_TYPES => { | |
22 | html => 'text/html; charset=UTF-8', | |
23 | txt => 'text/plain; charset=UTF-8', | |
24 | }; | |
25 | ||
26 | sub declaregen{ | |
27 | my ($generator, $regex) = @_; | |
28 | $generator = "Gruntmaster::Page::$generator"; | |
29 | eval "require $generator"; | |
30 | push @generators, [$regex, $generator]; | |
31 | } | |
32 | ||
33 | { | |
34 | my $component = qr'[^/]+'; | |
35 | my $contest = qr,(?:ct/$component/)?,; | |
36 | declaregen Index => qr,^index$,; | |
37 | declaregen Learn => qr,^learn$,; | |
38 | declaregen Account => qr,^account$,; | |
39 | declaregen Us => qr,^us/index$,; | |
40 | declaregen 'Us::Entry' => qr,^us/$component$,; | |
41 | declaregen Ct => qr,^ct/index$,; | |
42 | declaregen 'Ct::Entry' => qr,^ct/$component/index$,; | |
43 | declaregen St => qr,^ct/$component/log/st$,; | |
44 | declaregen Log => qr,^${contest}log/(?:\d+|index)$,; | |
45 | declaregen 'Log::Entry' => qr,^${contest}log/job/$component$,; | |
46 | declaregen Submit => qr,^${contest}submit$,; | |
47 | declaregen Pb => qr,^${contest}pb/index$,; | |
48 | declaregen 'Pb::Entry' => qr,^${contest}pb/$component$,; | |
49 | } | |
50 | ||
51 | sub _generate{ | |
52 | my ($path) = @_; | |
53 | my ($path_noext, $ext) = $path =~ m/^(.*)\.(.*)$/; | |
54 | my ($basename, $directories) = fileparse $path_noext; | |
55 | make_path $directories; | |
56 | ||
57 | IO::File->new(">$path_noext.var")->close unless -f "$path_noext.var"; | |
58 | flock my $lockfh = IO::File->new("<$path_noext.var"), LOCK_EX; | |
59 | open my $typemap, ">$path_noext.var.new"; | |
60 | say $typemap "URI: $basename\n"; | |
61 | for my $gen (@generators) { | |
62 | my ($regex, $generator) = @$gen; | |
63 | next unless $path_noext =~ $regex; | |
64 | for my $lang (@{LANGUAGES()}) { | |
65 | my $page = $generator->generate($path, $lang); | |
66 | write_file "$path_noext.$lang.$ext.new", $page; | |
67 | say $typemap "URI: $basename.$lang.$ext\nContent-Language: $lang\nContent-Type: " . CONTENT_TYPES->{$ext} . "\n"; | |
68 | gzip \$page => "$path_noext.$lang.gz.$ext.new", Minimal => 1; | |
69 | say $typemap "URI: $basename.$lang.gz.$ext\nContent-Language: $lang\nContent-Encoding: gzip\nContent-Type: " . CONTENT_TYPES->{$ext} . "\n"; | |
70 | } | |
71 | last | |
72 | } | |
73 | ||
74 | for my $lang (@{LANGUAGES()}) { | |
75 | rename "$path_noext.$lang.$ext.new", "$path_noext.$lang.$ext"; | |
76 | rename "$path_noext.$lang.gz.$ext.new", "$path_noext.$lang.gz.$ext"; | |
77 | } | |
78 | rename "$path_noext.var.new", "$path_noext.var"; | |
79 | close $typemap; | |
80 | } | |
81 | ||
82 | sub generate{ | |
83 | PUBLISH 'genpage', shift; | |
84 | } | |
85 | ||
86 | 1; | |
87 | __END__ | |
88 | # Below is stub documentation for your module. You'd better edit it! | |
89 | ||
90 | =head1 NAME | |
91 | ||
92 | Gruntmaster::Page - Perl extension for blah blah blah | |
93 | ||
94 | =head1 SYNOPSIS | |
95 | ||
96 | use Gruntmaster::Page; | |
97 | blah blah blah | |
98 | ||
99 | =head1 DESCRIPTION | |
100 | ||
101 | Stub documentation for Gruntmaster::Page, created by h2xs. It looks like the | |
102 | author of the extension was negligent enough to leave the stub | |
103 | unedited. | |
104 | ||
105 | Blah blah blah. | |
106 | ||
107 | =head2 EXPORT | |
108 | ||
109 | None by default. | |
110 | ||
111 | ||
112 | ||
113 | =head1 SEE ALSO | |
114 | ||
115 | Mention other useful documentation such as the documentation of | |
116 | related modules or operating system documentation (such as man pages | |
117 | in UNIX), or any relevant external documentation such as RFCs or | |
118 | standards. | |
119 | ||
120 | If you have a mailing list set up for your module, mention it here. | |
121 | ||
122 | If you have a web site set up for your module, mention it here. | |
123 | ||
124 | =head1 AUTHOR | |
125 | ||
126 | Marius Gavrilescu, E<lt>marius@E<gt> | |
127 | ||
128 | =head1 COPYRIGHT AND LICENSE | |
129 | ||
130 | Copyright (C) 2013 by Marius Gavrilescu | |
131 | ||
132 | This library is free software; you can redistribute it and/or modify | |
133 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
134 | at your option, any later version of Perl 5 you may have available. | |
135 | ||
136 | ||
137 | =cut |