summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Locale/Script.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Locale/Script.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Locale/Script.pm276
1 files changed, 20 insertions, 256 deletions
diff --git a/Master/tlpkg/tlperl/lib/Locale/Script.pm b/Master/tlpkg/tlperl/lib/Locale/Script.pm
index e83ad23c059..d389149fd93 100644
--- a/Master/tlpkg/tlperl/lib/Locale/Script.pm
+++ b/Master/tlpkg/tlperl/lib/Locale/Script.pm
@@ -1,275 +1,39 @@
package Locale::Script;
# Copyright (C) 2001 Canon Research Centre Europe (CRE).
# Copyright (C) 2002-2009 Neil Bowers
-# Copyright (c) 2010-2011 Sullivan Beck
+# Copyright (c) 2010-2012 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;
+use Exporter;
-require Exporter;
-use Carp;
-use Locale::Codes;
-use Locale::Constants;
-use Locale::Codes::Script;
+our $VERSION;
+$VERSION='3.21';
-#=======================================================================
-# Public Global Variables
-#=======================================================================
+our (@ISA,@EXPORT);
-our($VERSION,@ISA,@EXPORT,@EXPORT_OK);
+my $backend = 'Locale::Codes::Script';
+my $backend_exp = $backend . "::EXPORT";
-$VERSION='3.16';
-@ISA = qw(Exporter);
-@EXPORT = qw(code2script
- script2code
- all_script_codes
- all_script_names
- script_code2code
- LOCALE_SCRIPT_ALPHA
- LOCALE_SCRIPT_NUMERIC
- );
+eval "require $backend; $backend->import(); return 1;";
-sub _code {
- my($code,$codeset) = @_;
- $code = "" if (! $code);
-
- $codeset = LOCALE_SCRIPT_DEFAULT if (! defined($codeset) || $codeset eq "");
-
- if ($codeset =~ /^\d+$/) {
- if ($codeset == LOCALE_SCRIPT_ALPHA) {
- $codeset = "alpha";
- } elsif ($codeset == LOCALE_SCRIPT_NUMERIC) {
- $codeset = "num";
- } else {
- return (1);
- }
- }
-
- if ($codeset eq "alpha") {
- $code = ucfirst(lc($code));
- } elsif ($codeset eq "num") {
- if (defined($code) && $code ne "") {
- return (1) unless ($code =~ /^\d+$/);
- $code = sprintf("%.3d", $code);
- }
- } else {
- return (1);
- }
-
- return (0,$code,$codeset);
-}
-
-#=======================================================================
-#
-# code2script ( CODE [,CODESET] )
-#
-#=======================================================================
-
-sub code2script {
- my($err,$code,$codeset) = _code(@_);
- return undef if ($err ||
- ! defined $code);
-
- return Locale::Codes::_code2name("script",$code,$codeset);
-}
-
-#=======================================================================
-#
-# script2code ( SCRIPT [,CODESET] )
-#
-#=======================================================================
-
-sub script2code {
- my($script,$codeset) = @_;
- my($err,$tmp);
- ($err,$tmp,$codeset) = _code("",$codeset);
- return undef if ($err ||
- ! defined $script);
-
- return Locale::Codes::_name2code("script",$script,$codeset);
-}
-
-#=======================================================================
-#
-# script_code2code ( CODE,CODESET_IN,CODESET_OUT )
-#
-#=======================================================================
-
-sub script_code2code {
- (@_ == 3) or croak "script_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("script",$code,$inset,$outset);
-}
-
-#=======================================================================
-#
-# all_script_codes ( [CODESET] )
-#
-#=======================================================================
-
-sub all_script_codes {
- my($codeset) = @_;
- my($err,$tmp);
- ($err,$tmp,$codeset) = _code("",$codeset);
- return undef if ($err);
-
- return Locale::Codes::_all_codes("script",$codeset);
-}
-
-
-#=======================================================================
-#
-# all_script_names ( [CODESET] )
-#
-#=======================================================================
-
-sub all_script_names {
- my($codeset) = @_;
- my($err,$tmp);
- ($err,$tmp,$codeset) = _code("",$codeset);
- return undef if ($err);
-
- return Locale::Codes::_all_names("script",$codeset);
+{
+ no strict 'refs';
+ @EXPORT = @{ $backend_exp };
}
-#=======================================================================
-#
-# rename_script ( CODE,NAME [,CODESET] )
-#
-#=======================================================================
-
-sub rename_script {
- 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("script",$code,$new_name,$codeset,$nowarn);
-}
+unshift (@ISA, $backend);
-#=======================================================================
-#
-# add_script ( CODE,NAME [,CODESET] )
-#
-#=======================================================================
-
-sub add_script {
- 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("script",$code,$name,$codeset,$nowarn);
-}
-
-#=======================================================================
-#
-# delete_script ( CODE [,CODESET] )
-#
-#=======================================================================
-
-sub delete_script {
- 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("script",$code,$codeset,$nowarn);
-}
-
-#=======================================================================
-#
-# add_script_alias ( NAME,NEW_NAME )
-#
-#=======================================================================
-
-sub add_script_alias {
- my($name,$new_name,$nowarn) = @_;
- $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
-
- return Locale::Codes::_add_alias("script",$name,$new_name,$nowarn);
-}
-
-#=======================================================================
-#
-# delete_script_alias ( NAME )
-#
-#=======================================================================
-
-sub delete_script_alias {
- my($name,$nowarn) = @_;
- $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
-
- return Locale::Codes::_delete_alias("script",$name,$nowarn);
-}
-
-#=======================================================================
-#
-# rename_script_code ( CODE,NEW_CODE [,CODESET] )
-#
-#=======================================================================
-
-sub rename_script_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("script",$code,$new_code,$codeset,$nowarn);
-}
-
-#=======================================================================
-#
-# add_script_code_alias ( CODE,NEW_CODE [,CODESET] )
-#
-#=======================================================================
-
-sub add_script_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("script",$code,$new_code,$codeset,$nowarn);
-}
-
-#=======================================================================
-#
-# delete_script_code_alias ( CODE [,CODESET] )
-#
-#=======================================================================
-
-sub delete_script_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("script",$code,$codeset,$nowarn);
-}
+sub rename_script { Locale::Codes::Script::rename_script(@_) }
+sub add_script { Locale::Codes::Script::add_script(@_) }
+sub delete_script { Locale::Codes::Script::delete_script(@_) }
+sub add_script_alias { Locale::Codes::Script::add_script_alias(@_) }
+sub delete_script_alias { Locale::Codes::Script::delete_script_alias(@_) }
+sub rename_script_code { Locale::Codes::Script::rename_script_code(@_) }
+sub add_script_code_alias { Locale::Codes::Script::add_script_code_alias(@_) }
+sub delete_script_code_alias { Locale::Codes::Script::delete_script_code_alias(@_) }
1;
# Local Variables: