Filename | /usr/local/share/perl/5.18.2/HTTP/Headers/Util.pm |
Statements | Executed 1100020 statements in 3.35s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
100001 | 1 | 1 | 2.73s | 3.14s | _split_header_words | HTTP::Headers::Util::
300003 | 2 | 1 | 417ms | 417ms | CORE:subst (opcode) | HTTP::Headers::Util::
1 | 1 | 1 | 14µs | 33µs | BEGIN@3 | HTTP::Headers::Util::
1 | 1 | 1 | 10µs | 96µs | BEGIN@8 | HTTP::Headers::Util::
1 | 1 | 1 | 9µs | 18µs | BEGIN@4 | HTTP::Headers::Util::
0 | 0 | 0 | 0s | 0s | join_header_words | HTTP::Headers::Util::
0 | 0 | 0 | 0s | 0s | split_header_words | HTTP::Headers::Util::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package HTTP::Headers::Util; | ||||
2 | |||||
3 | 2 | 28µs | 2 | 52µs | # spent 33µs (14+19) within HTTP::Headers::Util::BEGIN@3 which was called:
# once (14µs+19µs) by HTTP::Headers::ActionPack::Util::BEGIN@15 at line 3 # spent 33µs making 1 call to HTTP::Headers::Util::BEGIN@3
# spent 19µs making 1 call to strict::import |
4 | 2 | 41µs | 2 | 27µs | # spent 18µs (9+9) within HTTP::Headers::Util::BEGIN@4 which was called:
# once (9µs+9µs) by HTTP::Headers::ActionPack::Util::BEGIN@15 at line 4 # spent 18µs making 1 call to HTTP::Headers::Util::BEGIN@4
# spent 9µs making 1 call to warnings::import |
5 | |||||
6 | 1 | 500ns | our $VERSION = "6.11"; | ||
7 | |||||
8 | 2 | 602µs | 2 | 183µs | # spent 96µs (10+86) within HTTP::Headers::Util::BEGIN@8 which was called:
# once (10µs+86µs) by HTTP::Headers::ActionPack::Util::BEGIN@15 at line 8 # spent 96µs making 1 call to HTTP::Headers::Util::BEGIN@8
# spent 86µs making 1 call to base::import |
9 | |||||
10 | 1 | 1µs | our @EXPORT_OK=qw(split_header_words _split_header_words join_header_words); | ||
11 | |||||
12 | |||||
13 | sub split_header_words { | ||||
14 | my @res = &_split_header_words; | ||||
15 | for my $arr (@res) { | ||||
16 | for (my $i = @$arr - 2; $i >= 0; $i -= 2) { | ||||
17 | $arr->[$i] = lc($arr->[$i]); | ||||
18 | } | ||||
19 | } | ||||
20 | return @res; | ||||
21 | } | ||||
22 | |||||
23 | sub _split_header_words | ||||
24 | # spent 3.14s (2.73+417ms) within HTTP::Headers::Util::_split_header_words which was called 100001 times, avg 31µs/call:
# 100001 times (2.73s+417ms) by HTTP::Headers::ActionPack::Util::split_header_words at line 33 of HTTP/Headers/ActionPack/Util.pm, avg 31µs/call | ||||
25 | 100001 | 111ms | my(@val) = @_; | ||
26 | 100001 | 56.6ms | my @res; | ||
27 | 100001 | 134ms | for (@val) { | ||
28 | 100001 | 26.4ms | my @cur; | ||
29 | 100001 | 107ms | while (length) { | ||
30 | 100001 | 880ms | 100001 | 321ms | if (s/^\s*(=*[^\s=;,]+)//) { # 'token' or parameter 'attribute' # spent 321ms making 100001 calls to HTTP::Headers::Util::CORE:subst, avg 3µs/call |
31 | 100001 | 424ms | push(@cur, $1); | ||
32 | # a quoted value | ||||
33 | 100001 | 843ms | 200002 | 95.5ms | if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) { # spent 95.5ms making 200002 calls to HTTP::Headers::Util::CORE:subst, avg 478ns/call |
34 | my $val = $1; | ||||
35 | $val =~ s/\\(.)/$1/g; | ||||
36 | push(@cur, $val); | ||||
37 | # some unquoted value | ||||
38 | } | ||||
39 | elsif (s/^\s*=\s*([^;,\s]*)//) { | ||||
40 | my $val = $1; | ||||
41 | $val =~ s/\s+$//; | ||||
42 | push(@cur, $val); | ||||
43 | # no value, a lone token | ||||
44 | } | ||||
45 | else { | ||||
46 | 100001 | 57.8ms | push(@cur, undef); | ||
47 | } | ||||
48 | } | ||||
49 | elsif (s/^\s*,//) { | ||||
50 | push(@res, [@cur]) if @cur; | ||||
51 | @cur = (); | ||||
52 | } | ||||
53 | elsif (s/^\s*;// || s/^\s+//) { | ||||
54 | # continue | ||||
55 | } | ||||
56 | else { | ||||
57 | die "This should not happen: '$_'"; | ||||
58 | } | ||||
59 | } | ||||
60 | 100001 | 183ms | push(@res, \@cur) if @cur; | ||
61 | } | ||||
62 | 100001 | 529ms | @res; | ||
63 | } | ||||
64 | |||||
65 | |||||
66 | sub join_header_words | ||||
67 | { | ||||
68 | @_ = ([@_]) if @_ && !ref($_[0]); | ||||
69 | my @res; | ||||
70 | for (@_) { | ||||
71 | my @cur = @$_; | ||||
72 | my @attr; | ||||
73 | while (@cur) { | ||||
74 | my $k = shift @cur; | ||||
75 | my $v = shift @cur; | ||||
76 | if (defined $v) { | ||||
77 | if ($v =~ /[\x00-\x20()<>@,;:\\\"\/\[\]?={}\x7F-\xFF]/ || !length($v)) { | ||||
78 | $v =~ s/([\"\\])/\\$1/g; # escape " and \ | ||||
79 | $k .= qq(="$v"); | ||||
80 | } | ||||
81 | else { | ||||
82 | # token | ||||
83 | $k .= "=$v"; | ||||
84 | } | ||||
85 | } | ||||
86 | push(@attr, $k); | ||||
87 | } | ||||
88 | push(@res, join("; ", @attr)) if @attr; | ||||
89 | } | ||||
90 | join(", ", @res); | ||||
91 | } | ||||
92 | |||||
93 | |||||
94 | 1 | 4µs | 1; | ||
95 | |||||
96 | __END__ | ||||
sub HTTP::Headers::Util::CORE:subst; # opcode |