]>
Commit | Line | Data |
---|---|---|
42546e6c MG |
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 header footer/; | |
8 | ||
9 | use File::Basename qw/fileparse/; | |
10 | use File::Slurp qw/write_file/; | |
11 | use IO::Compress::Gzip qw/gzip/; | |
12 | ||
13 | our $VERSION = '0.001'; | |
14 | our @generators; | |
15 | ||
16 | use constant LANGUAGES => [ 'en' ]; | |
17 | use constant CONTENT_TYPES => { | |
18 | html => 'text/html; charset=UTF-8', | |
19 | txt => 'text/plain; charset=UTF-8', | |
20 | }; | |
21 | ||
22 | my %header_templates = ( | |
23 | en => <<'HTML', | |
24 | <!DOCTYPE html> | |
25 | <title>TITLE_GOES_HERE</title> | |
26 | <link rel="stylesheet" href="/gm.css"> | |
27 | <script src="/jquery-2.0.3.min.js"></script> | |
28 | <script src="/view.js"></script> | |
29 | <meta charset="utf-8"> | |
30 | ||
31 | <span id="admin"></span> | |
32 | <div id="title"><span class="i">i</span><span class="Eval">Eval</span></div> | |
33 | <div id="subtitle">TITLE_GOES_HERE</div> | |
34 | ||
35 | <nav><ul><li><a href="/">Home</a><li><a href="/log/">View job log</a><li><a href="/submit.var">Submit job</a><li><a href="/pb/">Problem list</a></ul></nav> | |
36 | ||
37 | HTML | |
38 | ); | |
39 | ||
40 | my %footer_templates = ( | |
41 | en => <<'HTML', | |
42 | ||
43 | <footer> | |
44 | Dilmom: Why don't you call your product the Gruntmaster 6000? | |
45 | Dilbert: What kind of product do you see when you imagine a Gruntmaster 6000? | |
46 | Dilmom: Well, it's a stripped-down version of the Gruntmaster 9000, of course. But it's software-upgradeable. | |
47 | </footer> | |
48 | HTML | |
49 | ); | |
50 | ||
51 | sub header{ | |
52 | my ($language, $title) = @_; | |
53 | $header_templates{$language} =~ s/TITLE_GOES_HERE/$title/ger; | |
54 | } | |
55 | ||
56 | sub footer{ | |
57 | $footer_templates{$_[0]}; | |
58 | } | |
59 | ||
60 | sub declaregen{ | |
61 | my ($generator, $regex) = @_; | |
62 | $generator = "Gruntmaster::Page::$generator"; | |
63 | eval "require $generator"; | |
64 | my $gensub = $generator->can('generate') or die "No such generator: $generator"; | |
65 | push @generators, [$regex, $gensub]; | |
66 | } | |
67 | ||
68 | declaregen Index => qr'^index$'; | |
69 | declaregen Log => qr'^log/index$'; | |
70 | declaregen 'Log::Entry' => qr'^log/.*/index$'; | |
71 | declaregen Submit => qr'^submit$'; | |
72 | declaregen Pb => qr'^pb/index$'; | |
73 | declaregen 'Pb::Entry' => qr'^pb/.*/index$'; | |
74 | ||
75 | sub generate{ | |
76 | my ($path) = @_; | |
77 | my ($path_noext, $ext) = $path =~ m/^(.*)\.(.*)$/; | |
78 | my $basename = fileparse $path_noext; | |
79 | ||
80 | open my $typemap, ">$path_noext.var"; | |
81 | say $typemap "URI: $basename\n"; | |
82 | for my $gen(@generators) { | |
83 | my ($regex, $generator) = @$gen; | |
84 | next unless $path_noext =~ $regex; | |
85 | for my $lang (@{LANGUAGES()}) { | |
86 | my $page = $generator->($path, $lang); | |
87 | write_file "$path_noext.$lang.$ext", $page; | |
88 | say $typemap "URI: $basename.$lang.$ext\nContent-Language: $lang\nContent-Type: " . CONTENT_TYPES->{$ext} . "\n"; | |
89 | gzip \$page => "$path_noext.$lang.gz.$ext", Minimal => 1; | |
90 | say $typemap "URI: $basename.$lang.gz.$ext\nContent-Language: $lang\nContent-Encoding: gzip\nContent-Type: " . CONTENT_TYPES->{$ext} . "\n"; | |
91 | } | |
92 | } | |
93 | close $typemap; | |
94 | } | |
95 | ||
96 | 1; | |
97 | __END__ | |
98 | # Below is stub documentation for your module. You'd better edit it! | |
99 | ||
100 | =head1 NAME | |
101 | ||
102 | Gruntmaster::Page - Perl extension for blah blah blah | |
103 | ||
104 | =head1 SYNOPSIS | |
105 | ||
106 | use Gruntmaster::Page; | |
107 | blah blah blah | |
108 | ||
109 | =head1 DESCRIPTION | |
110 | ||
111 | Stub documentation for Gruntmaster::Page, created by h2xs. It looks like the | |
112 | author of the extension was negligent enough to leave the stub | |
113 | unedited. | |
114 | ||
115 | Blah blah blah. | |
116 | ||
117 | =head2 EXPORT | |
118 | ||
119 | None by default. | |
120 | ||
121 | ||
122 | ||
123 | =head1 SEE ALSO | |
124 | ||
125 | Mention other useful documentation such as the documentation of | |
126 | related modules or operating system documentation (such as man pages | |
127 | in UNIX), or any relevant external documentation such as RFCs or | |
128 | standards. | |
129 | ||
130 | If you have a mailing list set up for your module, mention it here. | |
131 | ||
132 | If you have a web site set up for your module, mention it here. | |
133 | ||
134 | =head1 AUTHOR | |
135 | ||
136 | Marius Gavrilescu, E<lt>marius@E<gt> | |
137 | ||
138 | =head1 COPYRIGHT AND LICENSE | |
139 | ||
140 | Copyright (C) 2013 by Marius Gavrilescu | |
141 | ||
142 | This library is free software; you can redistribute it and/or modify | |
143 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
144 | at your option, any later version of Perl 5 you may have available. | |
145 | ||
146 | ||
147 | =cut |