cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm

   1 package Locale::Codes::LangExt;
   2 # Copyright (c) 2011-2011 Sullivan Beck
   3 # This program is free software; you can redistribute it and/or modify it
   4 # under the same terms as Perl itself.
   5
   6 use strict;
   7 use warnings;
   8 require 5.002;
   9
  10 require Exporter;
  11 use Carp;
  12 use Locale::Codes;
  13 use Locale::Codes::Constants;
  14 use Locale::Codes::LangExt_Codes;
  15
  16 #=======================================================================
  17 #       Public Global Variables
  18 #=======================================================================
  19
  20 our($VERSION,@ISA,@EXPORT,@EXPORT_OK);
  21
  22 $VERSION='3.18';
  23 @ISA       = qw(Exporter);
  24 @EXPORT    = qw(code2langext
  25                 langext2code
  26                 all_langext_codes
  27                 all_langext_names
  28                 langext_code2code
  29                 LOCALE_LANGEXT_ALPHA
  30                );
  31
  32 sub _code {
  33    my($code,$codeset) = @_;
  34    $code = ""  if (! $code);
  35
  36    $codeset = LOCALE_LANGEXT_DEFAULT  if (! defined($codeset)  ||  $codeset eq "");
  37
  38    if ($codeset =~ /^\d+$/) {
  39       if      ($codeset ==  LOCALE_LANGEXT_ALPHA) {
  40          $codeset = "alpha";
  41       } else {
  42          return (1);
  43       }
  44    }
  45
  46    if      ($codeset eq "alpha") {
  47       $code    = lc($code);
  48    } else {
  49       return (1);
  50    }
  51
  52    return (0,$code,$codeset);
  53 }
  54
  55 #=======================================================================
  56 #
  57 # code2langext ( CODE [,CODESET] )
  58 #
  59 #=======================================================================
  60
  61 sub code2langext {
  62    my($err,$code,$codeset) = _code(@_);
  63    return undef  if ($err  ||
  64                      ! defined $code);
  65
  66    return Locale::Codes::_code2name("langext",$code,$codeset);
  67 }
  68
  69 #=======================================================================
  70 #
  71 # langext2code ( LANGEXT [,CODESET] )
  72 #
  73 #=======================================================================
  74
  75 sub langext2code {
  76    my($langext,$codeset) = @_;
  77    my($err,$tmp);
  78    ($err,$tmp,$codeset) = _code("",$codeset);
  79    return undef  if ($err  ||
  80                      ! defined $langext);
  81
  82    return Locale::Codes::_name2code("langext",$langext,$codeset);
  83 }
  84
  85 #=======================================================================
  86 #
  87 # langext_code2code ( CODE,CODESET_IN,CODESET_OUT )
  88 #
  89 #=======================================================================
  90
  91 sub langext_code2code {
  92    (@_ == 3) or croak "langext_code2code() takes 3 arguments!";
  93    my($code,$inset,$outset) = @_;
  94    my($err,$tmp);
  95    ($err,$code,$inset) = _code($code,$inset);
  96    return undef  if ($err);
  97    ($err,$tmp,$outset) = _code("",$outset);
  98    return undef  if ($err);
  99
 100    return Locale::Codes::_code2code("langext",$code,$inset,$outset);
 101 }
 102
 103 #=======================================================================
 104 #
 105 # all_langext_codes ( [CODESET] )
 106 #
 107 #=======================================================================
 108
 109 sub all_langext_codes {
 110    my($codeset) = @_;
 111    my($err,$tmp);
 112    ($err,$tmp,$codeset) = _code("",$codeset);
 113    return ()  if ($err);
 114
 115    return Locale::Codes::_all_codes("langext",$codeset);
 116 }
 117
 118
 119 #=======================================================================
 120 #
 121 # all_langext_names ( [CODESET] )
 122 #
 123 #=======================================================================
 124
 125 sub all_langext_names {
 126    my($codeset) = @_;
 127    my($err,$tmp);
 128    ($err,$tmp,$codeset) = _code("",$codeset);
 129    return ()  if ($err);
 130
 131    return Locale::Codes::_all_names("langext",$codeset);
 132 }
 133
 134 #=======================================================================
 135 #
 136 # rename_langext ( CODE,NAME [,CODESET] )
 137 #
 138 #=======================================================================
 139
 140 sub rename_langext {
 141    my($code,$new_name,@args) = @_;
 142    my $nowarn   = 0;
 143    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 144    my $codeset  = shift(@args);
 145    my $err;
 146    ($err,$code,$codeset) = _code($code,$codeset);
 147
 148    return Locale::Codes::_rename("langext",$code,$new_name,$codeset,$nowarn);
 149 }
 150
 151 #=======================================================================
 152 #
 153 # add_langext ( CODE,NAME [,CODESET] )
 154 #
 155 #=======================================================================
 156
 157 sub add_langext {
 158    my($code,$name,@args) = @_;
 159    my $nowarn   = 0;
 160    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 161    my $codeset  = shift(@args);
 162    my $err;
 163    ($err,$code,$codeset) = _code($code,$codeset);
 164
 165    return Locale::Codes::_add_code("langext",$code,$name,$codeset,$nowarn);
 166 }
 167
 168 #=======================================================================
 169 #
 170 # delete_langext ( CODE [,CODESET] )
 171 #
 172 #=======================================================================
 173
 174 sub delete_langext {
 175    my($code,@args) = @_;
 176    my $nowarn   = 0;
 177    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 178    my $codeset  = shift(@args);
 179    my $err;
 180    ($err,$code,$codeset) = _code($code,$codeset);
 181
 182    return Locale::Codes::_delete_code("langext",$code,$codeset,$nowarn);
 183 }
 184
 185 #=======================================================================
 186 #
 187 # add_langext_alias ( NAME,NEW_NAME )
 188 #
 189 #=======================================================================
 190
 191 sub add_langext_alias {
 192    my($name,$new_name,$nowarn) = @_;
 193    $nowarn   = (defined($nowarn)  &&  $nowarn eq "nowarn" ? 1 : 0);
 194
 195    return Locale::Codes::_add_alias("langext",$name,$new_name,$nowarn);
 196 }
 197
 198 #=======================================================================
 199 #
 200 # delete_langext_alias ( NAME )
 201 #
 202 #=======================================================================
 203
 204 sub delete_langext_alias {
 205    my($name,$nowarn) = @_;
 206    $nowarn   = (defined($nowarn)  &&  $nowarn eq "nowarn" ? 1 : 0);
 207
 208    return Locale::Codes::_delete_alias("langext",$name,$nowarn);
 209 }
 210
 211 #=======================================================================
 212 #
 213 # rename_langext_code ( CODE,NEW_CODE [,CODESET] )
 214 #
 215 #=======================================================================
 216
 217 sub rename_langext_code {
 218    my($code,$new_code,@args) = @_;
 219    my $nowarn   = 0;
 220    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 221    my $codeset  = shift(@args);
 222    my $err;
 223    ($err,$code,$codeset)     = _code($code,$codeset);
 224    ($err,$new_code,$codeset) = _code($new_code,$codeset)  if (! $err);
 225
 226    return Locale::Codes::_rename_code("langext",$code,$new_code,$codeset,$nowarn);
 227 }
 228
 229 #=======================================================================
 230 #
 231 # add_langext_code_alias ( CODE,NEW_CODE [,CODESET] )
 232 #
 233 #=======================================================================
 234
 235 sub add_langext_code_alias {
 236    my($code,$new_code,@args) = @_;
 237    my $nowarn   = 0;
 238    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 239    my $codeset  = shift(@args);
 240    my $err;
 241    ($err,$code,$codeset)     = _code($code,$codeset);
 242    ($err,$new_code,$codeset) = _code($new_code,$codeset)  if (! $err);
 243
 244    return Locale::Codes::_add_code_alias("langext",$code,$new_code,$codeset,$nowarn);
 245 }
 246
 247 #=======================================================================
 248 #
 249 # delete_langext_code_alias ( CODE [,CODESET] )
 250 #
 251 #=======================================================================
 252
 253 sub delete_langext_code_alias {
 254    my($code,@args) = @_;
 255    my $nowarn   = 0;
 256    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 257    my $codeset  = shift(@args);
 258    my $err;
 259    ($err,$code,$codeset)     = _code($code,$codeset);
 260
 261    return Locale::Codes::_delete_code_alias("langext",$code,$codeset,$nowarn);
 262 }
 263
 264 1;
 265 # Local Variables:
 266 # mode: cperl
 267 # indent-tabs-mode: nil
 268 # cperl-indent-level: 3
 269 # cperl-continued-statement-offset: 2
 270 # cperl-continued-brace-offset: 0
 271 # cperl-brace-offset: 0
 272 # cperl-brace-imaginary-offset: 0
 273 # cperl-label-offset: -2
 274 # End: