lib/Plack/Middleware/BasicStyle.pm

   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.001001';
  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,is;
  47 }
  48
  49 sub call { ## no critic (Complexity)
  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 * 86_400;
  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/is;
  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-2017 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