File Coverage

blib/lib/Plack/Middleware/BasicStyle.pm
Criterion Covered Total %
statement 69 70 98.5
branch 29 30 96.6
condition 24 38 63.1
subroutine 12 12 100.0
pod 2 2 100.0
total 136 152 89.4


line stmt bran cond sub pod time code
1             package Plack::Middleware::BasicStyle;
2              
3 1     1   12800 use 5.014000;
  1         2  
4 1     1   4 use strict;
  1         1  
  1         15  
5 1     1   3 use warnings;
  1         3  
  1         20  
6              
7 1     1   377 use parent qw/Plack::Middleware/;
  1         271  
  1         3  
8              
9 1     1   10906 use HTML::Parser;
  1         4115  
  1         26  
10 1     1   447 use Plack::Request;
  1         51671  
  1         27  
11 1     1   6 use Plack::Util;
  1         1  
  1         20  
12 1     1   4 use Plack::Util::Accessor qw/style any_content_type even_if_styled use_link_header/;
  1         2  
  1         7  
13              
14             our $VERSION = '0.001';
15             our $DEFAULT_STYLE = <
16            
30             EOF
31              
32             sub prepare_app {
33 13     13 1 6017 my ($self) = @_;
34             $self->{link_header} =
35 13 100       23 sprintf '<%s>; rel=stylesheet', $self->use_link_header
36             if $self->use_link_header;
37 13   66     108 $self->style($self->style // $DEFAULT_STYLE);
38             }
39              
40             sub _content_type_ok {
41 12     12   12 my ($self, $hdrs) = @_;
42 12 100       21 return 1 if $self->any_content_type;
43 11         47 my $content_type =
44             Plack::Util::header_get($hdrs, 'Content-Type');
45 11 100       85 return '' unless $content_type;
46 10         35 $content_type =~ m,text/html,i;
47             }
48              
49             sub call {
50 13     13 1 21458 my ($self, $env) = @_;
51 13 100       24 if ($self->use_link_header) {
52 2         18 my $req = Plack::Request->new($env);
53 2 100       18 if (lc $req->path eq lc $self->use_link_header) {
54 1         8 my $days30 = 30 * 86400;
55 1         13 my @hdrs = (
56             'Content-Length' => length $self->style,
57             'Content-Type' => 'text/css',
58             'Cache-Control' => "max-age=$days30",
59             );
60 1         7 return [200, \@hdrs, [$self->style]]
61             }
62             }
63              
64 12         83 my $res = $self->app->($env);
65 12 50 33     129 if (ref $res ne 'ARRAY'
    100 33        
66             || @$res < 3
67             || ref $res->[2] ne 'ARRAY' ) {
68 0         0 $res
69             } elsif (!$self->_content_type_ok($res->[1])) {
70 1         4 $res
71             } else {
72 11         11 my ($styled, $html_end, $head_end, $doctype_end);
73             my $parser_callback = sub {
74 14     14   18 my ($tagname, $offset_end, $attr) = @_;
75 14 100 33     26 $html_end //= $offset_end if $tagname eq 'html';
76 14 100 33     22 $head_end //= $offset_end if $tagname eq 'head';
77 14 100 33     33 $doctype_end //= $offset_end if $tagname eq 'doctype';
78 14 100       19 $styled = 1 if $tagname eq 'style';
79             $styled = 1 if $tagname eq 'link'
80 14 100 50     62 && ($attr->{rel} // '') =~ /stylesheet/i;
      66        
81 11         31 };
82              
83 11         38 my $p = HTML::Parser->new(api_version => 3);
84 11         205 $p->report_tags(qw/style link html head/);
85 11         36 $p->handler(start => $parser_callback, 'tagname,offset_end,attr');
86 11         23 $p->handler(declaration => $parser_callback, 'tagname,offset_end,attr');
87 11         6 $p->parse($_) for @{$res->[2]};
  11         58  
88 11         20 $p->eof;
89              
90 11 100 100     27 return $res if $styled && !$self->even_if_styled;
91              
92 9 100       18 if ($self->use_link_header) {
93 1         4 push @{$res->[1]}, 'Link', $self->{link_header};
  1         3  
94             } else {
95             # If there's a , put the style right after it
96             # Otherwise, if there's a , put the style right after it
97             # Otherwise, if there's a , put the style right after it
98             # Otherwise, put the style at the very beginning of the body
99 8 100 100     53 if ($head_end || $html_end || $doctype_end) {
      100        
100 5         4 my $body = join '', @{$res->[2]};
  5         9  
101 5   100     20 my $pos = $head_end // $html_end // $doctype_end;
      66        
102 5         9 substr $body, $pos, 0, $self->style;
103 5         21 $res->[2] = [$body]
104             } else {
105 3         2 unshift @{$res->[2]}, $self->style
  3         7  
106             }
107             }
108              
109 9         91 $res
110             }
111             }
112              
113             1;
114             __END__