This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump Locale-Codes from 3.39 to 3.40
[perl5.git] / cpan / Locale-Codes / lib / Locale / Codes.pm
index eb053af..129af11 100644 (file)
@@ -1,15 +1,16 @@
 package Locale::Codes;
 # Copyright (C) 2001      Canon Research Centre Europe (CRE).
 # Copyright (C) 2002-2009 Neil Bowers
-# Copyright (c) 2010-2010 Sullivan Beck
+# Copyright (c) 2010-2016 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;
-require 5.002;
 
 use Carp;
+use Locale::Codes::Constants;
 
 #=======================================================================
 #       Public Global Variables
@@ -18,7 +19,7 @@ use Carp;
 # This module is not called directly... %Data is filled in by the
 # calling modules.
 
-use vars qw($VERSION %Data);
+our($VERSION,%Data,%Retired);
 
 # $Data{ TYPE }{ code2id   }{ CODESET } { CODE }  = [ ID, I ]
 #              { id2code   }{ CODESET } { ID }    = CODE
@@ -26,57 +27,128 @@ use vars qw($VERSION %Data);
 #              { 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.13';
+$VERSION='3.40';
 
 #=======================================================================
 #
-# _code2name ( TYPE,CODE,CODESET )
+# _code ( TYPE,CODE,CODESET )
 #
 #=======================================================================
 
-sub _code2name {
+sub _code {
+   return (1)  if (@_ > 3);
+
    my($type,$code,$codeset) = @_;
+   $code = ''  if (! defined $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 eq '');
+
+   # Determine the properties of the codeset
+
+   my($op,@args) = @{ $ALL_CODESETS{$type}{'codesets'}{$codeset} };
+
+   if      ($op eq 'lc') {
+      $code = lc($code);
+      return (0,$code,$codeset);
+   }
+
+   if ($op eq 'uc') {
+      $code = uc($code);
+      return (0,$code,$codeset);
+   }
+
+   if ($op eq 'ucfirst') {
+      $code = ucfirst(lc($code));
+      return (0,$code,$codeset);
+   }
+
+   # uncoverable branch false
+   if ($op eq 'numeric') {
+      return (1)  unless ($code =~ /^\d+$/);
+      my $l = $args[0];
+      $code    = sprintf("%.${l}d", $code);
+      return (0,$code,$codeset);
+   }
+
+   # uncoverable statement
+   die "ERROR: codeset not defined correctly: $codeset [$op]\n";
+}
+
+#=======================================================================
+#
+# _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);
 
    $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}) {
+   if (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 {
-      #---------------------------------------------------------------
-      # no such code!
-      #---------------------------------------------------------------
       return undef;
    }
 }
 
 #=======================================================================
 #
-# _name2code ( TYPE,NAME,CODESET )
+# _name2code ( TYPE,NAME [,CODESET] [,'retired'] )
 #
 #=======================================================================
 
 sub _name2code {
-   my($type,$name,$codeset) = @_;
-   $name = ""  if (! $name);
-   $name = lc($name);
+   my($type,$name,@args)   = @_;
+   return undef  if (! $name);
+   $name                   = lc($name);
+
+   my $retired             = 0;
+   if (@args > 0  &&  $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 $Data{$type}{'id2code'}{$codeset}{$id};
       }
+
+   } elsif ($retired  &&  exists $Retired{$type}{$codeset}{'name'}{$name}) {
+      return $Retired{$type}{$codeset}{'name'}{$name}[0];
    }
 
-   #---------------------------------------------------------------
-   # no such name!
-   #---------------------------------------------------------------
    return undef;
-  }
+}
 
 #=======================================================================
 #
@@ -85,7 +157,30 @@ sub _name2code {
 #=======================================================================
 
 sub _code2code {
-   my($type,$code,$inset,$outset) = @_;
+   my($type,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   if (@args != 3) {
+      if (! $nowarn) {                                    # uncoverable branch true
+         croak "${type}_code2code() takes 3 arguments!";  # uncoverable statement
+      }
+      return undef;
+   }
+
+   my($code,$inset,$outset) = @args;
+   my($err,$tmp);
+   ($err,$code,$inset) = _code($type,$code,$inset);
+   return undef  if ($err);
+   ($err,$tmp,$outset) = _code($type,'',$outset);
+   return undef  if ($err);
 
    my $name    = _code2name($type,$code,$inset);
    my $outcode = _name2code($type,$name,$outset);
@@ -94,31 +189,44 @@ sub _code2code {
 
 #=======================================================================
 #
-# _all_codes ( TYPE,CODESET )
+# _all_codes ( TYPE [,CODESET] [,'retired'] )
 #
 #=======================================================================
 
 sub _all_codes {
-   my($type,$codeset) = @_;
-
-   if (! exists $Data{$type}{'code2id'}{$codeset}) {
-      return ();
+   my($type,@args)         = @_;
+   my $retired             = 0;
+   if (@args > 0  &&  $args[$#args] eq 'retired') {
+      pop(@args);
+      $retired             = 1;
    }
+
+   my ($err,$tmp,$codeset) = _code($type,'',@args);
+   return ()  if ($err);
+
    my @codes = keys %{ $Data{$type}{'code2id'}{$codeset} };
+   push(@codes,keys %{ $Retired{$type}{$codeset}{'code'} })  if ($retired);
    return (sort @codes);
 }
 
 #=======================================================================
 #
-# _all_names ( TYPE,CODESET )
+# _all_names ( TYPE [,CODESET] [,'retired'] )
 #
 #=======================================================================
 
 sub _all_names {
-   my($type,$codeset) = @_;
+   my($type,@args)         = @_;
+   my $retired             = 0;
+   if (@args > 0  &&  $args[$#args] eq 'retired') {
+      pop(@args);
+      $retired             = 1;
+   }
+
+   my ($err,$tmp,$codeset) = _code($type,'',@args);
+   return ()  if ($err);
 
    my @codes = _all_codes($type,$codeset);
-   return ()  if (! @codes);
    my @names;
 
    foreach my $code (@codes) {
@@ -126,6 +234,12 @@ sub _all_names {
       my $name   = $Data{$type}{'id2names'}{$id}[$i];
       push(@names,$name);
    }
+   if ($retired) {
+      foreach my $lc (keys %{ $Retired{$type}{$codeset}{'name'} }) {
+         my $name = $Retired{$type}{$codeset}{'name'}{$lc}[1];
+         push @names,$name;
+      }
+   }
    return (sort @names);
 }
 
@@ -140,23 +254,37 @@ sub _all_names {
 #=======================================================================
 
 sub _rename {
-   my($type,$code,$new_name,$codeset,$nowarn) = @_;
+   my($type,$code,$new_name,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   my $codeset  = shift(@args);
+   my $err;
+   ($err,$code,$codeset) = _code($type,$code,$codeset);
 
    if (! $codeset) {
-      carp "rename_$type(): unknown codeset\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+         carp "rename_$type(): unknown codeset\n";        # uncoverable statement
+      }
       return 0;
    }
 
-   $code = $Data{$type}{'codealias'}{$codeset}{$code}
-     if (exists $Data{$type}{'codealias'}{$codeset}{$code});
-
    # Check that $code exists in the codeset.
 
    my $id;
    if (exists $Data{$type}{'code2id'}{$codeset}{$code}) {
       $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
    } else {
-      carp "rename_$type(): unknown code: $code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+         carp "rename_$type(): unknown code: $code\n";    # uncoverable statement
+      }
       return 0;
    }
 
@@ -177,8 +305,11 @@ sub _rename {
       my ($new_id,$i) = @{ $Data{$type}{'alias2id'}{lc($new_name)} };
       if ($new_id != $id) {
          # Case 1
-         carp "rename_$type(): rename to an existing $type not allowed\n"
-           unless ($nowarn);
+         if (! $nowarn) {                                 # uncoverable branch true
+                                                          # uncoverable statement
+            carp "rename_$type(): rename to an existing $type not allowed\n";
+         }
+
          return 0;
       }
 
@@ -209,10 +340,25 @@ sub _rename {
 #=======================================================================
 
 sub _add_code {
-   my($type,$code,$name,$codeset,$nowarn) = @_;
+   my($type,$code,$name,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   my $codeset  = shift(@args);
+   my $err;
+   ($err,$code,$codeset) = _code($type,$code,$codeset);
 
    if (! $codeset) {
-      carp "add_$type(): unknown codeset\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+         carp "add_$type(): unknown codeset\n";           # uncoverable statement
+      }
       return 0;
    }
 
@@ -220,7 +366,9 @@ sub _add_code {
 
    if (exists $Data{$type}{'code2id'}{$codeset}{$code}  ||
        exists $Data{$type}{'codealias'}{$codeset}{$code}) {
-      carp "add_$type(): code already in use: $code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+         carp "add_$type(): code already in use: $code\n";# uncoverable statement
+      }
       return 0;
    }
 
@@ -232,7 +380,10 @@ sub _add_code {
    if (exists $Data{$type}{'alias2id'}{lc($name)}) {
       ($id,$i) = @{ $Data{$type}{'alias2id'}{lc($name)} };
       if (exists $Data{$type}{'id2code'}{$codeset}{$id}) {
-         carp "add_$type(): name already in use: $name\n"  unless ($nowarn);
+         if (! $nowarn) {                                 # uncoverable branch true
+                                                          # uncoverable statement
+            carp "add_$type(): name already in use: $name\n";
+         }
          return 0;
       }
 
@@ -260,20 +411,35 @@ sub _add_code {
 #=======================================================================
 
 sub _delete_code {
-   my($type,$code,$codeset,$nowarn) = @_;
+   my($type,$code,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   my $codeset  = shift(@args);
+   my $err;
+   ($err,$code,$codeset) = _code($type,$code,$codeset);
 
    if (! $codeset) {
-      carp "delete_$type(): unknown codeset\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+         carp "delete_$type(): unknown codeset\n";        # uncoverable statement
+      }
       return 0;
    }
 
-   $code = $Data{$type}{'codealias'}{$codeset}{$code}
-     if (exists $Data{$type}{'codealias'}{$codeset}{$code});
-
    # Check that $code is valid.
 
    if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
-      carp "delete_$type(): code does not exist: $code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "delete_$type(): code does not exist: $code\n";
+      }
       return 0;
    }
 
@@ -315,7 +481,16 @@ sub _delete_code {
 #=======================================================================
 
 sub _add_alias {
-   my($type,$name,$new_name,$nowarn) = @_;
+   my($type,$name,$new_name,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
 
    # Check that $name is used and $new_name is new.
 
@@ -323,12 +498,18 @@ sub _add_alias {
    if (exists $Data{$type}{'alias2id'}{lc($name)}) {
       $id = $Data{$type}{'alias2id'}{lc($name)}[0];
    } else {
-      carp "add_${type}_alias(): name does not exist: $name\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "add_${type}_alias(): name does not exist: $name\n";
+      }
       return 0;
    }
 
    if (exists $Data{$type}{'alias2id'}{lc($new_name)}) {
-      carp "add_${type}_alias(): alias already in use: $new_name\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "add_${type}_alias(): alias already in use: $new_name\n";
+      }
       return 0;
    }
 
@@ -354,7 +535,16 @@ sub _add_alias {
 #=======================================================================
 
 sub _delete_alias {
-   my($type,$name,$nowarn) = @_;
+   my($type,$name,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
 
    # Check that $name is used.
 
@@ -362,14 +552,19 @@ sub _delete_alias {
    if (exists $Data{$type}{'alias2id'}{lc($name)}) {
       ($id,$i) = @{ $Data{$type}{'alias2id'}{lc($name)} };
    } else {
-      carp "delete_${type}_alias(): name does not exist: $name\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "delete_${type}_alias(): name does not exist: $name\n";
+      }
       return 0;
    }
 
-   my $n = $#{ $Data{$type}{'id2names'}{$id} };
+   my $n = $#{ $Data{$type}{'id2names'}{$id} } + 1;
    if ($n == 1) {
-      carp "delete_${type}_alias(): only one name defined (use _delete_${type} instead)\n"
-        unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "delete_${type}_alias(): only one name defined (use _delete_${type} instead)\n";
+      }
       return 0;
    }
 
@@ -383,15 +578,15 @@ sub _delete_alias {
    #   Set to 0   if I = $i
    #   Decrement  if I > $i
 
-   foreach my $codeset (keys %{ $Data{'code2id'} }) {
-      foreach my $code (keys %{ $Data{'code2id'}{$codeset} }) {
-         my($jd,$j) = @{ $Data{'code2id'}{$codeset}{$code} };
+   foreach my $codeset (keys %{ $Data{$type}{'code2id'} }) {
+      foreach my $code (keys %{ $Data{$type}{'code2id'}{$codeset} }) {
+         my($jd,$j) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
          next  if ($jd ne $id  ||
                    $j < $i);
          if ($i == $j) {
-            $Data{'code2id'}{$codeset}{$code}[1] = 0;
+            $Data{$type}{'code2id'}{$codeset}{$code}[1] = 0;
          } else {
-            $Data{'code2id'}{$codeset}{$code}[1]--;
+            $Data{$type}{'code2id'}{$codeset}{$code}[1]--;
          }
       }
    }
@@ -409,20 +604,37 @@ sub _delete_alias {
 #=======================================================================
 
 sub _rename_code {
-   my($type,$code,$new_code,$codeset,$nowarn) = @_;
+   my($type,$code,$new_code,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   my $codeset  = shift(@args);
+   my $err;
+   ($err,$code,$codeset)     = _code($type,$code,$codeset);
 
    if (! $codeset) {
-      carp "rename_$type(): unknown codeset\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+         carp "rename_${type}_code(): unknown codeset\n"; # uncoverable statement
+      }
       return 0;
    }
 
-   $code = $Data{$type}{'codealias'}{$codeset}{$code}
-     if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+   ($err,$new_code,$codeset) = _code($type,$new_code,$codeset);
 
    # Check that $code exists in the codeset.
 
    if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
-      carp "rename_$type(): unknown code: $code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "rename_${type}_code(): unknown code: $code\n";
+      }
       return 0;
    }
 
@@ -449,13 +661,19 @@ sub _rename_code {
 
       } else {
          # Case 2
-         carp "rename_$type(): new code already in use: $new_code\n"  unless ($nowarn);
+         if (! $nowarn) {                                 # uncoverable branch true
+                                                          # uncoverable statement
+            carp "rename_${type}_code(): new code already in use: $new_code\n";
+         }
          return 0;
       }
 
    } elsif (exists $Data{$type}{'code2id'}{$codeset}{$new_code}) {
       # Case 3
-      carp "rename_$type(): new code already in use: $new_code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "rename_${type}_code(): new code already in use: $new_code\n";
+      }
       return 0;
    }
 
@@ -481,27 +699,48 @@ sub _rename_code {
 #=======================================================================
 
 sub _add_code_alias {
-   my($type,$code,$new_code,$codeset,$nowarn) = @_;
+   my($type,$code,$new_code,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   my $codeset  = shift(@args);
+   my $err;
+   ($err,$code,$codeset)     = _code($type,$code,$codeset);
 
    if (! $codeset) {
-      carp "add_${type}_code_alias(): unknown codeset\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "add_${type}_code_alias(): unknown codeset\n";
+      }
       return 0;
    }
 
-   $code = $Data{$type}{'codealias'}{$codeset}{$code}
-     if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+   ($err,$new_code,$codeset) = _code($type,$new_code,$codeset);
 
    # Check that $code exists in the codeset and that $new_code
    # does not exist.
 
    if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
-      carp "add_${type}_code_alias(): unknown code: $code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "add_${type}_code_alias(): unknown code: $code\n";
+      }
       return 0;
    }
 
    if (exists $Data{$type}{'code2id'}{$codeset}{$new_code}  ||
        exists $Data{$type}{'codealias'}{$codeset}{$new_code}) {
-      carp "add_${type}_code_alias(): code already in use: $new_code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "add_${type}_code_alias(): code already in use: $new_code\n";
+      }
       return 0;
    }
 
@@ -514,24 +753,43 @@ sub _add_code_alias {
 
 #=======================================================================
 #
-# _delete_code_alias ( TYPE,CODE,CODESET )
+# _delete_code_alias ( TYPE,ALIAS,CODESET )
 #
 # Deletes an alias for the code.
 #
 #=======================================================================
 
 sub _delete_code_alias {
-   my($type,$code,$codeset,$nowarn) = @_;
+   my($type,$code,@args) = @_;
+
+   # For tests, we'll ALWAYS have $nowarn
+   my $nowarn   = 0;
+   if (@args) {                                           # uncoverable branch false
+      if ($args[$#args] eq "nowarn") {                    # uncoverable branch false
+         $nowarn      = 1;
+         pop(@args);
+      }
+   }
+
+   my $codeset  = shift(@args);
+   my $err;
+   ($err,$code,$codeset)     = Locale::Codes::_code($type,$code,$codeset);
 
    if (! $codeset) {
-      carp "delete_${type}_code_alias(): unknown codeset\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "delete_${type}_code_alias(): unknown codeset\n";
+      }
       return 0;
    }
 
    # Check that $code exists in the codeset as an alias.
 
    if (! exists $Data{$type}{'codealias'}{$codeset}{$code}) {
-      carp "delete_${type}_code_alias(): no alias defined: $code\n"  unless ($nowarn);
+      if (! $nowarn) {                                    # uncoverable branch true
+                                                          # uncoverable statement
+         carp "delete_${type}_code_alias(): no alias defined: $code\n";
+      }
       return 0;
    }
 
@@ -542,79 +800,6 @@ sub _delete_code_alias {
    return 1;
 }
 
-#=======================================================================
-#
-# alias_code ( ALIAS => CODE [ , CODESET ] )
-#
-# Add an alias for an existing code. If the CODESET isn't specified,
-# then we use the default (currently the alpha-2 codeset).
-#
-#   Locale::Country::alias_code('uk' => 'gb');
-#
-#=======================================================================
-
-# sub alias_code {
-#    my $nowarn   = 0;
-#    $nowarn      = 1, pop  if ($_[$#_] eq "nowarn");
-#    my $alias    = shift;
-#    my $code     = shift;
-#    my $codeset  = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
-
-#    return 0  if ($codeset !~ /^\d+$/);
-
-#    if      ($codeset == LOCALE_CODE_ALPHA_2) {
-#       $codeset = "alpha2";
-#       $alias   = lc($alias);
-#    } elsif ($codeset == LOCALE_CODE_ALPHA_3) {
-#       $codeset = "alpha3";
-#       $alias   = lc($alias);
-#    } elsif ($codeset == LOCALE_CODE_FIPS) {
-#       $codeset = "fips";
-#       $alias   = uc($alias);
-#    } elsif ($codeset == LOCALE_CODE_NUMERIC) {
-#       $codeset = "num";
-#       return undef if ($alias =~ /\D/);
-#       $alias   = sprintf("%.3d", $alias);
-#    } else {
-#       carp "rename_country(): unknown codeset\n"  unless ($nowarn);
-#       return 0;
-#    }
-
-#    # Check that $code exists in the codeset.
-
-#    my ($id,$i);
-#    if (exists $Data{$type}{'code2id'}{$codeset}{$code}) {
-#       ($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
-#    } else {
-#       carp "alias_code: attempt to alias \"$alias\" to unknown country code \"$code\"\n"
-#       unless ($nowarn);
-#       return 0;
-#    }
-
-#    # Cases:
-#    #   The alias already exists.
-#    #      Error
-#    #
-#    #   It's new
-#    #      Create a new entry in Code2CountryID
-#    #      Replace the entiry in CountryID2Code
-#    #      Regenerate %Codes
-
-#    if (exists $Data{$type}{'code2id'}{$codeset}{$alias}) {
-#       carp "alias_code: attempt to alias \"$alias\" which is already in use\n"
-#       unless ($nowarn);
-#       return 0;
-#    }
-
-#    $Data{$type}{'code2id'}{$codeset}{$alias} = [ $id, $i ];
-#    $Data{$type}{'id2names'}ID2Code{$codeset}{$id} = $alias;
-
-#    my @codes = keys %{ $Data{$type}{'code2id'}{$codeset} };
-#    $Locale::CountryCodes::Codes{$codeset} = [ sort @codes ];
-
-#    return $alias;
-# }
-
 1;
 # Local Variables:
 # mode: cperl
@@ -624,5 +809,5 @@ sub _delete_code_alias {
 # cperl-continued-brace-offset: 0
 # cperl-brace-offset: 0
 # cperl-brace-imaginary-offset: 0
-# cperl-label-offset: -2
+# cperl-label-offset: 0
 # End: