Filename | /usr/local/lib/perl5/site_perl/URI/_punycode.pm |
Statements | Executed 29 statements in 2.50ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 36µs | 45µs | BEGIN@3 | URI::_punycode::
1 | 1 | 1 | 22µs | 30µs | BEGIN@12 | URI::_punycode::
1 | 1 | 1 | 22µs | 175µs | BEGIN@16 | URI::_punycode::
1 | 1 | 1 | 21µs | 143µs | BEGIN@22 | URI::_punycode::
1 | 1 | 1 | 21µs | 49µs | BEGIN@9 | URI::_punycode::
1 | 1 | 1 | 20µs | 145µs | BEGIN@21 | URI::_punycode::
1 | 1 | 1 | 19µs | 149µs | BEGIN@18 | URI::_punycode::
1 | 1 | 1 | 19µs | 143µs | BEGIN@17 | URI::_punycode::
1 | 1 | 1 | 19µs | 40µs | BEGIN@4 | URI::_punycode::
1 | 1 | 1 | 18µs | 146µs | BEGIN@20 | URI::_punycode::
1 | 1 | 1 | 18µs | 139µs | BEGIN@19 | URI::_punycode::
1 | 1 | 1 | 9µs | 9µs | CORE:qr (opcode) | URI::_punycode::
0 | 0 | 0 | 0s | 0s | _croak | URI::_punycode::
0 | 0 | 0 | 0s | 0s | adapt | URI::_punycode::
0 | 0 | 0 | 0s | 0s | code_point | URI::_punycode::
0 | 0 | 0 | 0s | 0s | decode_punycode | URI::_punycode::
0 | 0 | 0 | 0s | 0s | digit_value | URI::_punycode::
0 | 0 | 0 | 0s | 0s | encode_punycode | URI::_punycode::
0 | 0 | 0 | 0s | 0s | min | URI::_punycode::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package URI::_punycode; | ||||
2 | |||||
3 | 2 | 56µs | 2 | 54µs | # spent 45µs (36+10) within URI::_punycode::BEGIN@3 which was called:
# once (36µs+10µs) by URI::_idna::BEGIN@9 at line 3 # spent 45µs making 1 call to URI::_punycode::BEGIN@3
# spent 10µs making 1 call to strict::import |
4 | 2 | 96µs | 2 | 62µs | # spent 40µs (19+21) within URI::_punycode::BEGIN@4 which was called:
# once (19µs+21µs) by URI::_idna::BEGIN@9 at line 4 # spent 40µs making 1 call to URI::_punycode::BEGIN@4
# spent 22µs making 1 call to warnings::import |
5 | |||||
6 | 1 | 2µs | our $VERSION = '1.72'; | ||
7 | 1 | 40µs | $VERSION = eval $VERSION; # spent 6µs executing statements in string eval | ||
8 | |||||
9 | 2 | 78µs | 2 | 77µs | # spent 49µs (21+28) within URI::_punycode::BEGIN@9 which was called:
# once (21µs+28µs) by URI::_idna::BEGIN@9 at line 9 # spent 49µs making 1 call to URI::_punycode::BEGIN@9
# spent 28µs making 1 call to Exporter::import |
10 | 1 | 4µs | our @EXPORT = qw(encode_punycode decode_punycode); | ||
11 | |||||
12 | 2 | 77µs | 2 | 37µs | # spent 30µs (22+7) within URI::_punycode::BEGIN@12 which was called:
# once (22µs+7µs) by URI::_idna::BEGIN@9 at line 12 # spent 30µs making 1 call to URI::_punycode::BEGIN@12
# spent 7µs making 1 call to integer::import |
13 | |||||
14 | 1 | 2µs | our $DEBUG = 0; | ||
15 | |||||
16 | 2 | 57µs | 2 | 328µs | # spent 175µs (22+153) within URI::_punycode::BEGIN@16 which was called:
# once (22µs+153µs) by URI::_idna::BEGIN@9 at line 16 # spent 175µs making 1 call to URI::_punycode::BEGIN@16
# spent 153µs making 1 call to constant::import |
17 | 2 | 57µs | 2 | 268µs | # spent 143µs (19+124) within URI::_punycode::BEGIN@17 which was called:
# once (19µs+124µs) by URI::_idna::BEGIN@9 at line 17 # spent 143µs making 1 call to URI::_punycode::BEGIN@17
# spent 124µs making 1 call to constant::import |
18 | 2 | 52µs | 2 | 280µs | # spent 149µs (19+130) within URI::_punycode::BEGIN@18 which was called:
# once (19µs+130µs) by URI::_idna::BEGIN@9 at line 18 # spent 149µs making 1 call to URI::_punycode::BEGIN@18
# spent 130µs making 1 call to constant::import |
19 | 2 | 52µs | 2 | 260µs | # spent 139µs (18+121) within URI::_punycode::BEGIN@19 which was called:
# once (18µs+121µs) by URI::_idna::BEGIN@9 at line 19 # spent 139µs making 1 call to URI::_punycode::BEGIN@19
# spent 121µs making 1 call to constant::import |
20 | 2 | 53µs | 2 | 275µs | # spent 146µs (18+128) within URI::_punycode::BEGIN@20 which was called:
# once (18µs+128µs) by URI::_idna::BEGIN@9 at line 20 # spent 146µs making 1 call to URI::_punycode::BEGIN@20
# spent 128µs making 1 call to constant::import |
21 | 2 | 56µs | 2 | 271µs | # spent 145µs (20+126) within URI::_punycode::BEGIN@21 which was called:
# once (20µs+126µs) by URI::_idna::BEGIN@9 at line 21 # spent 145µs making 1 call to URI::_punycode::BEGIN@21
# spent 126µs making 1 call to constant::import |
22 | 2 | 1.77ms | 2 | 265µs | # spent 143µs (21+122) within URI::_punycode::BEGIN@22 which was called:
# once (21µs+122µs) by URI::_idna::BEGIN@9 at line 22 # spent 143µs making 1 call to URI::_punycode::BEGIN@22
# spent 122µs making 1 call to constant::import |
23 | |||||
24 | 1 | 2µs | my $Delimiter = chr 0x2D; | ||
25 | 1 | 26µs | 1 | 9µs | my $BasicRE = qr/[\x00-\x7f]/; # spent 9µs making 1 call to URI::_punycode::CORE:qr |
26 | |||||
27 | sub _croak { require Carp; Carp::croak(@_); } | ||||
28 | |||||
29 | sub digit_value { | ||||
30 | my $code = shift; | ||||
31 | return ord($code) - ord("A") if $code =~ /[A-Z]/; | ||||
32 | return ord($code) - ord("a") if $code =~ /[a-z]/; | ||||
33 | return ord($code) - ord("0") + 26 if $code =~ /[0-9]/; | ||||
34 | return; | ||||
35 | } | ||||
36 | |||||
37 | sub code_point { | ||||
38 | my $digit = shift; | ||||
39 | return $digit + ord('a') if 0 <= $digit && $digit <= 25; | ||||
40 | return $digit + ord('0') - 26 if 26 <= $digit && $digit <= 36; | ||||
41 | die 'NOT COME HERE'; | ||||
42 | } | ||||
43 | |||||
44 | sub adapt { | ||||
45 | my($delta, $numpoints, $firsttime) = @_; | ||||
46 | $delta = $firsttime ? $delta / DAMP : $delta / 2; | ||||
47 | $delta += $delta / $numpoints; | ||||
48 | my $k = 0; | ||||
49 | while ($delta > ((BASE - TMIN) * TMAX) / 2) { | ||||
50 | $delta /= BASE - TMIN; | ||||
51 | $k += BASE; | ||||
52 | } | ||||
53 | return $k + (((BASE - TMIN + 1) * $delta) / ($delta + SKEW)); | ||||
54 | } | ||||
55 | |||||
56 | sub decode_punycode { | ||||
57 | my $code = shift; | ||||
58 | |||||
59 | my $n = INITIAL_N; | ||||
60 | my $i = 0; | ||||
61 | my $bias = INITIAL_BIAS; | ||||
62 | my @output; | ||||
63 | |||||
64 | if ($code =~ s/(.*)$Delimiter//o) { | ||||
65 | push @output, map ord, split //, $1; | ||||
66 | return _croak('non-basic code point') unless $1 =~ /^$BasicRE*$/o; | ||||
67 | } | ||||
68 | |||||
69 | while ($code) { | ||||
70 | my $oldi = $i; | ||||
71 | my $w = 1; | ||||
72 | LOOP: | ||||
73 | for (my $k = BASE; 1; $k += BASE) { | ||||
74 | my $cp = substr($code, 0, 1, ''); | ||||
75 | my $digit = digit_value($cp); | ||||
76 | defined $digit or return _croak("invalid punycode input"); | ||||
77 | $i += $digit * $w; | ||||
78 | my $t = ($k <= $bias) ? TMIN | ||||
79 | : ($k >= $bias + TMAX) ? TMAX : $k - $bias; | ||||
80 | last LOOP if $digit < $t; | ||||
81 | $w *= (BASE - $t); | ||||
82 | } | ||||
83 | $bias = adapt($i - $oldi, @output + 1, $oldi == 0); | ||||
84 | warn "bias becomes $bias" if $DEBUG; | ||||
85 | $n += $i / (@output + 1); | ||||
86 | $i = $i % (@output + 1); | ||||
87 | splice(@output, $i, 0, $n); | ||||
88 | warn join " ", map sprintf('%04x', $_), @output if $DEBUG; | ||||
89 | $i++; | ||||
90 | } | ||||
91 | return join '', map chr, @output; | ||||
92 | } | ||||
93 | |||||
94 | sub encode_punycode { | ||||
95 | my $input = shift; | ||||
96 | my @input = split //, $input; | ||||
97 | |||||
98 | my $n = INITIAL_N; | ||||
99 | my $delta = 0; | ||||
100 | my $bias = INITIAL_BIAS; | ||||
101 | |||||
102 | my @output; | ||||
103 | my @basic = grep /$BasicRE/, @input; | ||||
104 | my $h = my $b = @basic; | ||||
105 | push @output, @basic; | ||||
106 | push @output, $Delimiter if $b && $h < @input; | ||||
107 | warn "basic codepoints: (@output)" if $DEBUG; | ||||
108 | |||||
109 | while ($h < @input) { | ||||
110 | my $m = min(grep { $_ >= $n } map ord, @input); | ||||
111 | warn sprintf "next code point to insert is %04x", $m if $DEBUG; | ||||
112 | $delta += ($m - $n) * ($h + 1); | ||||
113 | $n = $m; | ||||
114 | for my $i (@input) { | ||||
115 | my $c = ord($i); | ||||
116 | $delta++ if $c < $n; | ||||
117 | if ($c == $n) { | ||||
118 | my $q = $delta; | ||||
119 | LOOP: | ||||
120 | for (my $k = BASE; 1; $k += BASE) { | ||||
121 | my $t = ($k <= $bias) ? TMIN : | ||||
122 | ($k >= $bias + TMAX) ? TMAX : $k - $bias; | ||||
123 | last LOOP if $q < $t; | ||||
124 | my $cp = code_point($t + (($q - $t) % (BASE - $t))); | ||||
125 | push @output, chr($cp); | ||||
126 | $q = ($q - $t) / (BASE - $t); | ||||
127 | } | ||||
128 | push @output, chr(code_point($q)); | ||||
129 | $bias = adapt($delta, $h + 1, $h == $b); | ||||
130 | warn "bias becomes $bias" if $DEBUG; | ||||
131 | $delta = 0; | ||||
132 | $h++; | ||||
133 | } | ||||
134 | } | ||||
135 | $delta++; | ||||
136 | $n++; | ||||
137 | } | ||||
138 | return join '', @output; | ||||
139 | } | ||||
140 | |||||
141 | sub min { | ||||
142 | my $min = shift; | ||||
143 | for (@_) { $min = $_ if $_ <= $min } | ||||
144 | return $min; | ||||
145 | } | ||||
146 | |||||
147 | 1 | 12µs | 1; | ||
148 | __END__ | ||||
# spent 9µs within URI::_punycode::CORE:qr which was called:
# once (9µs+0s) by URI::_idna::BEGIN@9 at line 25 |