[p5sagit/p5-mst-13.2.git] / cpan / Locale-Codes / lib / Locale / Language.pm

package Locale::Language;
# Copyright (C) 2001      Canon Research Centre Europe (CRE).
# Copyright (C) 2002-2009 Neil Bowers
# Copyright (c) 2010-2010 Sullivan Beck
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

use strict;
use warnings;
require 5.002;

require Exporter;
use Carp;
use Locale::Codes;
use Locale::Constants;
use Locale::Codes::Language;

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

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION='3.12';
@ISA       = qw(Exporter);
@EXPORT    = qw(code2language
                language2code
                all_language_codes
                all_language_names
                language_code2code
                LOCALE_LANG_ALPHA_2
                LOCALE_LANG_ALPHA_3
                LOCALE_LANG_TERM
               );

sub _code {
   my($code,$codeset) = @_;
   $code = ""  if (! $code);

   $codeset = LOCALE_LANG_DEFAULT  if (! defined($codeset)  ||  $codeset eq "");

   if ($codeset =~ /^\d+$/) {
      if      ($codeset ==  LOCALE_LANG_ALPHA_2) {
         $codeset = "alpha2";
      } elsif ($codeset ==  LOCALE_LANG_ALPHA_3) {
         $codeset = "alpha3";
      } elsif ($codeset ==  LOCALE_LANG_TERM) {
         $codeset = "term";
      } else {
         return (1);
      }
   }

   if      ($codeset eq "alpha2"  ||
            $codeset eq "alpha3"  ||
            $codeset eq "term") {
      $code    = lc($code);
   } else {
      return (1);
   }

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

#=======================================================================
#
# code2language ( CODE [,CODESET] )
#
#=======================================================================

sub code2language {
   my($err,$code,$codeset) = _code(@_);
   return undef  if ($err  ||
                     ! defined $code);

   return Locale::Codes::_code2name("language",$code,$codeset);
}

#=======================================================================
#
# language2code ( LANGUAGE [,CODESET] )
#
#=======================================================================

sub language2code {
   my($language,$codeset) = @_;
   my($err,$tmp);
   ($err,$tmp,$codeset) = _code("",$codeset);
   return undef  if ($err  ||
                     ! defined $language);

   return Locale::Codes::_name2code("language",$language,$codeset);
}

#=======================================================================
#
# language_code2code ( CODE,CODESET_IN,CODESET_OUT )
#
#=======================================================================

sub language_code2code {
   (@_ == 3) or croak "language_code2code() takes 3 arguments!";
   my($code,$inset,$outset) = @_;
   my($err,$tmp);
   ($err,$code,$inset) = _code($code,$inset);
   return undef  if ($err);
   ($err,$tmp,$outset) = _code("",$outset);
   return undef  if ($err);

   return Locale::Codes::_code2code("language",$code,$inset,$outset);
}

#=======================================================================
#
# all_language_codes ( [CODESET] )
#
#=======================================================================

sub all_language_codes {
   my($codeset) = @_;
   my($err,$tmp);
   ($err,$tmp,$codeset) = _code("",$codeset);
   return undef  if ($err);

   return Locale::Codes::_all_codes("language",$codeset);
}


#=======================================================================
#
# all_language_names ( [CODESET] )
#
#=======================================================================

sub all_language_names {
   my($codeset) = @_;
   my($err,$tmp);
   ($err,$tmp,$codeset) = _code("",$codeset);
   return undef  if ($err);

   return Locale::Codes::_all_names("language",$codeset);
}

#=======================================================================
#
# rename_language ( CODE,NAME [,CODESET] )
#
#=======================================================================

sub rename_language {
   my($code,$new_name,@args) = @_;
   my $nowarn   = 0;
   $nowarn      = 1, pop(@args)  if ($args[$#args] eq "nowarn");
   my $codeset  = shift(@args);
   my $err;
   ($err,$code,$codeset) = _code($code,$codeset);

   return Locale::Codes::_rename("language",$code,$new_name,$codeset,$nowarn);
}

#=======================================================================
#
# add_language ( CODE,NAME [,CODESET] )
#
#=======================================================================

sub add_language {
   my($code,$name,@args) = @_;
   my $nowarn   = 0;
   $nowarn      = 1, pop(@args)  if ($args[$#args] eq "nowarn");
   my $codeset  = shift(@args);
   my $err;
   ($err,$code,$codeset) = _code($code,$codeset);

   return Locale::Codes::_add_code("language",$code,$name,$codeset,$nowarn);
}

#=======================================================================
#
# delete_language ( CODE [,CODESET] )
#
#=======================================================================

sub delete_language {
   my($code,@args) = @_;
   my $nowarn   = 0;
   $nowarn      = 1, pop(@args)  if ($args[$#args] eq "nowarn");
   my $codeset  = shift(@args);
   my $err;
   ($err,$code,$codeset) = _code($code,$codeset);

   return Locale::Codes::_delete_code("language",$code,$codeset,$nowarn);
}

#=======================================================================
#
# add_language_alias ( NAME,NEW_NAME )
#
#=======================================================================

sub add_language_alias {
   my($name,$new_name,$nowarn) = @_;
   $nowarn   = (defined($nowarn)  &&  $nowarn eq "nowarn" ? 1 : 0);

   return Locale::Codes::_add_alias("language",$name,$new_name,$nowarn);
}

#=======================================================================
#
# delete_language_alias ( NAME )
#
#=======================================================================

sub delete_language_alias {
   my($name,$nowarn) = @_;
   $nowarn   = (defined($nowarn)  &&  $nowarn eq "nowarn" ? 1 : 0);

   return Locale::Codes::_delete_alias("language",$name,$nowarn);
}

#=======================================================================
#
# rename_language_code ( CODE,NEW_CODE [,CODESET] )
#
#=======================================================================

sub rename_language_code {
   my($code,$new_code,@args) = @_;
   my $nowarn   = 0;
   $nowarn      = 1, pop(@args)  if ($args[$#args] eq "nowarn");
   my $codeset  = shift(@args);
   my $err;
   ($err,$code,$codeset)     = _code($code,$codeset);
   ($err,$new_code,$codeset) = _code($new_code,$codeset)  if (! $err);

   return Locale::Codes::_rename_code("language",$code,$new_code,$codeset,$nowarn);
}

#=======================================================================
#
# add_language_code_alias ( CODE,NEW_CODE [,CODESET] )
#
#=======================================================================

sub add_language_code_alias {
   my($code,$new_code,@args) = @_;
   my $nowarn   = 0;
   $nowarn      = 1, pop(@args)  if ($args[$#args] eq "nowarn");
   my $codeset  = shift(@args);
   my $err;
   ($err,$code,$codeset)     = _code($code,$codeset);
   ($err,$new_code,$codeset) = _code($new_code,$codeset)  if (! $err);

   return Locale::Codes::_add_code_alias("language",$code,$new_code,$codeset,$nowarn);
}

#=======================================================================
#
# delete_language_code_alias ( CODE [,CODESET] )
#
#=======================================================================

sub delete_language_code_alias {
   my($code,@args) = @_;
   my $nowarn   = 0;
   $nowarn      = 1, pop(@args)  if ($args[$#args] eq "nowarn");
   my $codeset  = shift(@args);
   my $err;
   ($err,$code,$codeset)     = _code($code,$codeset);

   return Locale::Codes::_delete_code_alias("language",$code,$codeset,$nowarn);
}

1;
# Local Variables:
# mode: cperl
# indent-tabs-mode: nil
# cperl-indent-level: 3
# cperl-continued-statement-offset: 2
# cperl-continued-brace-offset: 0
# cperl-brace-offset: 0
# cperl-brace-imaginary-offset: 0
# cperl-label-offset: -2
# End:
Commit	Line	Data
47a334e9	1	package Locale::Language;
f768f60b	2	# Copyright (C) 2001 Canon Research Centre Europe (CRE).
	3	# Copyright (C) 2002-2009 Neil Bowers
	4	# Copyright (c) 2010-2010 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
47a334e9	8	use strict;
f768f60b	9	use warnings;
47a334e9	10	require 5.002;
47a334e9	11
47a334e9	12	require Exporter;
f768f60b	13	use Carp;
	14	use Locale::Codes;
	15	use Locale::Constants;
	16	use Locale::Codes::Language;
47a334e9	17
f768f60b	18	#=======================================================================
	19	# Public Global Variables
	20	#=======================================================================
47a334e9	21
f768f60b	22	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
	23
	24	$VERSION='3.12';
	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	}
47a334e9	64
f768f60b	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	}
47a334e9	78
47a334e9	79	#=======================================================================
6b14ceb7	80	#
f768f60b	81	# language2code ( LANGUAGE [,CODESET] )
6b14ceb7	82	#
47a334e9	83	#=======================================================================
f768f60b	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);
47a334e9	93	}
47a334e9	94
f768f60b	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	}
6b14ceb7	112
	113	#=======================================================================
	114	#
f768f60b	115	# all_language_codes ( [CODESET] )
6b14ceb7	116	#
6b14ceb7	117	#=======================================================================
f768f60b	118
	119	sub all_language_codes {
	120	my($codeset) = @_;
	121	my($err,$tmp);
	122	($err,$tmp,$codeset) = _code("",$codeset);
	123	return undef if ($err);
	124
	125	return Locale::Codes::_all_codes("language",$codeset);
47a334e9	126	}
47a334e9	127
47a334e9	128
47a334e9	129	#=======================================================================
6b14ceb7	130	#
f768f60b	131	# all_language_names ( [CODESET] )
6b14ceb7	132	#
6b14ceb7	133	#=======================================================================
f768f60b	134
	135	sub all_language_names {
	136	my($codeset) = @_;
	137	my($err,$tmp);
	138	($err,$tmp,$codeset) = _code("",$codeset);
	139	return undef if ($err);
	140
	141	return Locale::Codes::_all_names("language",$codeset);
47a334e9	142	}
47a334e9	143
f768f60b	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] 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	}
6b14ceb7	160
	161	#=======================================================================
	162	#
f768f60b	163	# add_language ( CODE,NAME [,CODESET] )
6b14ceb7	164	#
6b14ceb7	165	#=======================================================================
f768f60b	166
	167	sub add_language {
	168	my($code,$name,@args) = @_;
	169	my $nowarn = 0;
	170	$nowarn = 1, pop(@args) if ($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);
47a334e9	176	}
47a334e9	177
f768f60b	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] 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	}
47a334e9	194
47a334e9	195	#=======================================================================
f768f60b	196	#
	197	# add_language_alias ( NAME,NEW_NAME )
	198	#
47a334e9	199	#=======================================================================
f768f60b	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);
47a334e9	206	}
47a334e9	207
f768f60b	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	#=======================================================================
47a334e9	226
f768f60b	227	sub rename_language_code {
	228	my($code,$new_code,@args) = @_;
	229	my $nowarn = 0;
	230	$nowarn = 1, pop(@args) if ($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] 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] 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: