Filename | /usr/share/perl/5.14/CGI/Util.pm |
Statements | Executed 3921 statements in 18.8ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
104 | 8 | 8 | 4.77ms | 8.61ms | make_attributes | CGI::Util::
123 | 1 | 1 | 3.26ms | 3.38ms | _rearrange_params | CGI::Util::
126 | 1 | 1 | 2.84ms | 3.58ms | simple_escape | CGI::Util::
123 | 8 | 5 | 2.46ms | 6.00ms | rearrange | CGI::Util::
1 | 1 | 1 | 1.50ms | 2.25ms | BEGIN@12 | CGI::Util::
692 | 9 | 1 | 1.18ms | 1.18ms | CORE:subst (opcode) | CGI::Util::
9 | 2 | 1 | 315µs | 379µs | unescape | CGI::Util::
6 | 2 | 1 | 152µs | 186µs | escape | CGI::Util::
8 | 1 | 1 | 28µs | 28µs | CORE:substcont (opcode) | CGI::Util::
1 | 1 | 1 | 28µs | 35µs | BEGIN@3 | CGI::Util::
1 | 1 | 1 | 19µs | 52µs | BEGIN@251 | utf8::
1 | 1 | 1 | 15µs | 179µs | BEGIN@4 | CGI::Util::
0 | 0 | 0 | 0s | 0s | ascii2ebcdic | CGI::Util::
0 | 0 | 0 | 0s | 0s | ebcdic2ascii | CGI::Util::
0 | 0 | 0 | 0s | 0s | expire_calc | CGI::Util::
0 | 0 | 0 | 0s | 0s | expires | CGI::Util::
0 | 0 | 0 | 0s | 0s | rearrange_header | CGI::Util::
0 | 0 | 0 | 0s | 0s | utf8_chr | CGI::Util::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package CGI::Util; | ||||
2 | |||||
3 | 2 | 48µs | 2 | 42µs | # spent 35µs (28+7) within CGI::Util::BEGIN@3 which was called:
# once (28µs+7µs) by CGI::BEGIN@28 at line 3 # spent 35µs making 1 call to CGI::Util::BEGIN@3
# spent 7µs making 1 call to strict::import |
4 | 2 | 107µs | 2 | 344µs | # spent 179µs (15+164) within CGI::Util::BEGIN@4 which was called:
# once (15µs+164µs) by CGI::BEGIN@28 at line 4 # spent 179µs making 1 call to CGI::Util::BEGIN@4
# spent 164µs making 1 call to vars::import |
5 | 1 | 2µs | require Exporter; | ||
6 | 1 | 11µs | @ISA = qw(Exporter); | ||
7 | 1 | 3µs | @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape | ||
8 | expires ebcdic2ascii ascii2ebcdic); | ||||
9 | |||||
10 | 1 | 2µs | $VERSION = '3.51'; | ||
11 | |||||
12 | 2 | 2.29ms | 2 | 2.37ms | # spent 2.25ms (1.50+753µs) within CGI::Util::BEGIN@12 which was called:
# once (1.50ms+753µs) by CGI::BEGIN@28 at line 12 # spent 2.25ms making 1 call to CGI::Util::BEGIN@12
# spent 112µs making 1 call to constant::import |
13 | |||||
14 | # (ord('^') == 95) for codepage 1047 as on os390, vmesa | ||||
15 | 1 | 34µs | @A2E = ( | ||
16 | 0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15, | ||||
17 | 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31, | ||||
18 | 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97, | ||||
19 | 240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111, | ||||
20 | 124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214, | ||||
21 | 215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109, | ||||
22 | 121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150, | ||||
23 | 151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161, 7, | ||||
24 | 32, 33, 34, 35, 36, 37, 6, 23, 40, 41, 42, 43, 44, 9, 10, 27, | ||||
25 | 48, 49, 26, 51, 52, 53, 54, 8, 56, 57, 58, 59, 4, 20, 62,255, | ||||
26 | 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188, | ||||
27 | 144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171, | ||||
28 | 100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119, | ||||
29 | 172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89, | ||||
30 | 68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87, | ||||
31 | 140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223 | ||||
32 | ); | ||||
33 | 1 | 27µs | @E2A = ( | ||
34 | 0, 1, 2, 3,156, 9,134,127,151,141,142, 11, 12, 13, 14, 15, | ||||
35 | 16, 17, 18, 19,157, 10, 8,135, 24, 25,146,143, 28, 29, 30, 31, | ||||
36 | 128,129,130,131,132,133, 23, 27,136,137,138,139,140, 5, 6, 7, | ||||
37 | 144,145, 22,147,148,149,150, 4,152,153,154,155, 20, 21,158, 26, | ||||
38 | 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124, | ||||
39 | 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94, | ||||
40 | 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63, | ||||
41 | 248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34, | ||||
42 | 216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177, | ||||
43 | 176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164, | ||||
44 | 181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174, | ||||
45 | 172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215, | ||||
46 | 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245, | ||||
47 | 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255, | ||||
48 | 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213, | ||||
49 | 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159 | ||||
50 | ); | ||||
51 | |||||
52 | if (EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set | ||||
53 | $A2E[91] = 187; $A2E[92] = 188; $A2E[94] = 106; $A2E[96] = 74; | ||||
54 | $A2E[123] = 251; $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95; | ||||
55 | $A2E[162] = 176; $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186; | ||||
56 | $A2E[175] = 161; $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173; | ||||
57 | $A2E[249] = 192; | ||||
58 | |||||
59 | $E2A[74] = 96; $E2A[95] = 159; $E2A[106] = 94; $E2A[121] = 168; | ||||
60 | $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172; | ||||
61 | $E2A[187] = 91; $E2A[188] = 92; $E2A[192] = 249; $E2A[208] = 166; | ||||
62 | $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125; | ||||
63 | $E2A[255] = 126; | ||||
64 | } | ||||
65 | elsif (EBCDIC && ord('^') == 176) { # as in codepage 037 on os400 | ||||
66 | $A2E[10] = 37; $A2E[91] = 186; $A2E[93] = 187; $A2E[94] = 176; | ||||
67 | $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173; | ||||
68 | |||||
69 | $E2A[21] = 133; $E2A[37] = 10; $E2A[95] = 172; $E2A[173] = 221; | ||||
70 | $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168; | ||||
71 | } | ||||
72 | |||||
73 | # Smart rearrangement of parameters to allow named parameter | ||||
74 | # calling. We do the rearrangement if: | ||||
75 | # the first parameter begins with a - | ||||
76 | |||||
77 | # spent 6.00ms (2.46+3.55) within CGI::Util::rearrange which was called 123 times, avg 49µs/call:
# 88 times (1.70ms+1.10ms) by Foswiki::Request::param at line 410 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Request.pm, avg 32µs/call
# 17 times (341µs+218µs) by Foswiki::Request::header at line 549 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Request.pm, avg 33µs/call
# 6 times (134µs+698µs) by CGI::hidden at line 7 of (eval 196)[CGI.pm:896], avg 139µs/call
# 5 times (118µs+869µs) by CGI::Cookie::new at line 120 of CGI/Cookie.pm, avg 197µs/call
# 3 times (55µs+310µs) by Foswiki::Request::url at line 241 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Request.pm, avg 122µs/call
# 2 times (46µs+31µs) by CGI::delete at line 6 of (eval 170)[CGI.pm:896], avg 39µs/call
# once (38µs+296µs) by CGI::start_form at line 4 of (eval 199)[CGI.pm:896]
# once (28µs+19µs) by Foswiki::Request::cookie at line 445 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Request.pm | ||||
78 | 123 | 284µs | my ($order,@param) = @_; | ||
79 | 123 | 704µs | 123 | 3.38ms | my ($result, $leftover) = _rearrange_params( $order, @param ); # spent 3.38ms making 123 calls to CGI::Util::_rearrange_params, avg 28µs/call |
80 | 123 | 313µs | 1 | 161µs | push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 ) # spent 161µs making 1 call to CGI::Util::make_attributes |
81 | if keys %$leftover; | ||||
82 | 123 | 1.04ms | @$result; | ||
83 | } | ||||
84 | |||||
85 | sub rearrange_header { | ||||
86 | my ($order,@param) = @_; | ||||
87 | |||||
88 | my ($result,$leftover) = _rearrange_params( $order, @param ); | ||||
89 | push @$result, make_attributes( $leftover, 0, 1 ) if keys %$leftover; | ||||
90 | |||||
91 | @$result; | ||||
92 | } | ||||
93 | |||||
94 | # spent 3.38ms (3.26+123µs) within CGI::Util::_rearrange_params which was called 123 times, avg 28µs/call:
# 123 times (3.26ms+123µs) by CGI::Util::rearrange at line 79, avg 28µs/call | ||||
95 | 123 | 286µs | my($order,@param) = @_; | ||
96 | 123 | 243µs | return [] unless @param; | ||
97 | |||||
98 | 114 | 228µs | if (ref($param[0]) eq 'HASH') { | ||
99 | @param = %{$param[0]}; | ||||
100 | } else { | ||||
101 | return \@param | ||||
102 | 114 | 1.05ms | unless (defined($param[0]) && substr($param[0],0,1) eq '-'); | ||
103 | } | ||||
104 | |||||
105 | # map parameters into positional indices | ||||
106 | 14 | 21µs | my ($i,%pos); | ||
107 | 14 | 20µs | $i = 0; | ||
108 | 14 | 48µs | foreach (@$order) { | ||
109 | 173 | 635µs | foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; } | ||
110 | 73 | 186µs | $i++; | ||
111 | } | ||||
112 | |||||
113 | 14 | 23µs | my (@result,%leftover); | ||
114 | 14 | 60µs | $#result = $#$order; # preextend | ||
115 | 14 | 41µs | while (@param) { | ||
116 | 38 | 102µs | my $key = lc(shift(@param)); | ||
117 | 38 | 326µs | 38 | 123µs | $key =~ s/^\-//; # spent 123µs making 38 calls to CGI::Util::CORE:subst, avg 3µs/call |
118 | 38 | 187µs | if (exists $pos{$key}) { | ||
119 | 36 | 92µs | $result[$pos{$key}] = shift(@param); | ||
120 | } else { | ||||
121 | 2 | 8µs | $leftover{$key} = shift(@param); | ||
122 | } | ||||
123 | } | ||||
124 | |||||
125 | 14 | 120µs | return \@result, \%leftover; | ||
126 | } | ||||
127 | |||||
128 | # spent 8.61ms (4.77+3.84) within CGI::Util::make_attributes which was called 104 times, avg 83µs/call:
# 59 times (2.47ms+1.77ms) by CGI::a at line 6 of (eval 169)[CGI.pm:896], avg 72µs/call
# 11 times (436µs+312µs) by CGI::td at line 6 of (eval 190)[CGI.pm:896], avg 68µs/call
# 11 times (432µs+312µs) by CGI::th at line 6 of (eval 188)[CGI.pm:896], avg 68µs/call
# 9 times (444µs+298µs) by CGI::span at line 6 of (eval 178)[CGI.pm:896], avg 82µs/call
# 8 times (313µs+229µs) by CGI::Tr at line 6 of (eval 189)[CGI.pm:896], avg 68µs/call
# 3 times (412µs+527µs) by CGI::img at line 6 of (eval 186)[CGI.pm:896], avg 313µs/call
# 2 times (188µs+313µs) by CGI::start_table at line 6 of (eval 187)[CGI.pm:896], avg 250µs/call
# once (81µs+80µs) by CGI::Util::rearrange at line 80 | ||||
129 | 104 | 156µs | my $attr = shift; | ||
130 | 104 | 189µs | return () unless $attr && ref($attr) && ref($attr) eq 'HASH'; | ||
131 | 104 | 143µs | my $escape = shift || 0; | ||
132 | 104 | 141µs | my $do_not_quote = shift; | ||
133 | |||||
134 | 104 | 161µs | my $quote = $do_not_quote ? '' : '"'; | ||
135 | |||||
136 | 104 | 132µs | my(@att); | ||
137 | 208 | 770µs | foreach (keys %{$attr}) { | ||
138 | 126 | 199µs | my($key) = $_; | ||
139 | 126 | 875µs | 126 | 261µs | $key=~s/^\-//; # get rid of initial - if present # spent 261µs making 126 calls to CGI::Util::CORE:subst, avg 2µs/call |
140 | |||||
141 | # old way: breaks EBCDIC! | ||||
142 | # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes | ||||
143 | |||||
144 | 126 | 267µs | ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes | ||
145 | |||||
146 | 126 | 720µs | 126 | 3.58ms | my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_}; # spent 3.58ms making 126 calls to CGI::Util::simple_escape, avg 28µs/call |
147 | 126 | 656µs | push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/); | ||
148 | } | ||||
149 | 104 | 610µs | return @att; | ||
150 | } | ||||
151 | |||||
152 | # spent 3.58ms (2.84+737µs) within CGI::Util::simple_escape which was called 126 times, avg 28µs/call:
# 126 times (2.84ms+737µs) by CGI::Util::make_attributes at line 146, avg 28µs/call | ||||
153 | 126 | 218µs | return unless defined(my $toencode = shift); | ||
154 | 126 | 745µs | 126 | 213µs | $toencode =~ s{&}{&}gso; # spent 213µs making 126 calls to CGI::Util::CORE:subst, avg 2µs/call |
155 | 126 | 780µs | 126 | 176µs | $toencode =~ s{<}{<}gso; # spent 176µs making 126 calls to CGI::Util::CORE:subst, avg 1µs/call |
156 | 126 | 634µs | 126 | 170µs | $toencode =~ s{>}{>}gso; # spent 170µs making 126 calls to CGI::Util::CORE:subst, avg 1µs/call |
157 | 126 | 646µs | 126 | 179µs | $toencode =~ s{\"}{"}gso; # spent 179µs making 126 calls to CGI::Util::CORE:subst, avg 1µs/call |
158 | # Doesn't work. Can't work. forget it. | ||||
159 | # $toencode =~ s{\x8b}{‹}gso; | ||||
160 | # $toencode =~ s{\x9b}{›}gso; | ||||
161 | 126 | 658µs | $toencode; | ||
162 | } | ||||
163 | |||||
164 | sub utf8_chr { | ||||
165 | my $c = shift(@_); | ||||
166 | if ($] >= 5.006){ | ||||
167 | require utf8; | ||||
168 | my $u = chr($c); | ||||
169 | utf8::encode($u); # drop utf8 flag | ||||
170 | return $u; | ||||
171 | } | ||||
172 | if ($c < 0x80) { | ||||
173 | return sprintf("%c", $c); | ||||
174 | } elsif ($c < 0x800) { | ||||
175 | return sprintf("%c%c", 0xc0 | ($c >> 6), 0x80 | ($c & 0x3f)); | ||||
176 | } elsif ($c < 0x10000) { | ||||
177 | return sprintf("%c%c%c", | ||||
178 | 0xe0 | ($c >> 12), | ||||
179 | 0x80 | (($c >> 6) & 0x3f), | ||||
180 | 0x80 | ( $c & 0x3f)); | ||||
181 | } elsif ($c < 0x200000) { | ||||
182 | return sprintf("%c%c%c%c", | ||||
183 | 0xf0 | ($c >> 18), | ||||
184 | 0x80 | (($c >> 12) & 0x3f), | ||||
185 | 0x80 | (($c >> 6) & 0x3f), | ||||
186 | 0x80 | ( $c & 0x3f)); | ||||
187 | } elsif ($c < 0x4000000) { | ||||
188 | return sprintf("%c%c%c%c%c", | ||||
189 | 0xf8 | ($c >> 24), | ||||
190 | 0x80 | (($c >> 18) & 0x3f), | ||||
191 | 0x80 | (($c >> 12) & 0x3f), | ||||
192 | 0x80 | (($c >> 6) & 0x3f), | ||||
193 | 0x80 | ( $c & 0x3f)); | ||||
194 | |||||
195 | } elsif ($c < 0x80000000) { | ||||
196 | return sprintf("%c%c%c%c%c%c", | ||||
197 | 0xfc | ($c >> 30), | ||||
198 | 0x80 | (($c >> 24) & 0x3f), | ||||
199 | 0x80 | (($c >> 18) & 0x3f), | ||||
200 | 0x80 | (($c >> 12) & 0x3f), | ||||
201 | 0x80 | (($c >> 6) & 0x3f), | ||||
202 | 0x80 | ( $c & 0x3f)); | ||||
203 | } else { | ||||
204 | return utf8_chr(0xfffd); | ||||
205 | } | ||||
206 | } | ||||
207 | |||||
208 | # unescape URL-encoded data | ||||
209 | # spent 379µs (315+64) within CGI::Util::unescape which was called 9 times, avg 42µs/call:
# 6 times (242µs+54µs) by CGI::Cookie::parse at line 103 of CGI/Cookie.pm, avg 49µs/call
# 3 times (73µs+10µs) by CGI::Cookie::parse at line 106 of CGI/Cookie.pm, avg 28µs/call | ||||
210 | 9 | 20µs | shift() if @_ > 0 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass)); | ||
211 | 9 | 18µs | my $todecode = shift; | ||
212 | 9 | 22µs | return undef unless defined($todecode); | ||
213 | 9 | 22µs | $todecode =~ tr/+/ /; # pluses become spaces | ||
214 | 9 | 22µs | if (EBCDIC) { | ||
215 | $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge; | ||||
216 | } else { | ||||
217 | # handle surrogate pairs first -- dankogai. Ref: http://unicode.org/faq/utf_bom.html#utf16-2 | ||||
218 | 9 | 73µs | 9 | 16µs | $todecode =~ s{ # spent 16µs making 9 calls to CGI::Util::CORE:subst, avg 2µs/call |
219 | %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi | ||||
220 | %u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo | ||||
221 | }{ | ||||
222 | utf8_chr( | ||||
223 | 0x10000 | ||||
224 | + (hex($1) - 0xD800) * 0x400 | ||||
225 | + (hex($2) - 0xDC00) | ||||
226 | ) | ||||
227 | }gex; | ||||
228 | 9 | 135µs | 17 | 47µs | $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/ # spent 28µs making 8 calls to CGI::Util::CORE:substcont, avg 3µs/call
# spent 20µs making 9 calls to CGI::Util::CORE:subst, avg 2µs/call |
229 | 7 | 21µs | defined($1)? chr hex($1) : utf8_chr(hex($2))/ge; | ||
230 | } | ||||
231 | 9 | 58µs | return $todecode; | ||
232 | } | ||||
233 | |||||
234 | # URL-encode data | ||||
235 | # | ||||
236 | # We cannot use the %u escapes, they were rejected by W3C, so the official | ||||
237 | # way is %XX-escaped utf-8 encoding. | ||||
238 | # Naturally, Unicode strings have to be converted to their utf-8 byte | ||||
239 | # representation. (No action is required on 5.6.) | ||||
240 | # Byte strings were traditionally used directly as a sequence of octets. | ||||
241 | # This worked if they actually represented binary data (i.e. in CGI::Compress). | ||||
242 | # This also worked if these byte strings were actually utf-8 encoded; e.g., | ||||
243 | # when the source file used utf-8 without the apropriate "use utf8;". | ||||
244 | # This fails if the byte string is actually a Latin 1 encoded string, but it | ||||
245 | # was always so and cannot be fixed without breaking the binary data case. | ||||
246 | # -- Stepan Kasal <skasal@redhat.com> | ||||
247 | # | ||||
248 | 1 | 2µs | if ($] == 5.008) { | ||
249 | package utf8; | ||||
250 | |||||
251 | 2 | 889µs | 2 | 85µs | # spent 52µs (19+33) within utf8::BEGIN@251 which was called:
# once (19µs+33µs) by CGI::BEGIN@28 at line 251 # spent 52µs making 1 call to utf8::BEGIN@251
# spent 33µs making 1 call to warnings::unimport |
252 | |||||
253 | my $is_utf8_redefinition = <<'EOR'; | ||||
254 | sub is_utf8 { | ||||
255 | my ($text) = @_; | ||||
256 | |||||
257 | my $ctext = pack q{C0a*}, $text; | ||||
258 | |||||
259 | return ($text ne $ctext) && ($ctext =~ m/^( | ||||
260 | [\x09\x0A\x0D\x20-\x7E] | ||||
261 | | [\xC2-\xDF][\x80-\xBF] | ||||
262 | | \xE0[\xA0-\xBF][\x80-\xBF] | ||||
263 | | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} | ||||
264 | | \xED[\x80-\x9F][\x80-\xBF] | ||||
265 | | \xF0[\x90-\xBF][\x80-\xBF]{2} | ||||
266 | | [\xF1-\xF3][\x80-\xBF]{3} | ||||
267 | | \xF4[\x80-\x8F][\x80-\xBF]{2} | ||||
268 | )*$/xo); | ||||
269 | } | ||||
270 | EOR | ||||
271 | |||||
272 | eval $is_utf8_redefinition; | ||||
273 | } | ||||
274 | |||||
275 | # spent 186µs (152+34) within CGI::Util::escape which was called 6 times, avg 31µs/call:
# 3 times (89µs+20µs) by CGI::Cookie::as_string at line 151 of CGI/Cookie.pm, avg 36µs/call
# 3 times (63µs+14µs) by CGI::Cookie::as_string at line 152 of CGI/Cookie.pm, avg 26µs/call | ||||
276 | # If we being called in an OO-context, discard the first argument. | ||||
277 | 6 | 11µs | shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass)); | ||
278 | 6 | 12µs | my $toencode = shift; | ||
279 | 6 | 8µs | return undef unless defined($toencode); | ||
280 | 6 | 54µs | 6 | 14µs | utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode)); # spent 14µs making 6 calls to utf8::is_utf8, avg 2µs/call |
281 | 6 | 15µs | if (EBCDIC) { | ||
282 | $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg; | ||||
283 | } else { | ||||
284 | 6 | 51µs | 6 | 20µs | $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",ord($1))/eg; # spent 20µs making 6 calls to CGI::Util::CORE:subst, avg 3µs/call |
285 | } | ||||
286 | 6 | 37µs | return $toencode; | ||
287 | } | ||||
288 | |||||
289 | # This internal routine creates date strings suitable for use in | ||||
290 | # cookies and HTTP headers. (They differ, unfortunately.) | ||||
291 | # Thanks to Mark Fisher for this. | ||||
292 | sub expires { | ||||
293 | my($time,$format) = @_; | ||||
294 | $format ||= 'http'; | ||||
295 | |||||
296 | my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; | ||||
297 | my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/; | ||||
298 | |||||
299 | # pass through preformatted dates for the sake of expire_calc() | ||||
300 | $time = expire_calc($time); | ||||
301 | return $time unless $time =~ /^\d+$/; | ||||
302 | |||||
303 | # make HTTP/cookie date string from GMT'ed time | ||||
304 | # (cookies use '-' as date separator, HTTP uses ' ') | ||||
305 | my($sc) = ' '; | ||||
306 | $sc = '-' if $format eq "cookie"; | ||||
307 | my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time); | ||||
308 | $year += 1900; | ||||
309 | return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT", | ||||
310 | $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec); | ||||
311 | } | ||||
312 | |||||
313 | # This internal routine creates an expires time exactly some number of | ||||
314 | # hours from the current time. It incorporates modifications from | ||||
315 | # Mark Fisher. | ||||
316 | sub expire_calc { | ||||
317 | my($time) = @_; | ||||
318 | my(%mult) = ('s'=>1, | ||||
319 | 'm'=>60, | ||||
320 | 'h'=>60*60, | ||||
321 | 'd'=>60*60*24, | ||||
322 | 'M'=>60*60*24*30, | ||||
323 | 'y'=>60*60*24*365); | ||||
324 | # format for time can be in any of the forms... | ||||
325 | # "now" -- expire immediately | ||||
326 | # "+180s" -- in 180 seconds | ||||
327 | # "+2m" -- in 2 minutes | ||||
328 | # "+12h" -- in 12 hours | ||||
329 | # "+1d" -- in 1 day | ||||
330 | # "+3M" -- in 3 months | ||||
331 | # "+2y" -- in 2 years | ||||
332 | # "-3m" -- 3 minutes ago(!) | ||||
333 | # If you don't supply one of these forms, we assume you are | ||||
334 | # specifying the date yourself | ||||
335 | my($offset); | ||||
336 | if (!$time || (lc($time) eq 'now')) { | ||||
337 | $offset = 0; | ||||
338 | } elsif ($time=~/^\d+/) { | ||||
339 | return $time; | ||||
340 | } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([smhdMy])/) { | ||||
341 | $offset = ($mult{$2} || 1)*$1; | ||||
342 | } else { | ||||
343 | return $time; | ||||
344 | } | ||||
345 | my $cur_time = time; | ||||
346 | return ($cur_time+$offset); | ||||
347 | } | ||||
348 | |||||
349 | sub ebcdic2ascii { | ||||
350 | my $data = shift; | ||||
351 | $data =~ s/(.)/chr $E2A[ord($1)]/ge; | ||||
352 | $data; | ||||
353 | } | ||||
354 | |||||
355 | sub ascii2ebcdic { | ||||
356 | my $data = shift; | ||||
357 | $data =~ s/(.)/chr $A2E[ord($1)]/ge; | ||||
358 | $data; | ||||
359 | } | ||||
360 | |||||
361 | 1 | 62µs | 1; | ||
362 | |||||
363 | __END__ | ||||
# spent 1.18ms within CGI::Util::CORE:subst which was called 692 times, avg 2µs/call:
# 126 times (261µs+0s) by CGI::Util::make_attributes at line 139, avg 2µs/call
# 126 times (213µs+0s) by CGI::Util::simple_escape at line 154, avg 2µs/call
# 126 times (179µs+0s) by CGI::Util::simple_escape at line 157, avg 1µs/call
# 126 times (176µs+0s) by CGI::Util::simple_escape at line 155, avg 1µs/call
# 126 times (170µs+0s) by CGI::Util::simple_escape at line 156, avg 1µs/call
# 38 times (123µs+0s) by CGI::Util::_rearrange_params at line 117, avg 3µs/call
# 9 times (20µs+0s) by CGI::Util::unescape at line 228, avg 2µs/call
# 9 times (16µs+0s) by CGI::Util::unescape at line 218, avg 2µs/call
# 6 times (20µs+0s) by CGI::Util::escape at line 284, avg 3µs/call | |||||
# spent 28µs within CGI::Util::CORE:substcont which was called 8 times, avg 3µs/call:
# 8 times (28µs+0s) by CGI::Util::unescape at line 228, avg 3µs/call |