Commit | Line | Data |
3fea05b9 |
1 | package URI::_idna; |
2 | |
3 | # This module implements the RFCs 3490 (IDNA) and 3491 (Nameprep) |
4 | # based on Python-2.6.4/Lib/encodings/idna.py |
5 | |
6 | use strict; |
7 | use URI::_punycode qw(encode_punycode decode_punycode); |
8 | use Carp qw(croak); |
9 | |
10 | my $ASCII = qr/^[\x00-\x7F]*\z/; |
11 | |
12 | sub encode { |
13 | my $idomain = shift; |
14 | my @labels = split(/\./, $idomain, -1); |
15 | my @last_empty; |
16 | push(@last_empty, pop @labels) if @labels > 1 && $labels[-1] eq ""; |
17 | for (@labels) { |
18 | $_ = ToASCII($_); |
19 | } |
20 | return join(".", @labels, @last_empty); |
21 | } |
22 | |
23 | sub decode { |
24 | my $domain = shift; |
25 | return join(".", map ToUnicode($_), split(/\./, $domain, -1)) |
26 | } |
27 | |
28 | sub nameprep { # XXX real implementation missing |
29 | my $label = shift; |
30 | $label = lc($label); |
31 | return $label; |
32 | } |
33 | |
34 | sub check_size { |
35 | my $label = shift; |
36 | croak "Label empty" if $label eq ""; |
37 | croak "Label too long" if length($label) > 63; |
38 | return $label; |
39 | } |
40 | |
41 | sub ToASCII { |
42 | my $label = shift; |
43 | return check_size($label) if $label =~ $ASCII; |
44 | |
45 | # Step 2: nameprep |
46 | $label = nameprep($label); |
47 | # Step 3: UseSTD3ASCIIRules is false |
48 | # Step 4: try ASCII again |
49 | return check_size($label) if $label =~ $ASCII; |
50 | |
51 | # Step 5: Check ACE prefix |
52 | if ($label =~ /^xn--/) { |
53 | croak "Label starts with ACE prefix"; |
54 | } |
55 | |
56 | # Step 6: Encode with PUNYCODE |
57 | $label = encode_punycode($label); |
58 | |
59 | # Step 7: Prepend ACE prefix |
60 | $label = "xn--$label"; |
61 | |
62 | # Step 8: Check size |
63 | return check_size($label); |
64 | } |
65 | |
66 | sub ToUnicode { |
67 | my $label = shift; |
68 | $label = nameprep($label) unless $label =~ $ASCII; |
69 | return $label unless $label =~ /^xn--/; |
70 | my $label1 = decode_punycode(substr($label, 4)); |
71 | my $label2 = ToASCII($label); |
72 | if (lc($label) ne $label2) { |
73 | croak "IDNA does not round-trip: '$label' vs '$label2'"; |
74 | } |
75 | return $label1; |
76 | } |
77 | |
78 | 1; |