1 package Locale::Script;
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.
15 use Locale::Constants;
16 use Locale::Codes::Script;
18 #=======================================================================
19 # Public Global Variables
20 #=======================================================================
22 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
26 @EXPORT = qw(code2script
36 my($code,$codeset) = @_;
37 $code = "" if (! $code);
39 $codeset = LOCALE_SCRIPT_DEFAULT if (! defined($codeset) || $codeset eq "");
41 if ($codeset =~ /^\d+$/) {
42 if ($codeset == LOCALE_SCRIPT_ALPHA) {
44 } elsif ($codeset == LOCALE_SCRIPT_NUMERIC) {
51 if ($codeset eq "alpha") {
52 $code = ucfirst(lc($code));
53 } elsif ($codeset eq "num") {
54 if (defined($code) && $code ne "") {
55 return (1) unless ($code =~ /^\d+$/);
56 $code = sprintf("%.3d", $code);
62 return (0,$code,$codeset);
65 #=======================================================================
67 # code2script ( CODE [,CODESET] )
69 #=======================================================================
72 my($err,$code,$codeset) = _code(@_);
73 return undef if ($err ||
76 return Locale::Codes::_code2name("script",$code,$codeset);
79 #=======================================================================
81 # script2code ( SCRIPT [,CODESET] )
83 #=======================================================================
86 my($script,$codeset) = @_;
88 ($err,$tmp,$codeset) = _code("",$codeset);
89 return undef if ($err ||
92 return Locale::Codes::_name2code("script",$script,$codeset);
95 #=======================================================================
97 # script_code2code ( CODE,CODESET_IN,CODESET_OUT )
99 #=======================================================================
101 sub script_code2code {
102 (@_ == 3) or croak "script_code2code() takes 3 arguments!";
103 my($code,$inset,$outset) = @_;
105 ($err,$code,$inset) = _code($code,$inset);
106 return undef if ($err);
107 ($err,$tmp,$outset) = _code("",$outset);
108 return undef if ($err);
110 return Locale::Codes::_code2code("script",$code,$inset,$outset);
113 #=======================================================================
115 # all_script_codes ( [CODESET] )
117 #=======================================================================
119 sub all_script_codes {
122 ($err,$tmp,$codeset) = _code("",$codeset);
123 return undef if ($err);
125 return Locale::Codes::_all_codes("script",$codeset);
129 #=======================================================================
131 # all_script_names ( [CODESET] )
133 #=======================================================================
135 sub all_script_names {
138 ($err,$tmp,$codeset) = _code("",$codeset);
139 return undef if ($err);
141 return Locale::Codes::_all_names("script",$codeset);
144 #=======================================================================
146 # rename_script ( CODE,NAME [,CODESET] )
148 #=======================================================================
151 my($code,$new_name,@args) = @_;
153 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
154 my $codeset = shift(@args);
156 ($err,$code,$codeset) = _code($code,$codeset);
158 return Locale::Codes::_rename("script",$code,$new_name,$codeset,$nowarn);
161 #=======================================================================
163 # add_script ( CODE,NAME [,CODESET] )
165 #=======================================================================
168 my($code,$name,@args) = @_;
170 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
171 my $codeset = shift(@args);
173 ($err,$code,$codeset) = _code($code,$codeset);
175 return Locale::Codes::_add_code("script",$code,$name,$codeset,$nowarn);
178 #=======================================================================
180 # delete_script ( CODE [,CODESET] )
182 #=======================================================================
185 my($code,@args) = @_;
187 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
188 my $codeset = shift(@args);
190 ($err,$code,$codeset) = _code($code,$codeset);
192 return Locale::Codes::_delete_code("script",$code,$codeset,$nowarn);
195 #=======================================================================
197 # add_script_alias ( NAME,NEW_NAME )
199 #=======================================================================
201 sub add_script_alias {
202 my($name,$new_name,$nowarn) = @_;
203 $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
205 return Locale::Codes::_add_alias("script",$name,$new_name,$nowarn);
208 #=======================================================================
210 # delete_script_alias ( NAME )
212 #=======================================================================
214 sub delete_script_alias {
215 my($name,$nowarn) = @_;
216 $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
218 return Locale::Codes::_delete_alias("script",$name,$nowarn);
221 #=======================================================================
223 # rename_script_code ( CODE,NEW_CODE [,CODESET] )
225 #=======================================================================
227 sub rename_script_code {
228 my($code,$new_code,@args) = @_;
230 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
231 my $codeset = shift(@args);
233 ($err,$code,$codeset) = _code($code,$codeset);
234 ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
236 return Locale::Codes::_rename_code("script",$code,$new_code,$codeset,$nowarn);
239 #=======================================================================
241 # add_script_code_alias ( CODE,NEW_CODE [,CODESET] )
243 #=======================================================================
245 sub add_script_code_alias {
246 my($code,$new_code,@args) = @_;
248 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
249 my $codeset = shift(@args);
251 ($err,$code,$codeset) = _code($code,$codeset);
252 ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
254 return Locale::Codes::_add_code_alias("script",$code,$new_code,$codeset,$nowarn);
257 #=======================================================================
259 # delete_script_code_alias ( CODE [,CODESET] )
261 #=======================================================================
263 sub delete_script_code_alias {
264 my($code,@args) = @_;
266 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
267 my $codeset = shift(@args);
269 ($err,$code,$codeset) = _code($code,$codeset);
271 return Locale::Codes::_delete_code_alias("script",$code,$codeset,$nowarn);
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