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