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__ |