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