]>
Commit | Line | Data |
---|---|---|
1c93f4de MG |
1 | package Plack::Middleware::BasicStyle; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
7 | use parent qw/Plack::Middleware/; | |
8 | ||
9 | use HTML::Parser; | |
10 | use Plack::Request; | |
11 | use Plack::Util; | |
12 | use Plack::Util::Accessor qw/style any_content_type even_if_styled use_link_header/; | |
13 | ||
14 | our $VERSION = '0.001'; | |
15 | our $DEFAULT_STYLE = <<EOF =~ y/\n\t //rd; | |
16 | <style> | |
17 | body { | |
18 | margin:40px auto; | |
19 | max-width: 650px; | |
20 | line-height: 1.6; | |
21 | font-size:18px; | |
22 | color:#444; | |
23 | padding:0 10px | |
24 | } | |
25 | ||
26 | h1,h2,h3 { | |
27 | line-height:1.2 | |
28 | } | |
29 | </style> | |
30 | EOF | |
31 | ||
32 | sub prepare_app { | |
33 | my ($self) = @_; | |
34 | $self->{link_header} = | |
35 | sprintf '<%s>; rel=stylesheet', $self->use_link_header | |
36 | if $self->use_link_header; | |
37 | $self->style($self->style // $DEFAULT_STYLE); | |
38 | } | |
39 | ||
40 | sub _content_type_ok { | |
41 | my ($self, $hdrs) = @_; | |
42 | return 1 if $self->any_content_type; | |
43 | my $content_type = | |
44 | Plack::Util::header_get($hdrs, 'Content-Type'); | |
45 | return '' unless $content_type; | |
46 | $content_type =~ m,text/html,i; | |
47 | } | |
48 | ||
49 | sub call { | |
50 | my ($self, $env) = @_; | |
51 | if ($self->use_link_header) { | |
52 | my $req = Plack::Request->new($env); | |
53 | if (lc $req->path eq lc $self->use_link_header) { | |
54 | my $days30 = 30 * 86400; | |
55 | my @hdrs = ( | |
56 | 'Content-Length' => length $self->style, | |
57 | 'Content-Type' => 'text/css', | |
58 | 'Cache-Control' => "max-age=$days30", | |
59 | ); | |
60 | return [200, \@hdrs, [$self->style]] | |
61 | } | |
62 | } | |
63 | ||
64 | my $res = $self->app->($env); | |
65 | if (ref $res ne 'ARRAY' | |
66 | || @$res < 3 | |
67 | || ref $res->[2] ne 'ARRAY' ) { | |
68 | $res | |
69 | } elsif (!$self->_content_type_ok($res->[1])) { | |
70 | $res | |
71 | } else { | |
72 | my ($styled, $html_end, $head_end, $doctype_end); | |
73 | my $parser_callback = sub { | |
74 | my ($tagname, $offset_end, $attr) = @_; | |
75 | $html_end //= $offset_end if $tagname eq 'html'; | |
76 | $head_end //= $offset_end if $tagname eq 'head'; | |
77 | $doctype_end //= $offset_end if $tagname eq 'doctype'; | |
78 | $styled = 1 if $tagname eq 'style'; | |
79 | $styled = 1 if $tagname eq 'link' | |
80 | && ($attr->{rel} // '') =~ /stylesheet/i; | |
81 | }; | |
82 | ||
83 | my $p = HTML::Parser->new(api_version => 3); | |
84 | $p->report_tags(qw/style link html head/); | |
85 | $p->handler(start => $parser_callback, 'tagname,offset_end,attr'); | |
86 | $p->handler(declaration => $parser_callback, 'tagname,offset_end,attr'); | |
87 | $p->parse($_) for @{$res->[2]}; | |
88 | $p->eof; | |
89 | ||
90 | return $res if $styled && !$self->even_if_styled; | |
91 | ||
92 | if ($self->use_link_header) { | |
93 | push @{$res->[1]}, 'Link', $self->{link_header}; | |
94 | } else { | |
95 | # If there's a <head>, put the style right after it | |
96 | # Otherwise, if there's a <html>, put the style right after it | |
97 | # Otherwise, if there's a <!DOCTYPE ...>, put the style right after it | |
98 | # Otherwise, put the style at the very beginning of the body | |
99 | if ($head_end || $html_end || $doctype_end) { | |
100 | my $body = join '', @{$res->[2]}; | |
101 | my $pos = $head_end // $html_end // $doctype_end; | |
102 | substr $body, $pos, 0, $self->style; | |
103 | $res->[2] = [$body] | |
104 | } else { | |
105 | unshift @{$res->[2]}, $self->style | |
106 | } | |
107 | } | |
108 | ||
109 | $res | |
110 | } | |
111 | } | |
112 | ||
113 | 1; | |
114 | __END__ | |
115 | ||
116 | =encoding utf-8 | |
117 | ||
118 | =head1 NAME | |
119 | ||
120 | Plack::Middleware::BasicStyle - Add a basic <style> element to pages that don't have one | |
121 | ||
122 | =head1 SYNOPSIS | |
123 | ||
124 | # Basic usage (all default options) | |
125 | use Plack::Builder; | |
126 | builder { | |
127 | enable 'BasicStyle'; | |
128 | ... | |
129 | } | |
130 | ||
131 | # Default options set explicitly | |
132 | use Plack::Builder; | |
133 | builder { | |
134 | enable 'BasicStyle', | |
135 | style => $Plack::Middleware::BasicStyle::DEFAULT_STYLE, | |
136 | any_content_type => '', | |
137 | even_if_styled => '', | |
138 | use_link_header => ''; | |
139 | ... | |
140 | } | |
141 | ||
142 | # Custom options | |
143 | use Plack::Builder; | |
144 | builder { | |
145 | enable 'BasicStyle', | |
146 | style => '<style>body { background-color: #ddd }</style>', | |
147 | any_content_type => 1, | |
148 | even_if_styled => 1, | |
149 | use_link_header => '/basic-style.css'; | |
150 | ... | |
151 | } | |
152 | ||
153 | =head1 DESCRIPTION | |
154 | ||
155 | Plack::Middleware::BasicStyle is a Plack middleware that adds a basic | |
156 | <style> element to HTML pages that do not have a stylesheet. | |
157 | ||
158 | The default style, taken from | |
159 | L<http://bettermotherfuckingwebsite.com>, is (before minification): | |
160 | ||
161 | <style> | |
162 | body { | |
163 | margin:40px auto; | |
164 | max-width: 650px; | |
165 | line-height: 1.6; | |
166 | font-size:18px; | |
167 | color:#444; | |
168 | padding:0 10px | |
169 | } | |
170 | ||
171 | h1,h2,h3 { | |
172 | line-height:1.2 | |
173 | } | |
174 | </style> | |
175 | ||
176 | The middleware takes the following arguments: | |
177 | ||
178 | =over | |
179 | ||
180 | =item B<style> | |
181 | ||
182 | This is the HTML fragment that will be added to unstyled pages. | |
183 | ||
184 | It defaults to the value of | |
185 | C<< $Plack::Middleware::BasicStyle::DEFAULT_STYLE >>. | |
186 | ||
187 | =item B<any_content_type> | |
188 | ||
189 | If true, don't check whether Content-Type contains C<text/html>. | |
190 | ||
191 | If false (default), passes the response through unchanged if the | |
192 | Content-Type header is unset or does not contain the case-insensitive | |
193 | substring C<text/html>. | |
194 | ||
195 | =item B<even_if_styled> | |
196 | ||
197 | If true, don't check whether the response already includes a <style> | |
198 | or <link ... rel="stylesheet"> element. | |
199 | ||
200 | If false (default), passes the response through unchanged if the | |
201 | response includes a <style> or <link ... rel="stylesheet"> element. | |
202 | ||
203 | =item B<use_link_header> | |
204 | ||
205 | If false or unset (default), the given HTML fragment will be added | |
206 | right after the <head> start tag (if this exists), right after the | |
207 | <html> start tag (if this exists but <head> doesn't), or at the | |
208 | beginning of the document (if neither <html> nor <head> exists). | |
209 | ||
210 | If set, its value is interpreted as an URL path. The body of the | |
211 | response will not be modified, instead a C<Link:> HTTP header will be | |
212 | added to unstyled pages. Additionally, the middleware will intercept | |
213 | requests to that exact URL path and return the style (with status 200, | |
214 | a Content-Type of C<text/css>, a correct Content-Length header, and a | |
215 | Cache-Control header instructing the browser to cache the style for 30 | |
216 | days). | |
217 | ||
218 | Setting this makes the module more resilient to bugs and more | |
219 | efficient at the cost of asking the client to make an extra request. | |
220 | Therefore setting this argument is B<recommended>. | |
221 | ||
222 | =back | |
223 | ||
224 | =head1 CAVEATS | |
225 | ||
226 | This middleware only works with simple (non-streaming) responses, | |
227 | where the body is an arrayref. | |
228 | ||
229 | In other words, responses where the body is an IO::Handle, or | |
230 | streaming/delayed responses are NOT supported and will be passed | |
231 | through unchanged by this middleware. | |
232 | ||
233 | =head1 SEE ALSO | |
234 | ||
235 | L<http://bettermotherfuckingwebsite.com> | |
236 | ||
237 | =head1 AUTHOR | |
238 | ||
239 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
240 | ||
241 | =head1 COPYRIGHT AND LICENSE | |
242 | ||
243 | Copyright (C) 2016 by Marius Gavrilescu | |
244 | ||
245 | This library is free software; you can redistribute it and/or modify | |
246 | it under the same terms as Perl itself, either Perl version 5.24.0 or, | |
247 | at your option, any later version of Perl 5 you may have available. | |
248 | ||
249 | ||
250 | =cut |