1 files changed, 127 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Encode/compat/common.pm b/Master/tlpkg/tlperl/lib/Encode/compat/common.pm
new file mode 100644
index 00000000000..f9ba21cb67d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Encode/compat/common.pm
@@ -0,0 +1,127 @@
+# $File: //member/autrijus/Encode-compat/lib/Encode/compat/common.pm $ $Author: autrijus $
+# $Revision: #7 $ $Change: 10024 $ $DateTime: 2004/02/13 21:42:35 $
+
+package Encode::compat::common;
+our $VERSION = '0.06';
+
+1;
+
+package Encode;
+
+use strict;
+our $VERSION = '0.06';
+
+our @EXPORT = qw(
+  decode  decode_utf8  encode  encode_utf8
+  encodings  find_encoding
+);
+
+use constant DIE_ON_ERR		=> 1;
+use constant WARN_ON_ERR	=> 2;
+use constant RETURN_ON_ERR	=> 4;
+use constant LEAVE_SRC		=> 8;
+
+use constant PERLQQ		=> 256;
+use constant HTMLCREF		=> 512;
+use constant XMLCREF		=> 1024;
+
+use constant FB_DEFAULT		=> 0;
+use constant FB_CROAK		=> 1;
+use constant FB_QUIET		=> 4;
+use constant FB_WARN		=> 6;
+use constant FB_PERLQQ		=> 256;
+use constant FB_HTMLCREF	=> 512;
+use constant FB_XMLCREF		=> 1024;
+
+our @FB_FLAGS  = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
+                    PERLQQ HTMLCREF XMLCREF);
+our @FB_CONSTS = qw(FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
+                    FB_PERLQQ FB_HTMLCREF FB_XMLCREF);
+
+our @EXPORT_OK =
+    (
+     qw(
+       _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit
+       is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade
+      ),
+     @FB_FLAGS, @FB_CONSTS,
+    );
+
+our %EXPORT_TAGS =
+    (
+     all          =>  [ @EXPORT, @EXPORT_OK ],
+     fallbacks    =>  [ @FB_CONSTS ],
+     fallback_all =>  [ @FB_CONSTS, @FB_FLAGS ],
+    );
+
+sub from_to ($$$;$) {
+    use utf8;
+
+    # XXX: bad hack
+    if ($_[3] and $_[3] == FB_HTMLCREF() and lc($_[2]) eq 'latin1') {
+	$_[0] = join('', map {
+	    ord($_) < 128
+		? $_ : '&#' . ord($_) . ';'
+	} split(//, decode($_[1], $_[0])));
+    }
+    else {
+	$_[0] = _convert(@_[0..2]);
+    }
+}
+
+sub encodings {
+    # XXX: revisit
+    require Encode::Alias;
+    return sort values %Encode::Alias::Alias;
+}
+
+sub find_encoding {
+    return $_[0];
+}
+
+sub decode_utf8($;$) {
+    return decode("utf-8", @_);
+}
+
+sub encode_utf8($;$) {
+    return encode("utf-8", @_);
+}
+
+sub decode($$;$) {
+    my $result = ($_[0] =~ /utf-?8/i)
+	? $_[1] : _convert($_[1], $_[0] => 'utf-8'); 
+    _utf8_on($result);
+    return $result;
+}
+
+sub encode($$;$) {
+    my $result = ($_[0] =~ /utf-?8/i)
+	? $_[1] : _convert($_[1], 'utf-8' => $_[0]);
+    _utf8_off($result);
+    return $result;
+}
+
+{
+    my %decoder;
+    sub _convert {
+	require Text::Iconv;
+	Text::Iconv->raise_error(1);
+
+	require Encode::Alias;
+	my ($from, $to) = map {
+	    s/^utf8$/utf-8/i;
+	    s/^big5-eten$/big5/i;
+	    $_;
+	} map {
+	    Encode::Alias->find_alias($_) || lc($_)
+	} ($_[1], $_[2]);
+
+	my $result = ($from eq $to) ? $_[0] : (
+	    $decoder{$from, $to} ||= Text::Iconv->new( $from, $to )
+	)->convert($_[0]);
+
+	return $result;
+    }
+}
+
+1;