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

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