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   84331 use 5.014000;
  1         5  
4 1     1   7 use strict;
  1         3  
  1         30  
5 1     1   7 use warnings;
  1         3  
  1         50  
6              
7 1     1   374 use parent qw/Plack::Middleware/;
  1         342  
  1         7  
8              
9 1     1   15249 use HTML::Parser;
  1         6957  
  1         56  
10 1     1   472 use Plack::Request;
  1         78388  
  1         47  
11 1     1   11 use Plack::Util;
  1         3  
  1         40  
12 1     1   10 use Plack::Util::Accessor qw/style any_content_type even_if_styled use_link_header/;
  1         4  
  1         11  
13              
14             our $VERSION = '0.001001';
15             our $DEFAULT_STYLE = <<'EOF' =~ y/\n\t //rd;
16            
30             EOF
31              
32             sub prepare_app {
33 13     13 1 14593 my ($self) = @_;
34             $self->{link_header} =
35 13 100       50 sprintf '<%s>; rel=stylesheet', $self->use_link_header
36             if $self->use_link_header;
37 13   66     157 $self->style($self->style // $DEFAULT_STYLE);
38             }
39              
40             sub _content_type_ok {
41 12     12   32 my ($self, $hdrs) = @_;
42 12 100       41 return 1 if $self->any_content_type;
43 11         79 my $content_type =
44             Plack::Util::header_get($hdrs, 'Content-Type');
45 11 100       180 return '' unless $content_type;
46 10         66 $content_type =~ m,text/html,is;
47             }
48              
49             sub call { ## no critic (Complexity)
50 13     13 1 46614 my ($self, $env) = @_;
51 13 100       53 if ($self->use_link_header) {
52 2         26 my $req = Plack::Request->new($env);
53 2 100       27 if (lc $req->path eq lc $self->use_link_header) {
54 1         9 my $days30 = 30 * 86_400;
55 1         3 my @hdrs = (
56             'Content-Length' => length $self->style,
57             'Content-Type' => 'text/css',
58             'Cache-Control' => "max-age=$days30",
59             );
60 1         8 return [200, \@hdrs, [$self->style]]
61             }
62             }
63              
64 12         164 my $res = $self->app->($env);
65 12 50 33     208 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         7 $res
71             } else {
72 11         34 my ($styled, $html_end, $head_end, $doctype_end);
73             my $parser_callback = sub {
74 14     14   47 my ($tagname, $offset_end, $attr) = @_;
75 14 100 33     57 $html_end //= $offset_end if $tagname eq 'html';
76 14 100 33     46 $head_end //= $offset_end if $tagname eq 'head';
77 14 100 33     75 $doctype_end //= $offset_end if $tagname eq 'doctype';
78 14 100       37 $styled = 1 if $tagname eq 'style';
79             $styled = 1 if $tagname eq 'link'
80 14 100 50     113 && ($attr->{rel} // '') =~ /stylesheet/is;
      66        
81 11         65 };
82              
83 11         74 my $p = HTML::Parser->new(api_version => 3);
84 11         443 $p->report_tags(qw/style link html head/);
85 11         120 $p->handler(start => $parser_callback, 'tagname,offset_end,attr');
86 11         55 $p->handler(declaration => $parser_callback, 'tagname,offset_end,attr');
87 11         25 $p->parse($_) for @{$res->[2]};
  11         93  
88 11         55 $p->eof;
89              
90 11 100 100     42 return $res if $styled && !$self->even_if_styled;
91              
92 9 100       38 if ($self->use_link_header) {
93 1         9 push @{$res->[1]}, 'Link', $self->{link_header};
  1         7  
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     87 if ($head_end || $html_end || $doctype_end) {
      100        
100 5         11 my $body = join '', @{$res->[2]};
  5         22  
101 5   100     32 my $pos = $head_end // $html_end // $doctype_end;
      66        
102 5         39 substr $body, $pos, 0, $self->style;
103 5         47 $res->[2] = [$body]
104             } else {
105 3         7 unshift @{$res->[2]}, $self->style
  3         13  
106             }
107             }
108              
109 9         163 $res
110             }
111             }
112              
113             1;
114             __END__