3
  0   ˆl–Ðz¾”*e¶¥ ² Z¸Ø.4Ò˜´oÅ„î¼ç_‹uÐb&=LV[(ÅÄ ?÷     package Locale::Codes;
# Copyright (C) 2001      Canon Research Centre Europe (CRE).
# Copyright (C) 2002-2009 Neil Bowers
# Copyright (c) 2010-2013 Sullivan Beck
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

use strict;
require 5.006;
use warnings;

use Carp;
use Locale::Codes::Constants;

#=======================================================================
#       Public Global Variables
#=======================================================================

# This module is not called directly... %Data is filled in by the
# calling modules.

our($VERSION,%Data,%Retired);

# $Data{ TYPE }{ code2id   }{ CODESET } { CODE }  = [ ID, I ]
#              { id2code   }{ CODESET } { ID }    = CODE
#              { id2names  }{ ID }                = [ NAME, NAME, ... ]
#              { alias2id  }{ NAME }              = [ ID, I ]
#              { id        }                      = FIRST_UNUSED_ID
#              { codealias }{ CODESET } { ALIAS } = CODE
#
# $Retired{ TYPE }{ CODESET }{ code }{ CODE } = NAME
#                            { name }{ NAME } = [CODE,NAME]  (the key is lowercase)

$VERSION='3.26';

#=======================================================================
#
# _code ( TYPE,CODE,CODESET )
#
#=======================================================================

sub _code {
   return 1  if (@_ > 3);

   my($type,$code,$codeset) = @_;
   $code = ''  if (! $code);

   # Determine the codeset

   $codeset = $ALL_CODESETS{$type}{'default'}
     if (! defined($codeset)  ||  $codeset eq '');
   $codeset = lc($codeset);
   return 1  if (! exists $ALL_CODESETS{$type}{'codesets'}{$codeset});
   return (0,$code,$codeset)  if (! $code);

   # Determine the properties of the codeset

   my($op,@args) = @{ $ALL_CODESETS{$type}{'codesets'}{$codeset} };

   if      ($op eq 'lc') {
      $code = lc($code);

   } elsif ($op eq 'uc') {
      $code = uc($code);

   } elsif ($op eq 'ucfirst') {
      $code = ucfirst(lc($code));

   } elsif ($op eq 'numeric') {
      return (1)  unless ($code =~ /^\d+$/);
      my $l = $args[0];
      $code    = sprintf("%.${l}d", $code);
   }

   return (0,$code,$codeset);
}

#=======================================================================
#
# _code2name ( TYPE,CODE [,CODESET] [,'retired'] )
#
#=======================================================================

sub _code2name {
   my($type,@args)         = @_;
   my $retired             = 0;
   if (@args > 0  &&  $args[$#args]  &&  $args[$#args] eq 'retired') {
      pop(@args);
      $retired             = 1;
   }

   my($err,$code,$codeset) = _code($type,@args);
   return undef  if ($err  ||
                     ! defined $code);

   $code = $Data{$type}{'codealias'}{$codeset}{$code}
     if (exists $Data{$type}{'codealias'}{$codeset}{$code});

   if (exists $Data{$type}{'code2id'}{$codeset}  &&
       exists $Data{$type}{'code2id'}{$codeset}{$code}) {
      my ($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
      my $name    = $Data{$type}{'id2names'}{$id}[$i];
      return $name;

   } elsif ($retired  &&  exists $Retired{$type}{$codeset}{'code'}{$code}) {
      return $Retired{$type}{$codeset}{'code'}{$code};

   } else {
      return undef;
   }
}

#=======================================================================
#
# _name2code ( TYPE,NAME [,CODESET] [,'retired'] )
#
#=======================================================================

sub _name2code {
   my($type,$name,@args)   = @_;
   return undef  if (! $name);
   $name                   = lc($name);

   my $retired             = 0;
   if (@args > 0  &&  $args[$#args]  &&  $args[$#args] eq 'retired') {
      pop(@args);
      $retired             = 1;
   }

   my($err,$tmp,$codeset) = _code($type,'',@args);
   return undef  if ($err);

   if (exists $Data{$type}{'alias2id'}{$name}) {
      my $id = $Data{$type}{'alias2id'}{$name}[0];
      if (exists $Data{$type}{'id2code'}{$codeset}{$id}) {
         return $