| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
## Domain Registry Interface, Language Tag parsing (RFC5646) |
|
2
|
|
|
|
|
|
|
## |
|
3
|
|
|
|
|
|
|
## Copyright (c) 2015,2016 Patrick Mevzek . All rights reserved. |
|
4
|
|
|
|
|
|
|
## |
|
5
|
|
|
|
|
|
|
## This file is part of Net::DRI |
|
6
|
|
|
|
|
|
|
## |
|
7
|
|
|
|
|
|
|
## Net::DRI is free software; you can redistribute it and/or modify |
|
8
|
|
|
|
|
|
|
## it under the terms of the GNU General Public License as published by |
|
9
|
|
|
|
|
|
|
## the Free Software Foundation; either version 2 of the License, or |
|
10
|
|
|
|
|
|
|
## (at your option) any later version. |
|
11
|
|
|
|
|
|
|
## |
|
12
|
|
|
|
|
|
|
## See the LICENSE file that comes with this distribution for more details. |
|
13
|
|
|
|
|
|
|
#################################################################################################### |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
package Net::DRI::Data::LanguageTag; |
|
16
|
|
|
|
|
|
|
|
|
17
|
70
|
|
|
70
|
|
2119
|
use strict; |
|
|
70
|
|
|
|
|
86
|
|
|
|
70
|
|
|
|
|
1744
|
|
|
18
|
70
|
|
|
70
|
|
225
|
use warnings; |
|
|
70
|
|
|
|
|
83
|
|
|
|
70
|
|
|
|
|
1479
|
|
|
19
|
70
|
|
|
70
|
|
234
|
use feature 'state'; |
|
|
70
|
|
|
|
|
83
|
|
|
|
70
|
|
|
|
|
4833
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
70
|
|
|
70
|
|
650
|
use Sub::Name; |
|
|
70
|
|
|
|
|
528
|
|
|
|
70
|
|
|
|
|
12155
|
|
|
22
|
|
|
|
|
|
|
|
|
23
|
6
|
|
|
0
|
|
11
|
use overload '""' => sub { my ($self, @rest) = @_; return $self->as_string(); }, |
|
|
6
|
|
|
|
|
8
|
|
|
24
|
1
|
|
|
0
|
|
3
|
'@{}' => sub { my ($self, @rest) = @_; return [ $self->subtags() ]; }, |
|
|
1
|
|
|
|
|
3
|
|
|
25
|
3
|
100
|
|
0
|
|
400
|
'.' => sub { my ($self, $toadd, $swap) = @_; mydie('Left adding subtags is not implemented') if $swap; return $self->add_subtag($toadd); }, |
|
|
3
|
|
|
|
|
143
|
|
|
|
2
|
|
|
|
|
5
|
|
|
26
|
4
|
100
|
|
0
|
|
84
|
'cmp' => sub { my ($self, $other, $swap) = @_; my $r = "${self}" cmp "${other}"; return $swap ? -$r : $r; }, ## should we compare subtags one by one? |
|
|
4
|
|
|
|
|
6
|
|
|
|
4
|
|
|
|
|
24
|
|
|
27
|
70
|
|
|
70
|
|
296
|
'fallback' => undef; |
|
|
70
|
|
|
|
|
92
|
|
|
|
70
|
|
|
|
|
978
|
|
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $digit=qr/[0-9]/; |
|
30
|
|
|
|
|
|
|
my $alpha=qr/[A-Za-z]/; |
|
31
|
|
|
|
|
|
|
my $alphanum=qr/${digit}|${alpha}/; |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my $irregular=qr/en-GB-oed|i-ami|i-bnn|i-default|i-enochian|i-hak|i-klingon|i-lux|i-mingo|i-navajo|i-pwn|i-tao|i-tay|i-tsu|sgn-BE-FR|sgn-BE-NL|sgn-CH-DE/i; |
|
34
|
|
|
|
|
|
|
my $regular=qr/art-lojban|cel-gaulish|no-bok|no-nyn|zh-guoyu|zh-hakka|zh-min|zh-min-nan|zh-xiang/i; |
|
35
|
|
|
|
|
|
|
my $grandfathered=qr/${irregular}|${regular}/; |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $privateuse=qr/x(?:-${alphanum}{1,8})+/i; ## TODO check if lower bound is indeed 1 ! is this like an extension, and hence need to be checked |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $extlang=qr/${alpha}{3}(?:-${alpha}{3}){0,2}/; |
|
40
|
|
|
|
|
|
|
my $language=qr/(?:${alpha}{2,3}(-${extlang})?)|${alpha}{4}|${alpha}{5,8}/; |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $script=qr/${alpha}{4}/; |
|
43
|
|
|
|
|
|
|
my $region=qr/${alpha}{2}|${digit}{3}/; |
|
44
|
|
|
|
|
|
|
my $variant=qr/${alphanum}{5,8}|${digit}${alphanum}{3}/; |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $singleton=qr/${digit}|[A-W]|[Y-Z]|[a-w]|[y-z]/; |
|
47
|
|
|
|
|
|
|
my $extension=qr/${singleton}(?:-${alphanum}{2,8})+/; |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my $langtag=qr/(?${language})(? |