| 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 | Plack::Middleware::Lint::validate_res |
| 100001 | 1 | 1 | 5.93s | 6.95s | Plack::Middleware::Lint::validate_env |
| 100001 | 1 | 1 | 2.99s | 894s | Plack::Middleware::Lint::call |
| 1400014 | 8 | 1 | 2.30s | 2.30s | Plack::Middleware::Lint::CORE:match (opcode) |
| 100001 | 1 | 1 | 591ms | 727ms | Plack::Middleware::Lint::_has_wide_char |
| 1 | 1 | 1 | 33µs | 50µs | Plack::Middleware::Lint::BEGIN@2 |
| 1 | 1 | 1 | 10µs | 54µs | Plack::Middleware::Lint::wrap |
| 1 | 1 | 1 | 10µs | 23µs | Plack::Middleware::Lint::BEGIN@3 |
| 1 | 1 | 1 | 9µs | 31µs | Plack::Middleware::Lint::BEGIN@5 |
| 1 | 1 | 1 | 7µs | 42µs | Plack::Middleware::Lint::BEGIN@6 |
| 1 | 1 | 1 | 6µs | 6µs | Plack::Middleware::Lint::BEGIN@7 |
| 1 | 1 | 1 | 3µs | 3µs | Plack::Middleware::Lint::BEGIN@4 |
| 0 | 0 | 0 | 0s | 0s | Plack::Middleware::Lint::__ANON__[:108] |
| 0 | 0 | 0 | 0s | 0s | Plack::Middleware::Lint::is_possibly_fh |
| 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 |