File Coverage

blib/lib/AnyEvent/Util/idna.pl
Criterion Covered Total %
statement 74 74 100.0
branch 17 20 85.0
condition 3 5 60.0
subroutine 8 8 100.0
pod 2 3 66.6
total 104 110 94.5


line stmt bran cond sub pod time code
1             # based on RFC 3492
2              
3 1     1   7 use AnyEvent (); BEGIN { AnyEvent::common_sense }
  1     1   2  
  1         25  
  1         4  
4 1     1   5 use Carp ();
  1         2  
  1         12  
5 1     1   5 use List::Util ();
  1         2  
  1         14  
6 1     1   514 use integer;
  1         15  
  1         5  
7              
8             sub pyc_base () { 36 }
9             sub pyc_tmin () { 1 }
10             sub pyc_tmax () { 26 }
11             sub pyc_initial_bias () { 72 }
12             sub pyc_initial_n () { 128 }
13              
14             sub pyc_digits () { "abcdefghijklmnopqrstuvwxyz0123456789" }
15              
16             sub pyc_adapt($$$) {
17 12     12 0 22 my ($delta, $numpoints, $firsttime) = @_;
18              
19 12 100       20 $delta = $firsttime ? $delta / 700 : $delta >> 1;
20 12         19 $delta += $delta / $numpoints;
21              
22 12         18 my $k;
23              
24 12         22 while ($delta > (pyc_base - pyc_tmin) * pyc_tmax / 2) {
25 6         11 $delta /= pyc_base - pyc_tmin;
26 6         9 $k += pyc_base;
27             }
28              
29 12         21 $k + $delta * (pyc_base - pyc_tmin + 1) / ($delta + 38)
30             }
31              
32             sub punycode_encode($) {
33 5     5 1 54 my ($input) = @_;
34              
35 5         11 my ($n, $bias, $delta) = (pyc_initial_n, pyc_initial_bias);
36              
37 5         15 (my $output = $input) =~ y/\x00-\x7f//cd;
38 5         12 my $h = my $b = length $output;
39              
40 5         62 my @input = split '', $input;
41              
42 5 100 66     26 $output .= "-" if $b && $h < @input;
43              
44 5         13 while ($h < @input) {
45 9         27 my $m = List::Util::min grep { $_ >= $n } map ord, @input;
  25         59  
46              
47 9 50       25 $m - $n <= (0x7fffffff - $delta) / ($h + 1)
48             or Carp::croak "punycode_encode: overflow in punycode delta encoding";
49 9         12 $delta += ($m - $n) * ($h + 1);
50 9         11 $n = $m;
51              
52 9         18 for my $i (@input) {
53 25         31 my $c = ord $i;
54 25 100 50     47 ++$delta < 0x7fffffff
55             or Carp::croak "punycode_encode: overflow in punycode delta encoding"
56             if $c < $n;
57              
58 25 100       49 if ($c == $n) {
59 9         17 my ($q, $k) = ($delta, pyc_base);
60              
61 9         10 while () {
62 29         58 my $t = List::Util::min pyc_tmax, List::Util::max pyc_tmin, $k - $bias;
63              
64 29 100       51 last if $q < $t;
65              
66 20         41 $output .= substr pyc_digits, $t + (($q - $t) % (pyc_base - $t)), 1;
67              
68 20         31 $q = ($q - $t) / (pyc_base - $t);
69 20         25 $k += pyc_base;
70             }
71              
72 9         14 $output .= substr pyc_digits, $q, 1;
73              
74 9         23 $bias = pyc_adapt $delta, $h + 1, $h == $b;
75              
76 9         14 $delta = 0;
77 9         13 ++$h;
78             }
79             }
80              
81 9         11 ++$delta;
82 9         16 ++$n;
83             }
84              
85             $output
86 5         22 }
87              
88             sub punycode_decode($) {
89 2     2 1 28 my ($input) = @_;
90              
91 2         4 my ($n, $bias, $i) = (pyc_initial_n, pyc_initial_bias);
92 2         4 my $output;
93              
94 2 100       11 if ($input =~ /^(.*?)-([^-]*)$/x) {
95 1         3 $output = $1;
96 1         33 $input = $2;
97              
98 1 50       7 $output =~ /[^\x00-\x7f]/
99             and Carp::croak "punycode_decode: malformed punycode";
100             }
101              
102 2         5 while (length $input) {
103 3         5 my $oldi = $i;
104 3         4 my $w = 1;
105              
106 3         5 for (my $k = pyc_base; ; $k += pyc_base) {
107 9 50       22 (my $digit = index pyc_digits, substr $input, 0, 1, "")
108             >= 0
109             or Carp::croak "punycode_decode: malformed punycode";
110            
111 9         11 $i += $digit * $w;
112            
113 9         21 my $t = List::Util::max pyc_tmin, List::Util::min pyc_tmax, $k - $bias;
114 9 100       17 last if $digit < $t;
115              
116 6         11 $w *= pyc_base - $t;
117             }
118              
119 3         5 my $outlen = 1 + length $output;
120 3         14 $bias = pyc_adapt $i - $oldi, $outlen, $oldi == 0;
121              
122 3         6 $n += $i / $outlen;
123 3         4 $i %= $outlen;
124              
125 3         12 substr $output, $i, 0, chr $n;
126 3         7 ++$i;
127             }
128              
129             $output
130 2         6 }
131              
132             1