1N/A

1N/Arequire 5;

1N/Apackage I18N::LangTags::List;

1N/Ause strict;

1N/Ause vars qw(%Name %Is_Disrec $Debug $VERSION);

1N/A$VERSION = '0.29';

1N/A

1N/A{

1N/A my $seeking = 1;

1N/A my $count = 0;

1N/A my($disrec,$tag,$name);

1N/A my $last_name = '';

1N/A while(<I18N::LangTags::List::DATA>) {

1N/A if($seeking) {

1N/A $seeking = 0 if m/=for woohah/;

1N/A } elsif( ($disrec, $tag, $name) =

1N/A m/(\[?)\{([-0-9a-zA-Z]+)\}(?:\s*:)?\s*([^\[\]]+)/

1N/A ) {

1N/A $name =~ s/\s*[;\.]*\s*$//g;

1N/A next unless $name;

1N/A ++$count;

1N/A print "<$tag> <$name>\n" if $Debug;

1N/A $last_name = $Name{$tag} = $name;

1N/A $Is_Disrec{$tag} = 1 if $disrec;

1N/A } elsif (m/[Ff]ormerly \"([-a-z0-9]+)\"/) {

1N/A $Name{$1} = "$last_name (old tag)" if $last_name;

1N/A $Is_Disrec{$1} = 1;

1N/A }

1N/A }

1N/A die "No tags read??" unless $count;

1N/A}

1N/A

1N/Asub name {

1N/A my $tag = lc($_[0] || return);

1N/A $tag =~ s/^\s+//s;

1N/A $tag =~ s/\s+$//s;

1N/A

1N/A my $alt;

1N/A if($tag =~ m/^x-(.+)/) {

1N/A $alt = "i-$1";

1N/A } elsif($tag =~ m/^i-(.+)/) {

1N/A $alt = "x-$1";

1N/A } else {

1N/A $alt = '';

1N/A }

1N/A

1N/A my $subform = '';

1N/A my $name = '';

1N/A print "Input: {$tag}\n" if $Debug;

1N/A while(length $tag) {

1N/A last if $name = $Name{$tag};

1N/A last if $name = $Name{$alt};

1N/A if($tag =~ s/(-[a-z0-9]+)$//s) {

1N/A print "Shaving off: $1 leaving $tag\n" if $Debug;

1N/A $subform = "$1$subform";

1N/A # and loop around again

1N/A

1N/A $alt =~ s/(-[a-z0-9]+)$//s && $Debug && print " alt -> $alt\n";

1N/A } else {

1N/A # we're trying to pull a subform off a primary tag. TILT!

1N/A print "Aborting on: {$name}{$subform}\n" if $Debug;

1N/A last;

1N/A }

1N/A }

1N/A print "Output: {$name}{$subform}\n" if $Debug;

1N/A

1N/A return unless $name; # Failure

1N/A return $name unless $subform; # Exact match

1N/A $subform =~ s/^-//s;

1N/A $subform =~ s/-$//s;

1N/A return "$name (Subform \"$subform\")";

1N/A}

1N/A

1N/A

1N/Asub is_decent {

1N/A my $tag = lc($_[0] || return 0);

1N/A #require I18N::LangTags;

1N/A

1N/A return 0 unless

1N/A $tag =~

1N/A /^(?: # First subtag

1N/A [xi] | [a-z]{2,3}

1N/A )

1N/A (?: # Subtags thereafter

1N/A - # separator

1N/A [a-z0-9]{1,8} # subtag

1N/A )*

1N/A $/xs;

1N/A

1N/A my @supers = ();

1N/A foreach my $bit (split('-', $tag)) {

1N/A push @supers,

1N/A scalar(@supers) ? ($supers[-1] . '-' . $bit) : $bit;

1N/A }

1N/A return 0 unless @supers;

1N/A shift @supers if $supers[0] =~ m<^(i|x|sgn)$>s;

1N/A return 0 unless @supers;

1N/A

1N/A foreach my $f ($tag, @supers) {

1N/A return 0 if $Is_Disrec{$f};

1N/A return 2 if $Name{$f};

1N/A # so that decent subforms of indecent tags are decent

1N/A }

1N/A return 2 if $Name{$tag}; # not only is it decent, it's known!

1N/A return 1;

1N/A}

1N/A

1N/A1;

1N/A

1N/A