Filename | /usr/local/share/perl/5.18.2/Plack/Middleware/Lint.pm |
Statements | Executed 6300079 statements in 17.3s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
100001 | 1 | 1 | 6.04s | 8.05s | validate_res | Plack::Middleware::Lint::
100001 | 1 | 1 | 5.93s | 6.95s | validate_env | Plack::Middleware::Lint::
100001 | 1 | 1 | 2.99s | 894s | call | Plack::Middleware::Lint::
1400014 | 8 | 1 | 2.30s | 2.30s | CORE:match (opcode) | Plack::Middleware::Lint::
100001 | 1 | 1 | 591ms | 727ms | _has_wide_char | Plack::Middleware::Lint::
1 | 1 | 1 | 33µs | 50µs | BEGIN@2 | Plack::Middleware::Lint::
1 | 1 | 1 | 10µs | 54µs | wrap | Plack::Middleware::Lint::
1 | 1 | 1 | 10µs | 23µs | BEGIN@3 | Plack::Middleware::Lint::
1 | 1 | 1 | 9µs | 31µs | BEGIN@5 | Plack::Middleware::Lint::
1 | 1 | 1 | 7µs | 42µs | BEGIN@6 | Plack::Middleware::Lint::
1 | 1 | 1 | 6µs | 6µs | BEGIN@7 | Plack::Middleware::Lint::
1 | 1 | 1 | 3µs | 3µs | BEGIN@4 | Plack::Middleware::Lint::
0 | 0 | 0 | 0s | 0s | __ANON__[:108] | Plack::Middleware::Lint::
0 | 0 | 0 | 0s | 0s | is_possibly_fh | Plack::Middleware::Lint::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Plack::Middleware::Lint; | ||||
2 | 2 | 26µs | 2 | 67µs | # spent 50µs (33+17) within Plack::Middleware::Lint::BEGIN@2 which was called:
# once (33µs+17µs) by Plack::Util::load_class at line 2 # spent 50µs making 1 call to Plack::Middleware::Lint::BEGIN@2
# spent 17µs making 1 call to strict::import |
3 | 2 | 23µs | 2 | 36µs | # spent 23µs (10+13) within Plack::Middleware::Lint::BEGIN@3 which was called:
# once (10µs+13µs) by Plack::Util::load_class at line 3 # spent 23µs making 1 call to Plack::Middleware::Lint::BEGIN@3
# spent 13µs making 1 call to warnings::unimport |
4 | 2 | 22µs | 1 | 3µs | # spent 3µs within Plack::Middleware::Lint::BEGIN@4 which was called:
# once (3µs+0s) by Plack::Util::load_class at line 4 # spent 3µs making 1 call to Plack::Middleware::Lint::BEGIN@4 |
5 | 2 | 25µs | 2 | 54µs | # spent 31µs (9+23) within Plack::Middleware::Lint::BEGIN@5 which was called:
# once (9µs+23µs) by Plack::Util::load_class at line 5 # spent 31µs making 1 call to Plack::Middleware::Lint::BEGIN@5
# spent 23µs making 1 call to parent::import |
6 | 2 | 27µs | 2 | 78µs | # spent 42µs (7+35) within Plack::Middleware::Lint::BEGIN@6 which was called:
# once (7µs+35µs) by Plack::Util::load_class at line 6 # spent 42µs making 1 call to Plack::Middleware::Lint::BEGIN@6
# spent 35µs making 1 call to Exporter::import |
7 | 2 | 834µs | 1 | 6µs | # spent 6µs within Plack::Middleware::Lint::BEGIN@7 which was called:
# once (6µs+0s) by Plack::Util::load_class at line 7 # spent 6µs making 1 call to Plack::Middleware::Lint::BEGIN@7 |
8 | |||||
9 | # spent 54µs (10+44) within Plack::Middleware::Lint::wrap which was called:
# once (10µs+44µs) by Plack::Runner::__ANON__[/usr/local/share/perl/5.18.2/Plack/Runner.pm:193] at line 193 of Plack/Runner.pm | ||||
10 | 1 | 500ns | my($self, $app) = @_; | ||
11 | |||||
12 | 1 | 900ns | unless (ref $app eq 'CODE' or overload::Method($app, '&{}')) { | ||
13 | die("PSGI app should be a code reference: ", (defined $app ? $app : "undef")); | ||||
14 | } | ||||
15 | |||||
16 | 1 | 8µs | 1 | 44µs | $self->SUPER::wrap($app); # spent 44µs making 1 call to Plack::Middleware::wrap |
17 | } | ||||
18 | |||||
19 | # spent 894s (2.99+891) within Plack::Middleware::Lint::call which was called 100001 times, avg 8.94ms/call:
# 100001 times (2.99s+891s) by Plack::Component::__ANON__[/usr/local/share/perl/5.18.2/Plack/Component.pm:50] at line 50 of Plack/Component.pm, avg 8.94ms/call | ||||
20 | 100001 | 81.8ms | my $self = shift; | ||
21 | 100001 | 51.4ms | my $env = shift; | ||
22 | |||||
23 | 100001 | 280ms | 100001 | 6.95s | $self->validate_env($env); # spent 6.95s making 100001 calls to Plack::Middleware::Lint::validate_env, avg 70µs/call |
24 | 100001 | 545ms | 200002 | 876s | my $res = $self->app->($env); # spent 876s making 100001 calls to Plack::Component::__ANON__[Plack/Component.pm:50], avg 8.76ms/call
# spent 310ms making 100001 calls to Plack::Util::Accessor::__ANON__[Plack/Util/Accessor.pm:19], avg 3µs/call |
25 | 100001 | 749ms | 100001 | 8.05s | return $self->validate_res($res); # spent 8.05s making 100001 calls to Plack::Middleware::Lint::validate_res, avg 80µs/call |
26 | } | ||||
27 | |||||
28 | # spent 6.95s (5.93+1.02) within Plack::Middleware::Lint::validate_env which was called 100001 times, avg 70µs/call:
# 100001 times (5.93s+1.02s) by Plack::Middleware::Lint::call at line 23, avg 70µs/call | ||||
29 | 100001 | 81.4ms | my ($self, $env) = @_; | ||
30 | 100001 | 114ms | unless ($env->{REQUEST_METHOD}) { | ||
31 | die('Missing env param: REQUEST_METHOD'); | ||||
32 | } | ||||
33 | 100001 | 1.12s | 100001 | 457ms | unless ($env->{REQUEST_METHOD} =~ /^[A-Z]+$/) { # spent 457ms making 100001 calls to Plack::Middleware::Lint::CORE:match, avg 5µs/call |
34 | die("Invalid env param: REQUEST_METHOD($env->{REQUEST_METHOD})"); | ||||
35 | } | ||||
36 | 100001 | 130ms | unless (defined($env->{SCRIPT_NAME})) { # allows empty string | ||
37 | die('Missing mandatory env param: SCRIPT_NAME'); | ||||
38 | } | ||||
39 | 100001 | 139ms | if ($env->{SCRIPT_NAME} eq '/') { | ||
40 | die('SCRIPT_NAME must not be /'); | ||||
41 | } | ||||
42 | 100001 | 93.7ms | unless (defined($env->{PATH_INFO})) { # allows empty string | ||
43 | die('Missing mandatory env param: PATH_INFO'); | ||||
44 | } | ||||
45 | 100001 | 868ms | 100001 | 201ms | if ($env->{PATH_INFO} ne '' && $env->{PATH_INFO} !~ m!^/!) { # spent 201ms making 100001 calls to Plack::Middleware::Lint::CORE:match, avg 2µs/call |
46 | die('PATH_INFO must begin with / ($env->{PATH_INFO})'); | ||||
47 | } | ||||
48 | 100001 | 121ms | unless (defined($env->{SERVER_NAME})) { | ||
49 | die('Missing mandatory env param: SERVER_NAME'); | ||||
50 | } | ||||
51 | 100001 | 182ms | if ($env->{SERVER_NAME} eq '') { | ||
52 | die('SERVER_NAME must not be empty string'); | ||||
53 | } | ||||
54 | 100001 | 92.9ms | unless (defined($env->{SERVER_PORT})) { | ||
55 | die('Missing mandatory env param: SERVER_PORT'); | ||||
56 | } | ||||
57 | 100001 | 109ms | if ($env->{SERVER_PORT} eq '') { | ||
58 | die('SERVER_PORT must not be empty string'); | ||||
59 | } | ||||
60 | 100001 | 812ms | 100001 | 161ms | if (defined($env->{SERVER_PROTOCOL}) and $env->{SERVER_PROTOCOL} !~ m{^HTTP/\d}) { # spent 161ms making 100001 calls to Plack::Middleware::Lint::CORE:match, avg 2µs/call |
61 | die("Invalid SERVER_PROTOCOL: $env->{SERVER_PROTOCOL}"); | ||||
62 | } | ||||
63 | 100001 | 194ms | for my $param (qw/version url_scheme input errors multithread multiprocess/) { | ||
64 | 600006 | 584ms | unless (exists $env->{"psgi.$param"}) { | ||
65 | die("Missing psgi.$param"); | ||||
66 | } | ||||
67 | } | ||||
68 | 100001 | 176ms | unless (ref($env->{'psgi.version'}) eq 'ARRAY') { | ||
69 | die("psgi.version should be ArrayRef: $env->{'psgi.version'}"); | ||||
70 | } | ||||
71 | 100001 | 137ms | unless (scalar(@{$env->{'psgi.version'}}) == 2) { | ||
72 | die('psgi.version should contain 2 elements, not ', scalar(@{$env->{'psgi.version'}})); | ||||
73 | } | ||||
74 | 100001 | 929ms | 100001 | 198ms | unless ($env->{'psgi.url_scheme'} =~ /^https?$/) { # spent 198ms making 100001 calls to Plack::Middleware::Lint::CORE:match, avg 2µs/call |
75 | die("psgi.url_scheme should be 'http' or 'https': ", $env->{'psgi.url_scheme'}); | ||||
76 | } | ||||
77 | 100001 | 237ms | if ($env->{"psgi.version"}->[1] == 1) { # 1.1 | ||
78 | 100001 | 121ms | for my $param (qw(streaming nonblocking run_once)) { | ||
79 | 300003 | 302ms | unless (exists $env->{"psgi.$param"}) { | ||
80 | die("Missing psgi.$param"); | ||||
81 | } | ||||
82 | } | ||||
83 | } | ||||
84 | 100001 | 91.4ms | if ($env->{HTTP_CONTENT_TYPE}) { | ||
85 | die('HTTP_CONTENT_TYPE should not exist'); | ||||
86 | } | ||||
87 | 100001 | 633ms | if ($env->{HTTP_CONTENT_LENGTH}) { | ||
88 | die('HTTP_CONTENT_LENGTH should not exist'); | ||||
89 | } | ||||
90 | } | ||||
91 | |||||
92 | sub is_possibly_fh { | ||||
93 | my $fh = shift; | ||||
94 | |||||
95 | ref $fh eq 'GLOB' && | ||||
96 | *{$fh}{IO} && | ||||
97 | *{$fh}{IO}->can('getline'); | ||||
98 | } | ||||
99 | |||||
100 | # spent 8.05s (6.04+2.01) within Plack::Middleware::Lint::validate_res which was called 100001 times, avg 80µs/call:
# 100001 times (6.04s+2.01s) by Plack::Middleware::Lint::call at line 25, avg 80µs/call | ||||
101 | 100001 | 72.7ms | my ($self, $res, $streaming) = @_; | ||
102 | |||||
103 | 100001 | 84.4ms | unless (ref($res) eq 'ARRAY' or ref($res) eq 'CODE') { | ||
104 | die("Response should be array ref or code ref: $res"); | ||||
105 | } | ||||
106 | |||||
107 | 100001 | 63.0ms | if (ref $res eq 'CODE') { | ||
108 | return $self->response_cb($res, sub { $self->validate_res(@_, 1) }); | ||||
109 | } | ||||
110 | |||||
111 | 100001 | 60.2ms | unless (@$res == 3 || ($streaming && @$res == 2)) { | ||
112 | die('Response needs to be 3 element array, or 2 element in streaming'); | ||||
113 | } | ||||
114 | |||||
115 | 100001 | 810ms | 100001 | 255ms | unless ($res->[0] =~ /^\d+$/ && $res->[0] >= 100) { # spent 255ms making 100001 calls to Plack::Middleware::Lint::CORE:match, avg 3µs/call |
116 | die("Status code needs to be an integer greater than or equal to 100: $res->[0]"); | ||||
117 | } | ||||
118 | |||||
119 | 100001 | 93.9ms | unless (ref $res->[1] eq 'ARRAY') { | ||
120 | die("Headers needs to be an array ref: $res->[1]"); | ||||
121 | } | ||||
122 | |||||
123 | 100001 | 213ms | my @copy = @{$res->[1]}; | ||
124 | 100001 | 103ms | unless (@copy % 2 == 0) { | ||
125 | die('The number of response headers needs to be even, not odd(', scalar(@copy), ')'); | ||||
126 | } | ||||
127 | |||||
128 | 100001 | 501ms | while(my($key, $val) = splice(@copy, 0, 2)) { | ||
129 | 300003 | 161ms | if (lc $key eq 'status') { | ||
130 | die('Response headers MUST NOT contain a key named Status'); | ||||
131 | } | ||||
132 | 300003 | 1.76s | 300003 | 716ms | if ($key =~ /[:\r\n]|[-_]$/) { # spent 716ms making 300003 calls to Plack::Middleware::Lint::CORE:match, avg 2µs/call |
133 | die("Response headers MUST NOT contain a key with : or newlines, or that end in - or _: $key"); | ||||
134 | } | ||||
135 | 300003 | 1.22s | 300003 | 203ms | unless ($key =~ /^[a-zA-Z][0-9a-zA-Z\-_]*$/) { # spent 203ms making 300003 calls to Plack::Middleware::Lint::CORE:match, avg 678ns/call |
136 | die("Response headers MUST consist only of letters, digits, _ or - and MUST start with a letter: $key"); | ||||
137 | } | ||||
138 | 300003 | 1.07s | 300003 | 109ms | if ($val =~ /[\000-\037]/) { # spent 109ms making 300003 calls to Plack::Middleware::Lint::CORE:match, avg 363ns/call |
139 | die("Response headers MUST NOT contain characters below octal \037: $val"); | ||||
140 | } | ||||
141 | 300003 | 98.4ms | if (!defined $val) { | ||
142 | die("Response headers MUST be a defined string"); | ||||
143 | } | ||||
144 | } | ||||
145 | |||||
146 | # @$res == 2 is only right in psgi.streaming, and it's already checked. | ||||
147 | 100001 | 126ms | unless (@$res == 2 || | ||
148 | ref $res->[2] eq 'ARRAY' || | ||||
149 | Plack::Util::is_real_fh($res->[2]) || | ||||
150 | is_possibly_fh($res->[2]) || | ||||
151 | (blessed($res->[2]) && $res->[2]->can('getline'))) { | ||||
152 | die("Body should be an array ref or filehandle: $res->[2]"); | ||||
153 | } | ||||
154 | |||||
155 | 100001 | 390ms | 100001 | 727ms | if (ref $res->[2] eq 'ARRAY' && grep _has_wide_char($_), @{$res->[2]}) { # spent 727ms making 100001 calls to Plack::Middleware::Lint::_has_wide_char, avg 7µs/call |
156 | die("Body must be bytes and should not contain wide characters (UTF-8 strings)"); | ||||
157 | } | ||||
158 | |||||
159 | 100001 | 464ms | return $res; | ||
160 | } | ||||
161 | |||||
162 | # NOTE: Some modules like HTML:: or XML:: could possibly generate | ||||
163 | # ASCII/Latin-1 strings with utf8 flags on. They're actually safe to | ||||
164 | # print, so there's no need to give warnings about it. | ||||
165 | # spent 727ms (591+136) within Plack::Middleware::Lint::_has_wide_char which was called 100001 times, avg 7µs/call:
# 100001 times (591ms+136ms) by Plack::Middleware::Lint::validate_res at line 155, avg 7µs/call | ||||
166 | 100001 | 68.8ms | my $str = shift; | ||
167 | 100001 | 936ms | 100001 | 136ms | utf8::is_utf8($str) && $str =~ /[^\x00-\xff]/; # spent 136ms making 100001 calls to utf8::is_utf8, avg 1µs/call |
168 | } | ||||
169 | |||||
170 | 1 | 2µs | 1; | ||
171 | __END__ | ||||
# spent 2.30s within Plack::Middleware::Lint::CORE:match which was called 1400014 times, avg 2µs/call:
# 300003 times (716ms+0s) by Plack::Middleware::Lint::validate_res at line 132, avg 2µs/call
# 300003 times (203ms+0s) by Plack::Middleware::Lint::validate_res at line 135, avg 678ns/call
# 300003 times (109ms+0s) by Plack::Middleware::Lint::validate_res at line 138, avg 363ns/call
# 100001 times (457ms+0s) by Plack::Middleware::Lint::validate_env at line 33, avg 5µs/call
# 100001 times (255ms+0s) by Plack::Middleware::Lint::validate_res at line 115, avg 3µs/call
# 100001 times (201ms+0s) by Plack::Middleware::Lint::validate_env at line 45, avg 2µs/call
# 100001 times (198ms+0s) by Plack::Middleware::Lint::validate_env at line 74, avg 2µs/call
# 100001 times (161ms+0s) by Plack::Middleware::Lint::validate_env at line 60, avg 2µs/call |