← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:23 2010

File /usr/local/lib/perl5/site_perl/5.10.1/URI/_punycode.pm
Statements Executed 35
Statement Execution Time 950µs
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11114µs16µsURI::_punycode::::BEGIN@3URI::_punycode::BEGIN@3
11111µs15µsURI::_punycode::::BEGIN@10URI::_punycode::BEGIN@10
11111µs34µsURI::_punycode::::BEGIN@17URI::_punycode::BEGIN@17
1119µs59µsURI::_punycode::::BEGIN@14URI::_punycode::BEGIN@14
1117µs31µsURI::_punycode::::BEGIN@15URI::_punycode::BEGIN@15
1116µs31µsURI::_punycode::::BEGIN@18URI::_punycode::BEGIN@18
1116µs30µsURI::_punycode::::BEGIN@16URI::_punycode::BEGIN@16
1116µs29µsURI::_punycode::::BEGIN@20URI::_punycode::BEGIN@20
1116µs30µsURI::_punycode::::BEGIN@19URI::_punycode::BEGIN@19
1123µs3µsURI::_punycode::::CORE:qrURI::_punycode::CORE:qr (opcode)
0000s0sURI::_punycode::::_croakURI::_punycode::_croak
0000s0sURI::_punycode::::adaptURI::_punycode::adapt
0000s0sURI::_punycode::::code_pointURI::_punycode::code_point
0000s0sURI::_punycode::::decode_punycodeURI::_punycode::decode_punycode
0000s0sURI::_punycode::::digit_valueURI::_punycode::digit_value
0000s0sURI::_punycode::::encode_punycodeURI::_punycode::encode_punycode
0000s0sURI::_punycode::::minURI::_punycode::min
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package URI::_punycode;
2
3357µs219µs
# spent 16µs (14+3) within URI::_punycode::BEGIN@3 which was called # once (14µs+3µs) by URI::_idna::BEGIN@7 at line 3
use strict;
# spent 16µs making 1 call to URI::_punycode::BEGIN@3 # spent 2µs making 1 call to strict::import
41400nsour $VERSION = 0.02;
5
61800nsrequire Exporter;
718µsour @ISA = qw(Exporter);
81600nsour @EXPORT = qw(encode_punycode decode_punycode);
9
10332µs218µs
# spent 15µs (11+4) within URI::_punycode::BEGIN@10 which was called # once (11µs+4µs) by URI::_idna::BEGIN@7 at line 10
use integer;
# spent 15µs making 1 call to URI::_punycode::BEGIN@10 # spent 3µs making 1 call to integer::import
11
121100nsour $DEBUG = 0;
13
14326µs2109µs
# spent 59µs (9+50) within URI::_punycode::BEGIN@14 which was called # once (9µs+50µs) by URI::_idna::BEGIN@7 at line 14
use constant BASE => 36;
# spent 59µs making 1 call to URI::_punycode::BEGIN@14 # spent 50µs making 1 call to constant::import
15322µs254µs
# spent 31µs (7+24) within URI::_punycode::BEGIN@15 which was called # once (7µs+24µs) by URI::_idna::BEGIN@7 at line 15
use constant TMIN => 1;
# spent 31µs making 1 call to URI::_punycode::BEGIN@15 # spent 24µs making 1 call to constant::import
16320µs254µs
# spent 30µs (6+24) within URI::_punycode::BEGIN@16 which was called # once (6µs+24µs) by URI::_idna::BEGIN@7 at line 16
use constant TMAX => 26;
# spent 30µs making 1 call to URI::_punycode::BEGIN@16 # spent 24µs making 1 call to constant::import
17322µs258µs
# spent 34µs (11+24) within URI::_punycode::BEGIN@17 which was called # once (11µs+24µs) by URI::_idna::BEGIN@7 at line 17
use constant SKEW => 38;
# spent 34µs making 1 call to URI::_punycode::BEGIN@17 # spent 24µs making 1 call to constant::import
18321µs255µs
# spent 31µs (6+24) within URI::_punycode::BEGIN@18 which was called # once (6µs+24µs) by URI::_idna::BEGIN@7 at line 18
use constant DAMP => 700;
# spent 31µs making 1 call to URI::_punycode::BEGIN@18 # spent 24µs making 1 call to constant::import
19321µs254µs
# spent 30µs (6+24) within URI::_punycode::BEGIN@19 which was called # once (6µs+24µs) by URI::_idna::BEGIN@7 at line 19
use constant INITIAL_BIAS => 72;
# spent 30µs making 1 call to URI::_punycode::BEGIN@19 # spent 24µs making 1 call to constant::import
203701µs251µs
# spent 29µs (6+23) within URI::_punycode::BEGIN@20 which was called # once (6µs+23µs) by URI::_idna::BEGIN@7 at line 20
use constant INITIAL_N => 128;
# spent 29µs making 1 call to URI::_punycode::BEGIN@20 # spent 23µs making 1 call to constant::import
21
221300nsmy $Delimiter = chr 0x2D;
2319µs13µsmy $BasicRE = qr/[\x00-\x7f]/;
# spent 3µs making 1 call to URI::_punycode::CORE:qr
24
25sub _croak { require Carp; Carp::croak(@_); }
26
27sub digit_value {
28 my $code = shift;
29 return ord($code) - ord("A") if $code =~ /[A-Z]/;
30 return ord($code) - ord("a") if $code =~ /[a-z]/;
31 return ord($code) - ord("0") + 26 if $code =~ /[0-9]/;
32 return;
33}
34
35sub code_point {
36 my $digit = shift;
37 return $digit + ord('a') if 0 <= $digit && $digit <= 25;
38 return $digit + ord('0') - 26 if 26 <= $digit && $digit <= 36;
39 die 'NOT COME HERE';
40}
41
42sub adapt {
43 my($delta, $numpoints, $firsttime) = @_;
44 $delta = $firsttime ? $delta / DAMP : $delta / 2;
45 $delta += $delta / $numpoints;
46 my $k = 0;
47 while ($delta > ((BASE - TMIN) * TMAX) / 2) {
48 $delta /= BASE - TMIN;
49 $k += BASE;
50 }
51 return $k + (((BASE - TMIN + 1) * $delta) / ($delta + SKEW));
52}
53
54sub decode_punycode {
55 my $code = shift;
56
57 my $n = INITIAL_N;
58 my $i = 0;
59 my $bias = INITIAL_BIAS;
60 my @output;
61
62 if ($code =~ s/(.*)$Delimiter//o) {
63 push @output, map ord, split //, $1;
64 return _croak('non-basic code point') unless $1 =~ /^$BasicRE*$/o;
65 }
66
67 while ($code) {
68 my $oldi = $i;
69 my $w = 1;
70 LOOP:
71 for (my $k = BASE; 1; $k += BASE) {
72 my $cp = substr($code, 0, 1, '');
73 my $digit = digit_value($cp);
74 defined $digit or return _croak("invalid punycode input");
75 $i += $digit * $w;
76 my $t = ($k <= $bias) ? TMIN
77 : ($k >= $bias + TMAX) ? TMAX : $k - $bias;
78 last LOOP if $digit < $t;
79 $w *= (BASE - $t);
80 }
81 $bias = adapt($i - $oldi, @output + 1, $oldi == 0);
82 warn "bias becomes $bias" if $DEBUG;
83 $n += $i / (@output + 1);
84 $i = $i % (@output + 1);
85 splice(@output, $i, 0, $n);
86 warn join " ", map sprintf('%04x', $_), @output if $DEBUG;
87 $i++;
88 }
89 return join '', map chr, @output;
90}
91
92sub encode_punycode {
93 my $input = shift;
94 # my @input = split //, $input; # doesn't work in 5.6.x!
95 my @input = map substr($input, $_, 1), 0..length($input)-1;
96
97 my $n = INITIAL_N;
98 my $delta = 0;
99 my $bias = INITIAL_BIAS;
100
101 my @output;
102 my @basic = grep /$BasicRE/, @input;
103 my $h = my $b = @basic;
104 push @output, @basic;
105 push @output, $Delimiter if $b && $h < @input;
106 warn "basic codepoints: (@output)" if $DEBUG;
107
108 while ($h < @input) {
109 my $m = min(grep { $_ >= $n } map ord, @input);
110 warn sprintf "next code point to insert is %04x", $m if $DEBUG;
111 $delta += ($m - $n) * ($h + 1);
112 $n = $m;
113 for my $i (@input) {
114 my $c = ord($i);
115 $delta++ if $c < $n;
116 if ($c == $n) {
117 my $q = $delta;
118 LOOP:
119 for (my $k = BASE; 1; $k += BASE) {
120 my $t = ($k <= $bias) ? TMIN :
121 ($k >= $bias + TMAX) ? TMAX : $k - $bias;
122 last LOOP if $q < $t;
123 my $cp = code_point($t + (($q - $t) % (BASE - $t)));
124 push @output, chr($cp);
125 $q = ($q - $t) / (BASE - $t);
126 }
127 push @output, chr(code_point($q));
128 $bias = adapt($delta, $h + 1, $h == $b);
129 warn "bias becomes $bias" if $DEBUG;
130 $delta = 0;
131 $h++;
132 }
133 }
134 $delta++;
135 $n++;
136 }
137 return join '', @output;
138}
139
140sub min {
141 my $min = shift;
142 for (@_) { $min = $_ if $_ <= $min }
143 return $min;
144}
145
14618µs1;
147__END__
148
149=head1 NAME
150
151URI::_punycode - encodes Unicode string in Punycode
152
153=head1 SYNOPSIS
154
155 use URI::_punycode;
156 $punycode = encode_punycode($unicode);
157 $unicode = decode_punycode($punycode);
158
159=head1 DESCRIPTION
160
161URI::_punycode is a module to encode / decode Unicode strings into
162Punycode, an efficient encoding of Unicode for use with IDNA.
163
164This module requires Perl 5.6.0 or over to handle UTF8 flagged Unicode
165strings.
166
167=head1 FUNCTIONS
168
169This module exports following functions by default.
170
171=over 4
172
173=item encode_punycode
174
175 $punycode = encode_punycode($unicode);
176
177takes Unicode string (UTF8-flagged variable) and returns Punycode
178encoding for it.
179
180=item decode_punycode
181
182 $unicode = decode_punycode($punycode)
183
184takes Punycode encoding and returns original Unicode string.
185
186=back
187
188These functions throws exceptionsn on failure. You can catch 'em via
189C<eval>.
190
191=head1 AUTHOR
192
193Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> is the author of
194IDNA::Punycode v0.02 which was the basis for this module.
195
196This library is free software; you can redistribute it and/or modify
197it under the same terms as Perl itself.
198
199=head1 SEE ALSO
200
201L<IDNA::Punycode>, RFC 3492
202
203=cut
# spent 3µs within URI::_punycode::CORE:qr which was called # once (3µs+0s) by URI::_idna::BEGIN@7 at line 23 of URI/_punycode.pm
sub URI::_punycode::CORE:qr; # xsub