diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
commit | 661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch) | |
tree | 2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl.straw/lib/Encode | |
parent | b645030efc22e13c2498a1522083634ab91b2de1 (diff) |
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Encode')
32 files changed, 0 insertions, 5321 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Alias.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Alias.pm deleted file mode 100755 index f142403ca9c..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Alias.pm +++ /dev/null @@ -1,377 +0,0 @@ -package Encode::Alias; -use strict; -use warnings; -no warnings 'redefine'; -our $VERSION = do { my @r = ( q$Revision: 2.12 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; -sub DEBUG () { 0 } - -use base qw(Exporter); - -# Public, encouraged API is exported by default - -our @EXPORT = - qw ( - define_alias - find_alias -); - -our @Alias; # ordered matching list -our %Alias; # cached known aliases - -sub find_alias { - require Encode; - my $class = shift; - my $find = shift; - unless ( exists $Alias{$find} ) { - $Alias{$find} = undef; # Recursion guard - for ( my $i = 0 ; $i < @Alias ; $i += 2 ) { - my $alias = $Alias[$i]; - my $val = $Alias[ $i + 1 ]; - my $new; - if ( ref($alias) eq 'Regexp' && $find =~ $alias ) { - DEBUG and warn "eval $val"; - $new = eval $val; - DEBUG and $@ and warn "$val, $@"; - } - elsif ( ref($alias) eq 'CODE' ) { - DEBUG and warn "$alias", "->", "($find)"; - $new = $alias->($find); - } - elsif ( lc($find) eq lc($alias) ) { - $new = $val; - } - if ( defined($new) ) { - next if $new eq $find; # avoid (direct) recursion on bugs - DEBUG and warn "$alias, $new"; - my $enc = - ( ref($new) ) ? $new : Encode::find_encoding($new); - if ($enc) { - $Alias{$find} = $enc; - last; - } - } - } - - # case insensitive search when canonical is not in all lowercase - # RT ticket #7835 - unless ( $Alias{$find} ) { - my $lcfind = lc($find); - for my $name ( keys %Encode::Encoding, keys %Encode::ExtModule ) - { - $lcfind eq lc($name) or next; - $Alias{$find} = Encode::find_encoding($name); - DEBUG and warn "$find => $name"; - } - } - } - if (DEBUG) { - my $name; - if ( my $e = $Alias{$find} ) { - $name = $e->name; - } - else { - $name = ""; - } - warn "find_alias($class, $find)->name = $name"; - } - return $Alias{$find}; -} - -sub define_alias { - while (@_) { - my ( $alias, $name ) = splice( @_, 0, 2 ); - unshift( @Alias, $alias => $name ); # newer one has precedence - if ( ref($alias) ) { - - # clear %Alias cache to allow overrides - my @a = keys %Alias; - for my $k (@a) { - if ( ref($alias) eq 'Regexp' && $k =~ $alias ) { - DEBUG and warn "delete \$Alias\{$k\}"; - delete $Alias{$k}; - } - elsif ( ref($alias) eq 'CODE' ) { - DEBUG and warn "delete \$Alias\{$k\}"; - delete $Alias{ $alias->($name) }; - } - } - } - else { - DEBUG and warn "delete \$Alias\{$alias\}"; - delete $Alias{$alias}; - } - } -} - -# Allow latin-1 style names as well -# 0 1 2 3 4 5 6 7 8 9 10 -our @Latin2iso = ( 0, 1, 2, 3, 4, 9, 10, 13, 14, 15, 16 ); - -# Allow winlatin1 style names as well -our %Winlatin2cp = ( - 'latin1' => 1252, - 'latin2' => 1250, - 'cyrillic' => 1251, - 'greek' => 1253, - 'turkish' => 1254, - 'hebrew' => 1255, - 'arabic' => 1256, - 'baltic' => 1257, - 'vietnamese' => 1258, -); - -init_aliases(); - -sub undef_aliases { - @Alias = (); - %Alias = (); -} - -sub init_aliases { - require Encode; - undef_aliases(); - - # Try all-lower-case version should all else fails - define_alias( qr/^(.*)$/ => '"\L$1"' ); - - # UTF/UCS stuff - define_alias( qr/^(unicode-1-1-)?UTF-?7$/i => '"UTF-7"' ); - define_alias( qr/^UCS-?2-?LE$/i => '"UCS-2LE"' ); - define_alias( - qr/^UCS-?2-?(BE)?$/i => '"UCS-2BE"', - qr/^UCS-?4-?(BE|LE)?$/i => 'uc("UTF-32$1")', - qr/^iso-10646-1$/i => '"UCS-2BE"' - ); - define_alias( - qr/^UTF-?(16|32)-?BE$/i => '"UTF-$1BE"', - qr/^UTF-?(16|32)-?LE$/i => '"UTF-$1LE"', - qr/^UTF-?(16|32)$/i => '"UTF-$1"', - ); - - # ASCII - define_alias( qr/^(?:US-?)ascii$/i => '"ascii"' ); - define_alias( 'C' => 'ascii' ); - define_alias( qr/\b(?:ISO[-_]?)?646(?:[-_]?US)?$/i => '"ascii"' ); - - # Allow variants of iso-8859-1 etc. - define_alias( qr/\biso[-_]?(\d+)[-_](\d+)$/i => '"iso-$1-$2"' ); - - # At least HP-UX has these. - define_alias( qr/\biso8859(\d+)$/i => '"iso-8859-$1"' ); - - # More HP stuff. - define_alias( - qr/\b(?:hp-)?(arabic|greek|hebrew|kana|roman|thai|turkish)8$/i => - '"${1}8"' ); - - # The Official name of ASCII. - define_alias( qr/\bANSI[-_]?X3\.4[-_]?1968$/i => '"ascii"' ); - - # This is a font issue, not an encoding issue. - # (The currency symbol of the Latin 1 upper half - # has been redefined as the euro symbol.) - define_alias( qr/^(.+)\@euro$/i => '"$1"' ); - - define_alias( qr/\b(?:iso[-_]?)?latin[-_]?(\d+)$/i => -'defined $Encode::Alias::Latin2iso[$1] ? "iso-8859-$Encode::Alias::Latin2iso[$1]" : undef' - ); - - define_alias( - qr/\bwin(latin[12]|cyrillic|baltic|greek|turkish| - hebrew|arabic|baltic|vietnamese)$/ix => - '"cp" . $Encode::Alias::Winlatin2cp{lc($1)}' - ); - - # Common names for non-latin preferred MIME names - define_alias( - 'ascii' => 'US-ascii', - 'cyrillic' => 'iso-8859-5', - 'arabic' => 'iso-8859-6', - 'greek' => 'iso-8859-7', - 'hebrew' => 'iso-8859-8', - 'thai' => 'iso-8859-11', - ); - # RT #20781 - define_alias(qr/\btis-?620\b/i => '"iso-8859-11"'); - - # At least AIX has IBM-NNN (surprisingly...) instead of cpNNN. - # And Microsoft has their own naming (again, surprisingly). - # And windows-* is registered in IANA! - define_alias( - qr/\b(?:cp|ibm|ms|windows)[-_ ]?(\d{2,4})$/i => '"cp$1"' ); - - # Sometimes seen with a leading zero. - # define_alias( qr/\bcp037\b/i => '"cp37"'); - - # Mac Mappings - # predefined in *.ucm; unneeded - # define_alias( qr/\bmacIcelandic$/i => '"macIceland"'); - define_alias( qr/^mac_(.*)$/i => '"mac$1"' ); - # http://rt.cpan.org/Ticket/Display.html?id=36326 - define_alias( qr/^macintosh$/i => '"MacRoman"' ); - - # Ououououou. gone. They are differente! - # define_alias( qr/\bmacRomanian$/i => '"macRumanian"'); - - # Standardize on the dashed versions. - define_alias( qr/\bkoi8[\s\-_]*([ru])$/i => '"koi8-$1"' ); - - unless ($Encode::ON_EBCDIC) { - - # for Encode::CN - define_alias( qr/\beuc.*cn$/i => '"euc-cn"' ); - define_alias( qr/\bcn.*euc$/i => '"euc-cn"' ); - - # define_alias( qr/\bGB[- ]?(\d+)$/i => '"euc-cn"' ) - # CP936 doesn't have vendor-addon for GBK, so they're identical. - define_alias( qr/^gbk$/i => '"cp936"' ); - - # This fixes gb2312 vs. euc-cn confusion, practically - define_alias( qr/\bGB[-_ ]?2312(?!-?raw)/i => '"euc-cn"' ); - - # for Encode::JP - define_alias( qr/\bjis$/i => '"7bit-jis"' ); - define_alias( qr/\beuc.*jp$/i => '"euc-jp"' ); - define_alias( qr/\bjp.*euc$/i => '"euc-jp"' ); - define_alias( qr/\bujis$/i => '"euc-jp"' ); - define_alias( qr/\bshift.*jis$/i => '"shiftjis"' ); - define_alias( qr/\bsjis$/i => '"shiftjis"' ); - define_alias( qr/\bwindows-31j$/i => '"cp932"' ); - - # for Encode::KR - define_alias( qr/\beuc.*kr$/i => '"euc-kr"' ); - define_alias( qr/\bkr.*euc$/i => '"euc-kr"' ); - - # This fixes ksc5601 vs. euc-kr confusion, practically - define_alias( qr/(?:x-)?uhc$/i => '"cp949"' ); - define_alias( qr/(?:x-)?windows-949$/i => '"cp949"' ); - define_alias( qr/\bks_c_5601-1987$/i => '"cp949"' ); - - # for Encode::TW - define_alias( qr/\bbig-?5$/i => '"big5-eten"' ); - define_alias( qr/\bbig5-?et(?:en)?$/i => '"big5-eten"' ); - define_alias( qr/\btca[-_]?big5$/i => '"big5-eten"' ); - define_alias( qr/\bbig5-?hk(?:scs)?$/i => '"big5-hkscs"' ); - define_alias( qr/\bhk(?:scs)?[-_]?big5$/i => '"big5-hkscs"' ); - } - - # utf8 is blessed :) - define_alias( qr/\bUTF-8$/i => '"utf-8-strict"' ); - - # At last, Map white space and _ to '-' - define_alias( qr/^(\S+)[\s_]+(.*)$/i => '"$1-$2"' ); -} - -1; -__END__ - -# TODO: HP-UX '8' encodings arabic8 greek8 hebrew8 kana8 thai8 turkish8 -# TODO: HP-UX '15' encodings japanese15 korean15 roi15 -# TODO: Cyrillic encoding ISO-IR-111 (useful?) -# TODO: Armenian encoding ARMSCII-8 -# TODO: Hebrew encoding ISO-8859-8-1 -# TODO: Thai encoding TCVN -# TODO: Vietnamese encodings VPS -# TODO: Mac Asian+African encodings: Arabic Armenian Bengali Burmese -# ChineseSimp ChineseTrad Devanagari Ethiopic ExtArabic -# Farsi Georgian Gujarati Gurmukhi Hebrew Japanese -# Kannada Khmer Korean Laotian Malayalam Mongolian -# Oriya Sinhalese Symbol Tamil Telugu Tibetan Vietnamese - -=head1 NAME - -Encode::Alias - alias definitions to encodings - -=head1 SYNOPSIS - - use Encode; - use Encode::Alias; - define_alias( newName => ENCODING); - -=head1 DESCRIPTION - -Allows newName to be used as an alias for ENCODING. ENCODING may be -either the name of an encoding or an encoding object (as described -in L<Encode>). - -Currently I<newName> can be specified in the following ways: - -=over 4 - -=item As a simple string. - -=item As a qr// compiled regular expression, e.g.: - - define_alias( qr/^iso8859-(\d+)$/i => '"iso-8859-$1"' ); - -In this case, if I<ENCODING> is not a reference, it is C<eval>-ed -in order to allow C<$1> etc. to be substituted. The example is one -way to alias names as used in X11 fonts to the MIME names for the -iso-8859-* family. Note the double quotes inside the single quotes. - -(or, you don't have to do this yourself because this example is predefined) - -If you are using a regex here, you have to use the quotes as shown or -it won't work. Also note that regex handling is tricky even for the -experienced. Use this feature with caution. - -=item As a code reference, e.g.: - - define_alias( sub {shift =~ /^iso8859-(\d+)$/i ? "iso-8859-$1" : undef } ); - -The same effect as the example above in a different way. The coderef -takes the alias name as an argument and returns a canonical name on -success or undef if not. Note the second argument is not required. -Use this with even more caution than the regex version. - -=back - -=head3 Changes in code reference aliasing - -As of Encode 1.87, the older form - - define_alias( sub { return /^iso8859-(\d+)$/i ? "iso-8859-$1" : undef } ); - -no longer works. - -Encode up to 1.86 internally used "local $_" to implement ths older -form. But consider the code below; - - use Encode; - $_ = "eeeee" ; - while (/(e)/g) { - my $utf = decode('aliased-encoding-name', $1); - print "position:",pos,"\n"; - } - -Prior to Encode 1.86 this fails because of "local $_". - -=head2 Alias overloading - -You can override predefined aliases by simply applying define_alias(). -The new alias is always evaluated first, and when necessary, -define_alias() flushes the internal cache to make the new definition -available. - - # redirect SHIFT_JIS to MS/IBM Code Page 932, which is a - # superset of SHIFT_JIS - - define_alias( qr/shift.*jis$/i => '"cp932"' ); - define_alias( qr/sjis$/i => '"cp932"' ); - -If you want to zap all predefined aliases, you can use - - Encode::Alias->undef_aliases; - -to do so. And - - Encode::Alias->init_aliases; - -gets the factory settings back. - -=head1 SEE ALSO - -L<Encode>, L<Encode::Supported> - -=cut - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Byte.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Byte.pm deleted file mode 100755 index d105aa27cc8..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Byte.pm +++ /dev/null @@ -1,120 +0,0 @@ -package Encode::Byte; -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -1; -__END__ - -=head1 NAME - -Encode::Byte - Single Byte Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $greek = encode("iso-8859-7", $utf8); # loads Encode::Byte implicitly - $utf8 = decode("iso-8859-7", $greek); # ditto - -=head1 ABSTRACT - -This module implements various single byte encodings. For most cases it uses -\x80-\xff (upper half) to map non-ASCII characters. Encodings -supported are as follows. - - Canonical Alias Description - -------------------------------------------------------------------- - # ISO 8859 series - (iso-8859-1 is in built-in) - iso-8859-2 latin2 [ISO] - iso-8859-3 latin3 [ISO] - iso-8859-4 latin4 [ISO] - iso-8859-5 [ISO] - iso-8859-6 [ISO] - iso-8859-7 [ISO] - iso-8859-8 [ISO] - iso-8859-9 latin5 [ISO] - iso-8859-10 latin6 [ISO] - iso-8859-11 - (iso-8859-12 is nonexistent) - iso-8859-13 latin7 [ISO] - iso-8859-14 latin8 [ISO] - iso-8859-15 latin9 [ISO] - iso-8859-16 latin10 [ISO] - - # Cyrillic - koi8-f - koi8-r cp878 [RFC1489] - koi8-u [RFC2319] - - # Vietnamese - viscii - - # all cp* are also available as ibm-*, ms-*, and windows-* - # also see L<http://msdn.microsoft.com/en-us/library/aa752010%28VS.85%29.aspx> - - cp424 - cp437 - cp737 - cp775 - cp850 - cp852 - cp855 - cp856 - cp857 - cp860 - cp861 - cp862 - cp863 - cp864 - cp865 - cp866 - cp869 - cp874 - cp1006 - cp1250 WinLatin2 - cp1251 WinCyrillic - cp1252 WinLatin1 - cp1253 WinGreek - cp1254 WinTurkish - cp1255 WinHebrew - cp1256 WinArabic - cp1257 WinBaltic - cp1258 WinVietnamese - - # Macintosh - # Also see L<http://developer.apple.com/technotes/tn/tn1150.html> - MacArabic - MacCentralEurRoman - MacCroatian - MacCyrillic - MacFarsi - MacGreek - MacHebrew - MacIcelandic - MacRoman - MacRomanian - MacRumanian - MacSami - MacThai - MacTurkish - MacUkrainian - - # More vendor encodings - AdobeStandardEncoding - nextstep - hp-roman8 - -=head1 DESCRIPTION - -To find how to use this module in detail, see L<Encode>. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/CJKConstants.pm b/Master/tlpkg/tlperl.straw/lib/Encode/CJKConstants.pm deleted file mode 100755 index 43d20337544..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/CJKConstants.pm +++ /dev/null @@ -1,66 +0,0 @@ -# -# $Id: CJKConstants.pm,v 2.2 2006/06/03 20:28:48 dankogai Exp $ -# - -package Encode::CJKConstants; - -use strict; -use warnings; -our $RCSID = q$Id: CJKConstants.pm,v 2.2 2006/06/03 20:28:48 dankogai Exp $; -our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use Carp; - -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT = qw(); -our @EXPORT_OK = qw(%CHARCODE %ESC %RE); -our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK, @EXPORT ] ); - -my %_0208 = ( - 1978 => '\e\$\@', - 1983 => '\e\$B', - 1990 => '\e&\@\e\$B', -); - -our %CHARCODE = ( - UNDEF_EUC => "\xa2\xae", # ¢® in EUC - UNDEF_SJIS => "\x81\xac", # ¢® in SJIS - UNDEF_JIS => "\xa2\xf7", # ¢÷ -- used in unicode - UNDEF_UNICODE => "\x20\x20", # ¢÷ -- used in unicode -); - -our %ESC = ( - GB_2312 => "\e\$A", - JIS_0208 => "\e\$B", - JIS_0212 => "\e\$(D", - KSC_5601 => "\e\$(C", - ASC => "\e\(B", - KANA => "\e\(I", - '2022_KR' => "\e\$)C", -); - -our %RE = ( - ASCII => '[\x00-\x7f]', - BIN => '[\x00-\x06\x7f\xff]', - EUC_0212 => '\x8f[\xa1-\xfe][\xa1-\xfe]', - EUC_C => '[\xa1-\xfe][\xa1-\xfe]', - EUC_KANA => '\x8e[\xa1-\xdf]', - JIS_0208 => "$_0208{1978}|$_0208{1983}|$_0208{1990}", - JIS_0212 => "\e" . '\$\(D', - ISO_ASC => "\e" . '\([BJ]', - JIS_KANA => "\e" . '\(I', - '2022_KR' => "\e" . '\$\)C', - SJIS_C => '[\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc]', - SJIS_KANA => '[\xa1-\xdf]', - UTF8 => '[\xc0-\xdf][\x80-\xbf]|[\xe0-\xef][\x80-\xbf][\x80-\xbf]' -); - -1; - -=head1 NAME - -Encode::CJKConstants.pm -- Internally used by Encode::??::ISO_2022_* - -=cut - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/CN.pm b/Master/tlpkg/tlperl.straw/lib/Encode/CN.pm deleted file mode 100755 index 830f34507da..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/CN.pm +++ /dev/null @@ -1,74 +0,0 @@ -package Encode::CN; -BEGIN { - if ( ord("A") == 193 ) { - die "Encode::CN not supported on EBCDIC\n"; - } -} -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -# Relocated from Encode.pm - -use Encode::CN::HZ; - -# use Encode::CN::2022_CN; - -1; -__END__ - -=head1 NAME - -Encode::CN - China-based Chinese Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $euc_cn = encode("euc-cn", $utf8); # loads Encode::CN implicitly - $utf8 = decode("euc-cn", $euc_cn); # ditto - -=head1 DESCRIPTION - -This module implements China-based Chinese charset encodings. -Encodings supported are as follows. - - Canonical Alias Description - -------------------------------------------------------------------- - euc-cn /\beuc.*cn$/i EUC (Extended Unix Character) - /\bcn.*euc$/i - /\bGB[-_ ]?2312(?:\D.*$|$)/i (see below) - gb2312-raw The raw (low-bit) GB2312 character map - gb12345-raw Traditional chinese counterpart to - GB2312 (raw) - iso-ir-165 GB2312 + GB6345 + GB8565 + additions - MacChineseSimp GB2312 + Apple Additions - cp936 Code Page 936, also known as GBK - (Extended GuoBiao) - hz 7-bit escaped GB2312 encoding - -------------------------------------------------------------------- - -To find how to use this module in detail, see L<Encode>. - -=head1 NOTES - -Due to size concerns, C<GB 18030> (an extension to C<GBK>) is distributed -separately on CPAN, under the name L<Encode::HanExtra>. That module -also contains extra Taiwan-based encodings. - -=head1 BUGS - -When you see C<charset=gb2312> on mails and web pages, they really -mean C<euc-cn> encodings. To fix that, C<gb2312> is aliased to C<euc-cn>. -Use C<gb2312-raw> when you really mean it. - -The ASCII region (0x00-0x7f) is preserved for all encodings, even though -this conflicts with mappings by the Unicode Consortium. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/CN/HZ.pm b/Master/tlpkg/tlperl.straw/lib/Encode/CN/HZ.pm deleted file mode 100755 index 98c16a9053a..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/CN/HZ.pm +++ /dev/null @@ -1,198 +0,0 @@ -package Encode::CN::HZ; - -use strict; -use warnings; -use utf8 (); - -use vars qw($VERSION); -$VERSION = do { my @r = ( q$Revision: 2.5 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use Encode qw(:fallbacks); - -use base qw(Encode::Encoding); -__PACKAGE__->Define('hz'); - -# HZ is a combination of ASCII and escaped GB, so we implement it -# with the GB2312(raw) encoding here. Cf. RFCs 1842 & 1843. - -# not ported for EBCDIC. Which should be used, "~" or "\x7E"? - -sub needs_lines { 1 } - -sub decode ($$;$) { - my ( $obj, $str, $chk ) = @_; - - my $GB = Encode::find_encoding('gb2312-raw'); - my $ret = ''; - my $in_ascii = 1; # default mode is ASCII. - - while ( length $str ) { - if ($in_ascii) { # ASCII mode - if ( $str =~ s/^([\x00-\x7D\x7F]+)// ) { # no '~' => ASCII - $ret .= $1; - - # EBCDIC should need ascii2native, but not ported. - } - elsif ( $str =~ s/^\x7E\x7E// ) { # escaped tilde - $ret .= '~'; - } - elsif ( $str =~ s/^\x7E\cJ// ) { # '\cJ' == LF in ASCII - 1; # no-op - } - elsif ( $str =~ s/^\x7E\x7B// ) { # '~{' - $in_ascii = 0; # to GB - } - else { # encounters an invalid escape, \x80 or greater - last; - } - } - else { # GB mode; the byte ranges are as in RFC 1843. - no warnings 'uninitialized'; - if ( $str =~ s/^((?:[\x21-\x77][\x21-\x7E])+)// ) { - $ret .= $GB->decode( $1, $chk ); - } - elsif ( $str =~ s/^\x7E\x7D// ) { # '~}' - $in_ascii = 1; - } - else { # invalid - last; - } - } - } - $_[1] = '' if $chk; # needs_lines guarantees no partial character - return $ret; -} - -sub cat_decode { - my ( $obj, undef, $src, $pos, $trm, $chk ) = @_; - my ( $rdst, $rsrc, $rpos ) = \@_[ 1 .. 3 ]; - - my $GB = Encode::find_encoding('gb2312-raw'); - my $ret = ''; - my $in_ascii = 1; # default mode is ASCII. - - my $ini_pos = pos($$rsrc); - - substr( $src, 0, $pos ) = ''; - - my $ini_len = bytes::length($src); - - # $trm is the first of the pair '~~', then 2nd tilde is to be removed. - # XXX: Is better C<$src =~ s/^\x7E// or die if ...>? - $src =~ s/^\x7E// if $trm eq "\x7E"; - - while ( length $src ) { - my $now; - if ($in_ascii) { # ASCII mode - if ( $src =~ s/^([\x00-\x7D\x7F])// ) { # no '~' => ASCII - $now = $1; - } - elsif ( $src =~ s/^\x7E\x7E// ) { # escaped tilde - $now = '~'; - } - elsif ( $src =~ s/^\x7E\cJ// ) { # '\cJ' == LF in ASCII - next; - } - elsif ( $src =~ s/^\x7E\x7B// ) { # '~{' - $in_ascii = 0; # to GB - next; - } - else { # encounters an invalid escape, \x80 or greater - last; - } - } - else { # GB mode; the byte ranges are as in RFC 1843. - if ( $src =~ s/^((?:[\x21-\x77][\x21-\x7F])+)// ) { - $now = $GB->decode( $1, $chk ); - } - elsif ( $src =~ s/^\x7E\x7D// ) { # '~}' - $in_ascii = 1; - next; - } - else { # invalid - last; - } - } - - next if !defined $now; - - $ret .= $now; - - if ( $now eq $trm ) { - $$rdst .= $ret; - $$rpos = $ini_pos + $pos + $ini_len - bytes::length($src); - pos($$rsrc) = $ini_pos; - return 1; - } - } - - $$rdst .= $ret; - $$rpos = $ini_pos + $pos + $ini_len - bytes::length($src); - pos($$rsrc) = $ini_pos; - return ''; # terminator not found -} - -sub encode($$;$) { - my ( $obj, $str, $chk ) = @_; - - my $GB = Encode::find_encoding('gb2312-raw'); - my $ret = ''; - my $in_ascii = 1; # default mode is ASCII. - - no warnings 'utf8'; # $str may be malformed UTF8 at the end of a chunk. - - while ( length $str ) { - if ( $str =~ s/^([[:ascii:]]+)// ) { - my $tmp = $1; - $tmp =~ s/~/~~/g; # escapes tildes - if ( !$in_ascii ) { - $ret .= "\x7E\x7D"; # '~}' - $in_ascii = 1; - } - $ret .= pack 'a*', $tmp; # remove UTF8 flag. - } - elsif ( $str =~ s/(.)// ) { - my $s = $1; - my $tmp = $GB->encode( $s, $chk ); - last if !defined $tmp; - if ( length $tmp == 2 ) { # maybe a valid GB char (XXX) - if ($in_ascii) { - $ret .= "\x7E\x7B"; # '~{' - $in_ascii = 0; - } - $ret .= $tmp; - } - elsif ( length $tmp ) { # maybe FALLBACK in ASCII (XXX) - if ( !$in_ascii ) { - $ret .= "\x7E\x7D"; # '~}' - $in_ascii = 1; - } - $ret .= $tmp; - } - } - else { # if $str is malformed UTF8 *and* if length $str != 0. - last; - } - } - $_[1] = $str if $chk; - - # The state at the end of the chunk is discarded, even if in GB mode. - # That results in the combination of GB-OUT and GB-IN, i.e. "~}~{". - # Parhaps it is harmless, but further investigations may be required... - - if ( !$in_ascii ) { - $ret .= "\x7E\x7D"; # '~}' - $in_ascii = 1; - } - utf8::encode($ret); # https://rt.cpan.org/Ticket/Display.html?id=35120 - return $ret; -} - -1; -__END__ - -=head1 NAME - -Encode::CN::HZ -- internally used by Encode::CN - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Changes.e2x b/Master/tlpkg/tlperl.straw/lib/Encode/Changes.e2x deleted file mode 100755 index 5c67c55cb93..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Changes.e2x +++ /dev/null @@ -1,7 +0,0 @@ -# -# $Id: Changes.e2x,v 2.0 2004/05/16 20:55:15 dankogai Exp $ -# Revision history for Perl extension Encode::$_Name_. -# - -0.01 $_Now_ - Autogenerated by enc2xs version $_Version_. diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Config.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Config.pm deleted file mode 100755 index 1286a479998..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Config.pm +++ /dev/null @@ -1,170 +0,0 @@ -# -# Demand-load module list -# -package Encode::Config; -our $VERSION = do { my @r = ( q$Revision: 2.5 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use strict; -use warnings; - -our %ExtModule = ( - - # Encode::Byte - #iso-8859-1 is in Encode.pm itself - 'iso-8859-2' => 'Encode::Byte', - 'iso-8859-3' => 'Encode::Byte', - 'iso-8859-4' => 'Encode::Byte', - 'iso-8859-5' => 'Encode::Byte', - 'iso-8859-6' => 'Encode::Byte', - 'iso-8859-7' => 'Encode::Byte', - 'iso-8859-8' => 'Encode::Byte', - 'iso-8859-9' => 'Encode::Byte', - 'iso-8859-10' => 'Encode::Byte', - 'iso-8859-11' => 'Encode::Byte', - 'iso-8859-13' => 'Encode::Byte', - 'iso-8859-14' => 'Encode::Byte', - 'iso-8859-15' => 'Encode::Byte', - 'iso-8859-16' => 'Encode::Byte', - 'koi8-f' => 'Encode::Byte', - 'koi8-r' => 'Encode::Byte', - 'koi8-u' => 'Encode::Byte', - 'viscii' => 'Encode::Byte', - 'cp424' => 'Encode::Byte', - 'cp437' => 'Encode::Byte', - 'cp737' => 'Encode::Byte', - 'cp775' => 'Encode::Byte', - 'cp850' => 'Encode::Byte', - 'cp852' => 'Encode::Byte', - 'cp855' => 'Encode::Byte', - 'cp856' => 'Encode::Byte', - 'cp857' => 'Encode::Byte', - 'cp858' => 'Encode::Byte', - 'cp860' => 'Encode::Byte', - 'cp861' => 'Encode::Byte', - 'cp862' => 'Encode::Byte', - 'cp863' => 'Encode::Byte', - 'cp864' => 'Encode::Byte', - 'cp865' => 'Encode::Byte', - 'cp866' => 'Encode::Byte', - 'cp869' => 'Encode::Byte', - 'cp874' => 'Encode::Byte', - 'cp1006' => 'Encode::Byte', - 'cp1250' => 'Encode::Byte', - 'cp1251' => 'Encode::Byte', - 'cp1252' => 'Encode::Byte', - 'cp1253' => 'Encode::Byte', - 'cp1254' => 'Encode::Byte', - 'cp1255' => 'Encode::Byte', - 'cp1256' => 'Encode::Byte', - 'cp1257' => 'Encode::Byte', - 'cp1258' => 'Encode::Byte', - 'AdobeStandardEncoding' => 'Encode::Byte', - 'MacArabic' => 'Encode::Byte', - 'MacCentralEurRoman' => 'Encode::Byte', - 'MacCroatian' => 'Encode::Byte', - 'MacCyrillic' => 'Encode::Byte', - 'MacFarsi' => 'Encode::Byte', - 'MacGreek' => 'Encode::Byte', - 'MacHebrew' => 'Encode::Byte', - 'MacIcelandic' => 'Encode::Byte', - 'MacRoman' => 'Encode::Byte', - 'MacRomanian' => 'Encode::Byte', - 'MacRumanian' => 'Encode::Byte', - 'MacSami' => 'Encode::Byte', - 'MacThai' => 'Encode::Byte', - 'MacTurkish' => 'Encode::Byte', - 'MacUkrainian' => 'Encode::Byte', - 'nextstep' => 'Encode::Byte', - 'hp-roman8' => 'Encode::Byte', - #'gsm0338' => 'Encode::Byte', - 'gsm0338' => 'Encode::GSM0338', - - # Encode::EBCDIC - 'cp37' => 'Encode::EBCDIC', - 'cp500' => 'Encode::EBCDIC', - 'cp875' => 'Encode::EBCDIC', - 'cp1026' => 'Encode::EBCDIC', - 'cp1047' => 'Encode::EBCDIC', - 'posix-bc' => 'Encode::EBCDIC', - - # Encode::Symbol - 'dingbats' => 'Encode::Symbol', - 'symbol' => 'Encode::Symbol', - 'AdobeSymbol' => 'Encode::Symbol', - 'AdobeZdingbat' => 'Encode::Symbol', - 'MacDingbats' => 'Encode::Symbol', - 'MacSymbol' => 'Encode::Symbol', - - # Encode::Unicode - 'UCS-2BE' => 'Encode::Unicode', - 'UCS-2LE' => 'Encode::Unicode', - 'UTF-16' => 'Encode::Unicode', - 'UTF-16BE' => 'Encode::Unicode', - 'UTF-16LE' => 'Encode::Unicode', - 'UTF-32' => 'Encode::Unicode', - 'UTF-32BE' => 'Encode::Unicode', - 'UTF-32LE' => 'Encode::Unicode', - 'UTF-7' => 'Encode::Unicode::UTF7', -); - -unless ( ord("A") == 193 ) { - %ExtModule = ( - %ExtModule, - 'euc-cn' => 'Encode::CN', - 'gb12345-raw' => 'Encode::CN', - 'gb2312-raw' => 'Encode::CN', - 'hz' => 'Encode::CN', - 'iso-ir-165' => 'Encode::CN', - 'cp936' => 'Encode::CN', - 'MacChineseSimp' => 'Encode::CN', - - '7bit-jis' => 'Encode::JP', - 'euc-jp' => 'Encode::JP', - 'iso-2022-jp' => 'Encode::JP', - 'iso-2022-jp-1' => 'Encode::JP', - 'jis0201-raw' => 'Encode::JP', - 'jis0208-raw' => 'Encode::JP', - 'jis0212-raw' => 'Encode::JP', - 'cp932' => 'Encode::JP', - 'MacJapanese' => 'Encode::JP', - 'shiftjis' => 'Encode::JP', - - 'euc-kr' => 'Encode::KR', - 'iso-2022-kr' => 'Encode::KR', - 'johab' => 'Encode::KR', - 'ksc5601-raw' => 'Encode::KR', - 'cp949' => 'Encode::KR', - 'MacKorean' => 'Encode::KR', - - 'big5-eten' => 'Encode::TW', - 'big5-hkscs' => 'Encode::TW', - 'cp950' => 'Encode::TW', - 'MacChineseTrad' => 'Encode::TW', - - #'big5plus' => 'Encode::HanExtra', - #'euc-tw' => 'Encode::HanExtra', - #'gb18030' => 'Encode::HanExtra', - - 'MIME-Header' => 'Encode::MIME::Header', - 'MIME-B' => 'Encode::MIME::Header', - 'MIME-Q' => 'Encode::MIME::Header', - - 'MIME-Header-ISO_2022_JP' => 'Encode::MIME::Header::ISO_2022_JP', - ); -} - -# -# Why not export ? to keep ConfigLocal Happy! -# -while ( my ( $enc, $mod ) = each %ExtModule ) { - $Encode::ExtModule{$enc} = $mod; -} - -1; -__END__ - -=head1 NAME - -Encode::Config -- internally used by Encode - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/ConfigLocal_PM.e2x b/Master/tlpkg/tlperl.straw/lib/Encode/ConfigLocal_PM.e2x deleted file mode 100755 index e203dfded50..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/ConfigLocal_PM.e2x +++ /dev/null @@ -1,13 +0,0 @@ -# -# Local demand-load module list -# -# You should not edit this file by hand! use "enc2xs -C" -# -package Encode::ConfigLocal; -our $VERSION = $_LocalVer_; - -use strict; - -$_ModLines_ - -1; diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/EBCDIC.pm b/Master/tlpkg/tlperl.straw/lib/Encode/EBCDIC.pm deleted file mode 100755 index 8024c130da1..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/EBCDIC.pm +++ /dev/null @@ -1,45 +0,0 @@ -package Encode::EBCDIC; -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -1; -__END__ - -=head1 NAME - -Encode::EBCDIC - EBCDIC Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $posix_bc = encode("posix-bc", $utf8); # loads Encode::EBCDIC implicitly - $utf8 = decode("", $posix_bc); # ditto - -=head1 ABSTRACT - -This module implements various EBCDIC-Based encodings. Encodings -supported are as follows. - - Canonical Alias Description - -------------------------------------------------------------------- - cp37 - cp500 - cp875 - cp1026 - cp1047 - posix-bc - -=head1 DESCRIPTION - -To find how to use this module in detail, see L<Encode>. - -=head1 SEE ALSO - -L<Encode>, L<perlebcdic> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Encoder.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Encoder.pm deleted file mode 100755 index f7194f81ac4..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Encoder.pm +++ /dev/null @@ -1,253 +0,0 @@ -# -# $Id: Encoder.pm,v 2.1 2006/05/03 18:24:10 dankogai Exp $ -# -package Encode::Encoder; -use strict; -use warnings; -our $VERSION = do { my @r = ( q$Revision: 2.1 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT_OK = qw ( encoder ); - -our $AUTOLOAD; -sub DEBUG () { 0 } -use Encode qw(encode decode find_encoding from_to); -use Carp; - -sub new { - my ( $class, $data, $encname ) = @_; - unless ($encname) { - $encname = Encode::is_utf8($data) ? 'utf8' : ''; - } - else { - my $obj = find_encoding($encname) - or croak __PACKAGE__, ": unknown encoding: $encname"; - $encname = $obj->name; - } - my $self = { - data => $data, - encoding => $encname, - }; - bless $self => $class; -} - -sub encoder { __PACKAGE__->new(@_) } - -sub data { - my ( $self, $data ) = @_; - if ( defined $data ) { - $self->{data} = $data; - return $data; - } - else { - return $self->{data}; - } -} - -sub encoding { - my ( $self, $encname ) = @_; - if ($encname) { - my $obj = find_encoding($encname) - or confess __PACKAGE__, ": unknown encoding: $encname"; - $self->{encoding} = $obj->name; - return $self; - } - else { - return $self->{encoding}; - } -} - -sub bytes { - my ( $self, $encname ) = @_; - $encname ||= $self->{encoding}; - my $obj = find_encoding($encname) - or confess __PACKAGE__, ": unknown encoding: $encname"; - $self->{data} = $obj->decode( $self->{data}, 1 ); - $self->{encoding} = ''; - return $self; -} - -sub DESTROY { # defined so it won't autoload. - DEBUG and warn shift; -} - -sub AUTOLOAD { - my $self = shift; - my $type = ref($self) - or confess "$self is not an object"; - my $myname = $AUTOLOAD; - $myname =~ s/.*://; # strip fully-qualified portion - my $obj = find_encoding($myname) - or confess __PACKAGE__, ": unknown encoding: $myname"; - DEBUG and warn $self->{encoding}, " => ", $obj->name; - if ( $self->{encoding} ) { - from_to( $self->{data}, $self->{encoding}, $obj->name, 1 ); - } - else { - $self->{data} = $obj->encode( $self->{data}, 1 ); - } - $self->{encoding} = $obj->name; - return $self; -} - -use overload - q("") => sub { $_[0]->{data} }, - q(0+) => sub { use bytes(); bytes::length( $_[0]->{data} ) }, - fallback => 1, - ; - -1; -__END__ - -=head1 NAME - -Encode::Encoder -- Object Oriented Encoder - -=head1 SYNOPSIS - - use Encode::Encoder; - # Encode::encode("ISO-8859-1", $data); - Encode::Encoder->new($data)->iso_8859_1; # OOP way - # shortcut - use Encode::Encoder qw(encoder); - encoder($data)->iso_8859_1; - # you can stack them! - encoder($data)->iso_8859_1->base64; # provided base64() is defined - # you can use it as a decoder as well - encoder($base64)->bytes('base64')->latin1; - # stringified - print encoder($data)->utf8->latin1; # prints the string in latin1 - # numified - encoder("\x{abcd}\x{ef}g")->utf8 == 6; # true. bytes::length($data) - -=head1 ABSTRACT - -B<Encode::Encoder> allows you to use Encode in an object-oriented -style. This is not only more intuitive than a functional approach, -but also handier when you want to stack encodings. Suppose you want -your UTF-8 string converted to Latin1 then Base64: you can simply say - - my $base64 = encoder($utf8)->latin1->base64; - -instead of - - my $latin1 = encode("latin1", $utf8); - my $base64 = encode_base64($utf8); - -or the lazier and more convoluted - - my $base64 = encode_base64(encode("latin1", $utf8)); - -=head1 Description - -Here is how to use this module. - -=over 4 - -=item * - -There are at least two instance variables stored in a hash reference, -{data} and {encoding}. - -=item * - -When there is no method, it takes the method name as the name of the -encoding and encodes the instance I<data> with I<encoding>. If successful, -the instance I<encoding> is set accordingly. - -=item * - -You can retrieve the result via -E<gt>data but usually you don't have to -because the stringify operator ("") is overridden to do exactly that. - -=back - -=head2 Predefined Methods - -This module predefines the methods below: - -=over 4 - -=item $e = Encode::Encoder-E<gt>new([$data, $encoding]); - -returns an encoder object. Its data is initialized with $data if -present, and its encoding is set to $encoding if present. - -When $encoding is omitted, it defaults to utf8 if $data is already in -utf8 or "" (empty string) otherwise. - -=item encoder() - -is an alias of Encode::Encoder-E<gt>new(). This one is exported on demand. - -=item $e-E<gt>data([$data]) - -When $data is present, sets the instance data to $data and returns the -object itself. Otherwise, the current instance data is returned. - -=item $e-E<gt>encoding([$encoding]) - -When $encoding is present, sets the instance encoding to $encoding and -returns the object itself. Otherwise, the current instance encoding is -returned. - -=item $e-E<gt>bytes([$encoding]) - -decodes instance data from $encoding, or the instance encoding if -omitted. If the conversion is successful, the instance encoding -will be set to "". - -The name I<bytes> was deliberately picked to avoid namespace tainting --- this module may be used as a base class so method names that appear -in Encode::Encoding are avoided. - -=back - -=head2 Example: base64 transcoder - -This module is designed to work with L<Encode::Encoding>. -To make the Base64 transcoder example above really work, you could -write a module like this: - - package Encode::Base64; - use base 'Encode::Encoding'; - __PACKAGE__->Define('base64'); - use MIME::Base64; - sub encode{ - my ($obj, $data) = @_; - return encode_base64($data); - } - sub decode{ - my ($obj, $data) = @_; - return decode_base64($data); - } - 1; - __END__ - -And your caller module would be something like this: - - use Encode::Encoder; - use Encode::Base64; - - # now you can really do the following - - encoder($data)->iso_8859_1->base64; - encoder($base64)->bytes('base64')->latin1; - -=head2 Operator Overloading - -This module overloads two operators, stringify ("") and numify (0+). - -Stringify dumps the data inside the object. - -Numify returns the number of bytes in the instance data. - -They come in handy when you want to print or find the size of data. - -=head1 SEE ALSO - -L<Encode>, -L<Encode::Encoding> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Encoding.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Encoding.pm deleted file mode 100755 index 768d6d126ac..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Encoding.pm +++ /dev/null @@ -1,360 +0,0 @@ -package Encode::Encoding; - -# Base class for classes which implement encodings -use strict; -use warnings; -our $VERSION = do { my @r = ( q$Revision: 2.5 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -require Encode; - -sub DEBUG { 0 } - -sub Define { - my $obj = shift; - my $canonical = shift; - $obj = bless { Name => $canonical }, $obj unless ref $obj; - - # warn "$canonical => $obj\n"; - Encode::define_encoding( $obj, $canonical, @_ ); -} - -sub name { return shift->{'Name'} } - -sub mime_name{ - require Encode::MIME::Name; - return Encode::MIME::Name::get_mime_name(shift->name); -} - -# sub renew { return $_[0] } - -sub renew { - my $self = shift; - my $clone = bless {%$self} => ref($self); - $clone->{renewed}++; # so the caller can see it - DEBUG and warn $clone->{renewed}; - return $clone; -} - -sub renewed { return $_[0]->{renewed} || 0 } - -*new_sequence = \&renew; - -sub needs_lines { 0 } - -sub perlio_ok { - eval { require PerlIO::encoding }; - return $@ ? 0 : 1; -} - -# (Temporary|legacy) methods - -sub toUnicode { shift->decode(@_) } -sub fromUnicode { shift->encode(@_) } - -# -# Needs to be overloaded or just croak -# - -sub encode { - require Carp; - my $obj = shift; - my $class = ref($obj) ? ref($obj) : $obj; - Carp::croak( $class . "->encode() not defined!" ); -} - -sub decode { - require Carp; - my $obj = shift; - my $class = ref($obj) ? ref($obj) : $obj; - Carp::croak( $class . "->encode() not defined!" ); -} - -sub DESTROY { } - -1; -__END__ - -=head1 NAME - -Encode::Encoding - Encode Implementation Base Class - -=head1 SYNOPSIS - - package Encode::MyEncoding; - use base qw(Encode::Encoding); - - __PACKAGE__->Define(qw(myCanonical myAlias)); - -=head1 DESCRIPTION - -As mentioned in L<Encode>, encodings are (in the current -implementation at least) defined as objects. The mapping of encoding -name to object is via the C<%Encode::Encoding> hash. Though you can -directly manipulate this hash, it is strongly encouraged to use this -base class module and add encode() and decode() methods. - -=head2 Methods you should implement - -You are strongly encouraged to implement methods below, at least -either encode() or decode(). - -=over 4 - -=item -E<gt>encode($string [,$check]) - -MUST return the octet sequence representing I<$string>. - -=over 2 - -=item * - -If I<$check> is true, it SHOULD modify I<$string> in place to remove -the converted part (i.e. the whole string unless there is an error). -If perlio_ok() is true, SHOULD becomes MUST. - -=item * - -If an error occurs, it SHOULD return the octet sequence for the -fragment of string that has been converted and modify $string in-place -to remove the converted part leaving it starting with the problem -fragment. If perlio_ok() is true, SHOULD becomes MUST. - -=item * - -If I<$check> is is false then C<encode> MUST make a "best effort" to -convert the string - for example, by using a replacement character. - -=back - -=item -E<gt>decode($octets [,$check]) - -MUST return the string that I<$octets> represents. - -=over 2 - -=item * - -If I<$check> is true, it SHOULD modify I<$octets> in place to remove -the converted part (i.e. the whole sequence unless there is an -error). If perlio_ok() is true, SHOULD becomes MUST. - -=item * - -If an error occurs, it SHOULD return the fragment of string that has -been converted and modify $octets in-place to remove the converted -part leaving it starting with the problem fragment. If perlio_ok() is -true, SHOULD becomes MUST. - -=item * - -If I<$check> is false then C<decode> should make a "best effort" to -convert the string - for example by using Unicode's "\x{FFFD}" as a -replacement character. - -=back - -=back - -If you want your encoding to work with L<encoding> pragma, you should -also implement the method below. - -=over 4 - -=item -E<gt>cat_decode($destination, $octets, $offset, $terminator [,$check]) - -MUST decode I<$octets> with I<$offset> and concatenate it to I<$destination>. -Decoding will terminate when $terminator (a string) appears in output. -I<$offset> will be modified to the last $octets position at end of decode. -Returns true if $terminator appears output, else returns false. - -=back - -=head2 Other methods defined in Encode::Encodings - -You do not have to override methods shown below unless you have to. - -=over 4 - -=item -E<gt>name - -Predefined As: - - sub name { return shift->{'Name'} } - -MUST return the string representing the canonical name of the encoding. - -=item -E<gt>mime_name - -Predefined As: - - sub mime_name{ - require Encode::MIME::Name; - return Encode::MIME::Name::get_mime_name(shift->name); - } - -MUST return the string representing the IANA charset name of the encoding. - -=item -E<gt>renew - -Predefined As: - - sub renew { - my $self = shift; - my $clone = bless { %$self } => ref($self); - $clone->{renewed}++; - return $clone; - } - -This method reconstructs the encoding object if necessary. If you need -to store the state during encoding, this is where you clone your object. - -PerlIO ALWAYS calls this method to make sure it has its own private -encoding object. - -=item -E<gt>renewed - -Predefined As: - - sub renewed { $_[0]->{renewed} || 0 } - -Tells whether the object is renewed (and how many times). Some -modules emit C<Use of uninitialized value in null operation> warning -unless the value is numeric so return 0 for false. - -=item -E<gt>perlio_ok() - -Predefined As: - - sub perlio_ok { - eval{ require PerlIO::encoding }; - return $@ ? 0 : 1; - } - -If your encoding does not support PerlIO for some reasons, just; - - sub perlio_ok { 0 } - -=item -E<gt>needs_lines() - -Predefined As: - - sub needs_lines { 0 }; - -If your encoding can work with PerlIO but needs line buffering, you -MUST define this method so it returns true. 7bit ISO-2022 encodings -are one example that needs this. When this method is missing, false -is assumed. - -=back - -=head2 Example: Encode::ROT13 - - package Encode::ROT13; - use strict; - use base qw(Encode::Encoding); - - __PACKAGE__->Define('rot13'); - - sub encode($$;$){ - my ($obj, $str, $chk) = @_; - $str =~ tr/A-Za-z/N-ZA-Mn-za-m/; - $_[1] = '' if $chk; # this is what in-place edit means - return $str; - } - - # Jr pna or ynml yvxr guvf; - *decode = \&encode; - - 1; - -=head1 Why the heck Encode API is different? - -It should be noted that the I<$check> behaviour is different from the -outer public API. The logic is that the "unchecked" case is useful -when the encoding is part of a stream which may be reporting errors -(e.g. STDERR). In such cases, it is desirable to get everything -through somehow without causing additional errors which obscure the -original one. Also, the encoding is best placed to know what the -correct replacement character is, so if that is the desired behaviour -then letting low level code do it is the most efficient. - -By contrast, if I<$check> is true, the scheme above allows the -encoding to do as much as it can and tell the layer above how much -that was. What is lacking at present is a mechanism to report what -went wrong. The most likely interface will be an additional method -call to the object, or perhaps (to avoid forcing per-stream objects -on otherwise stateless encodings) an additional parameter. - -It is also highly desirable that encoding classes inherit from -C<Encode::Encoding> as a base class. This allows that class to define -additional behaviour for all encoding objects. - - package Encode::MyEncoding; - use base qw(Encode::Encoding); - - __PACKAGE__->Define(qw(myCanonical myAlias)); - -to create an object with C<< bless {Name => ...}, $class >>, and call -define_encoding. They inherit their C<name> method from -C<Encode::Encoding>. - -=head2 Compiled Encodings - -For the sake of speed and efficiency, most of the encodings are now -supported via a I<compiled form>: XS modules generated from UCM -files. Encode provides the enc2xs tool to achieve that. Please see -L<enc2xs> for more details. - -=head1 SEE ALSO - -L<perlmod>, L<enc2xs> - -=begin future - -=over 4 - -=item Scheme 1 - -The fixup routine gets passed the remaining fragment of string being -processed. It modifies it in place to remove bytes/characters it can -understand and returns a string used to represent them. For example: - - sub fixup { - my $ch = substr($_[0],0,1,''); - return sprintf("\x{%02X}",ord($ch); - } - -This scheme is close to how the underlying C code for Encode works, -but gives the fixup routine very little context. - -=item Scheme 2 - -The fixup routine gets passed the original string, an index into -it of the problem area, and the output string so far. It appends -what it wants to the output string and returns a new index into the -original string. For example: - - sub fixup { - # my ($s,$i,$d) = @_; - my $ch = substr($_[0],$_[1],1); - $_[2] .= sprintf("\x{%02X}",ord($ch); - return $_[1]+1; - } - -This scheme gives maximal control to the fixup routine but is more -complicated to code, and may require that the internals of Encode be tweaked to -keep the original string intact. - -=item Other Schemes - -Hybrids of the above. - -Multiple return values rather than in-place modifications. - -Index into the string could be C<pos($str)> allowing C<s/\G...//>. - -=back - -=end future - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/GSM0338.pm b/Master/tlpkg/tlperl.straw/lib/Encode/GSM0338.pm deleted file mode 100755 index 2ea71f2f77e..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/GSM0338.pm +++ /dev/null @@ -1,292 +0,0 @@ -# -# $Id: GSM0338.pm,v 2.1 2008/05/07 20:56:05 dankogai Exp $ -# -package Encode::GSM0338; - -use strict; -use warnings; -use Carp; - -use vars qw($VERSION); -$VERSION = do { my @r = ( q$Revision: 2.1 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use Encode qw(:fallbacks); - -use base qw(Encode::Encoding); -__PACKAGE__->Define('gsm0338'); - -sub needs_lines { 1 } -sub perlio_ok { 0 } - -use utf8; -our %UNI2GSM = ( - "\x{0040}" => "\x00", # COMMERCIAL AT - "\x{000A}" => "\x0A", # LINE FEED - "\x{000C}" => "\x1B\x0A", # FORM FEED - "\x{000D}" => "\x0D", # CARRIAGE RETURN - "\x{0020}" => "\x20", # SPACE - "\x{0021}" => "\x21", # EXCLAMATION MARK - "\x{0022}" => "\x22", # QUOTATION MARK - "\x{0023}" => "\x23", # NUMBER SIGN - "\x{0024}" => "\x02", # DOLLAR SIGN - "\x{0025}" => "\x25", # PERCENT SIGN - "\x{0026}" => "\x26", # AMPERSAND - "\x{0027}" => "\x27", # APOSTROPHE - "\x{0028}" => "\x28", # LEFT PARENTHESIS - "\x{0029}" => "\x29", # RIGHT PARENTHESIS - "\x{002A}" => "\x2A", # ASTERISK - "\x{002B}" => "\x2B", # PLUS SIGN - "\x{002C}" => "\x2C", # COMMA - "\x{002D}" => "\x2D", # HYPHEN-MINUS - "\x{002E}" => "\x2E", # FULL STOP - "\x{002F}" => "\x2F", # SOLIDUS - "\x{0030}" => "\x30", # DIGIT ZERO - "\x{0031}" => "\x31", # DIGIT ONE - "\x{0032}" => "\x32", # DIGIT TWO - "\x{0033}" => "\x33", # DIGIT THREE - "\x{0034}" => "\x34", # DIGIT FOUR - "\x{0035}" => "\x35", # DIGIT FIVE - "\x{0036}" => "\x36", # DIGIT SIX - "\x{0037}" => "\x37", # DIGIT SEVEN - "\x{0038}" => "\x38", # DIGIT EIGHT - "\x{0039}" => "\x39", # DIGIT NINE - "\x{003A}" => "\x3A", # COLON - "\x{003B}" => "\x3B", # SEMICOLON - "\x{003C}" => "\x3C", # LESS-THAN SIGN - "\x{003D}" => "\x3D", # EQUALS SIGN - "\x{003E}" => "\x3E", # GREATER-THAN SIGN - "\x{003F}" => "\x3F", # QUESTION MARK - "\x{0041}" => "\x41", # LATIN CAPITAL LETTER A - "\x{0042}" => "\x42", # LATIN CAPITAL LETTER B - "\x{0043}" => "\x43", # LATIN CAPITAL LETTER C - "\x{0044}" => "\x44", # LATIN CAPITAL LETTER D - "\x{0045}" => "\x45", # LATIN CAPITAL LETTER E - "\x{0046}" => "\x46", # LATIN CAPITAL LETTER F - "\x{0047}" => "\x47", # LATIN CAPITAL LETTER G - "\x{0048}" => "\x48", # LATIN CAPITAL LETTER H - "\x{0049}" => "\x49", # LATIN CAPITAL LETTER I - "\x{004A}" => "\x4A", # LATIN CAPITAL LETTER J - "\x{004B}" => "\x4B", # LATIN CAPITAL LETTER K - "\x{004C}" => "\x4C", # LATIN CAPITAL LETTER L - "\x{004D}" => "\x4D", # LATIN CAPITAL LETTER M - "\x{004E}" => "\x4E", # LATIN CAPITAL LETTER N - "\x{004F}" => "\x4F", # LATIN CAPITAL LETTER O - "\x{0050}" => "\x50", # LATIN CAPITAL LETTER P - "\x{0051}" => "\x51", # LATIN CAPITAL LETTER Q - "\x{0052}" => "\x52", # LATIN CAPITAL LETTER R - "\x{0053}" => "\x53", # LATIN CAPITAL LETTER S - "\x{0054}" => "\x54", # LATIN CAPITAL LETTER T - "\x{0055}" => "\x55", # LATIN CAPITAL LETTER U - "\x{0056}" => "\x56", # LATIN CAPITAL LETTER V - "\x{0057}" => "\x57", # LATIN CAPITAL LETTER W - "\x{0058}" => "\x58", # LATIN CAPITAL LETTER X - "\x{0059}" => "\x59", # LATIN CAPITAL LETTER Y - "\x{005A}" => "\x5A", # LATIN CAPITAL LETTER Z - "\x{005F}" => "\x11", # LOW LINE - "\x{0061}" => "\x61", # LATIN SMALL LETTER A - "\x{0062}" => "\x62", # LATIN SMALL LETTER B - "\x{0063}" => "\x63", # LATIN SMALL LETTER C - "\x{0064}" => "\x64", # LATIN SMALL LETTER D - "\x{0065}" => "\x65", # LATIN SMALL LETTER E - "\x{0066}" => "\x66", # LATIN SMALL LETTER F - "\x{0067}" => "\x67", # LATIN SMALL LETTER G - "\x{0068}" => "\x68", # LATIN SMALL LETTER H - "\x{0069}" => "\x69", # LATIN SMALL LETTER I - "\x{006A}" => "\x6A", # LATIN SMALL LETTER J - "\x{006B}" => "\x6B", # LATIN SMALL LETTER K - "\x{006C}" => "\x6C", # LATIN SMALL LETTER L - "\x{006D}" => "\x6D", # LATIN SMALL LETTER M - "\x{006E}" => "\x6E", # LATIN SMALL LETTER N - "\x{006F}" => "\x6F", # LATIN SMALL LETTER O - "\x{0070}" => "\x70", # LATIN SMALL LETTER P - "\x{0071}" => "\x71", # LATIN SMALL LETTER Q - "\x{0072}" => "\x72", # LATIN SMALL LETTER R - "\x{0073}" => "\x73", # LATIN SMALL LETTER S - "\x{0074}" => "\x74", # LATIN SMALL LETTER T - "\x{0075}" => "\x75", # LATIN SMALL LETTER U - "\x{0076}" => "\x76", # LATIN SMALL LETTER V - "\x{0077}" => "\x77", # LATIN SMALL LETTER W - "\x{0078}" => "\x78", # LATIN SMALL LETTER X - "\x{0079}" => "\x79", # LATIN SMALL LETTER Y - "\x{007A}" => "\x7A", # LATIN SMALL LETTER Z - "\x{000C}" => "\x1B\x0A", # FORM FEED - "\x{005B}" => "\x1B\x3C", # LEFT SQUARE BRACKET - "\x{005C}" => "\x1B\x2F", # REVERSE SOLIDUS - "\x{005D}" => "\x1B\x3E", # RIGHT SQUARE BRACKET - "\x{005E}" => "\x1B\x14", # CIRCUMFLEX ACCENT - "\x{007B}" => "\x1B\x28", # LEFT CURLY BRACKET - "\x{007C}" => "\x1B\x40", # VERTICAL LINE - "\x{007D}" => "\x1B\x29", # RIGHT CURLY BRACKET - "\x{007E}" => "\x1B\x3D", # TILDE - "\x{00A0}" => "\x1B", # NO-BREAK SPACE - "\x{00A1}" => "\x40", # INVERTED EXCLAMATION MARK - "\x{00A3}" => "\x01", # POUND SIGN - "\x{00A4}" => "\x24", # CURRENCY SIGN - "\x{00A5}" => "\x03", # YEN SIGN - "\x{00A7}" => "\x5F", # SECTION SIGN - "\x{00BF}" => "\x60", # INVERTED QUESTION MARK - "\x{00C4}" => "\x5B", # LATIN CAPITAL LETTER A WITH DIAERESIS - "\x{00C5}" => "\x0E", # LATIN CAPITAL LETTER A WITH RING ABOVE - "\x{00C6}" => "\x1C", # LATIN CAPITAL LETTER AE - "\x{00C9}" => "\x1F", # LATIN CAPITAL LETTER E WITH ACUTE - "\x{00D1}" => "\x5D", # LATIN CAPITAL LETTER N WITH TILDE - "\x{00D6}" => "\x5C", # LATIN CAPITAL LETTER O WITH DIAERESIS - "\x{00D8}" => "\x0B", # LATIN CAPITAL LETTER O WITH STROKE - "\x{00DC}" => "\x5E", # LATIN CAPITAL LETTER U WITH DIAERESIS - "\x{00DF}" => "\x1E", # LATIN SMALL LETTER SHARP S - "\x{00E0}" => "\x7F", # LATIN SMALL LETTER A WITH GRAVE - "\x{00E4}" => "\x7B", # LATIN SMALL LETTER A WITH DIAERESIS - "\x{00E5}" => "\x0F", # LATIN SMALL LETTER A WITH RING ABOVE - "\x{00E6}" => "\x1D", # LATIN SMALL LETTER AE - "\x{00E7}" => "\x09", # LATIN SMALL LETTER C WITH CEDILLA - "\x{00E8}" => "\x04", # LATIN SMALL LETTER E WITH GRAVE - "\x{00E9}" => "\x05", # LATIN SMALL LETTER E WITH ACUTE - "\x{00EC}" => "\x07", # LATIN SMALL LETTER I WITH GRAVE - "\x{00F1}" => "\x7D", # LATIN SMALL LETTER N WITH TILDE - "\x{00F2}" => "\x08", # LATIN SMALL LETTER O WITH GRAVE - "\x{00F6}" => "\x7C", # LATIN SMALL LETTER O WITH DIAERESIS - "\x{00F8}" => "\x0C", # LATIN SMALL LETTER O WITH STROKE - "\x{00F9}" => "\x06", # LATIN SMALL LETTER U WITH GRAVE - "\x{00FC}" => "\x7E", # LATIN SMALL LETTER U WITH DIAERESIS - "\x{0393}" => "\x13", # GREEK CAPITAL LETTER GAMMA - "\x{0394}" => "\x10", # GREEK CAPITAL LETTER DELTA - "\x{0398}" => "\x19", # GREEK CAPITAL LETTER THETA - "\x{039B}" => "\x14", # GREEK CAPITAL LETTER LAMDA - "\x{039E}" => "\x1A", # GREEK CAPITAL LETTER XI - "\x{03A0}" => "\x16", # GREEK CAPITAL LETTER PI - "\x{03A3}" => "\x18", # GREEK CAPITAL LETTER SIGMA - "\x{03A6}" => "\x12", # GREEK CAPITAL LETTER PHI - "\x{03A8}" => "\x17", # GREEK CAPITAL LETTER PSI - "\x{03A9}" => "\x15", # GREEK CAPITAL LETTER OMEGA - "\x{20AC}" => "\x1B\x65", # EURO SIGN -); -our %GSM2UNI = reverse %UNI2GSM; -our $ESC = "\x1b"; -our $ATMARK = "\x40"; -our $FBCHAR = "\x3F"; -our $NBSP = "\x{00A0}"; - -#define ERR_DECODE_NOMAP "%s \"\\x%02" UVXf "\" does not map to Unicode" - -sub decode ($$;$) { - my ( $obj, $bytes, $chk ) = @_; - my $str; - while ( length $bytes ) { - my $c = substr( $bytes, 0, 1, '' ); - my $u; - if ( $c eq "\x00" ) { - my $c2 = substr( $bytes, 0, 1, '' ); - $u = - !length $c2 ? $ATMARK - : $c2 eq "\x00" ? "\x{0000}" - : exists $GSM2UNI{$c2} ? $ATMARK . $GSM2UNI{$c2} - : $chk - ? croak sprintf( "\\x%02X\\x%02X does not map to Unicode", - ord($c), ord($c2) ) - : $ATMARK . $FBCHAR; - - } - elsif ( $c eq $ESC ) { - my $c2 = substr( $bytes, 0, 1, '' ); - $u = - exists $GSM2UNI{ $c . $c2 } ? $GSM2UNI{ $c . $c2 } - : exists $GSM2UNI{$c2} ? $NBSP . $GSM2UNI{$c2} - : $chk - ? croak sprintf( "\\x%02X\\x%02X does not map to Unicode", - ord($c), ord($c2) ) - : $NBSP . $FBCHAR; - } - else { - $u = - exists $GSM2UNI{$c} - ? $GSM2UNI{$c} - : $chk ? ref $chk eq 'CODE' - ? $chk->( ord $c ) - : croak sprintf( "\\x%02X does not map to Unicode", ord($c) ) - : $FBCHAR; - } - $str .= $u; - } - $_[1] = $bytes if $chk; - return $str; -} - -#define ERR_ENCODE_NOMAP "\"\\x{%04" UVxf "}\" does not map to %s" - -sub encode($$;$) { - my ( $obj, $str, $chk ) = @_; - my $bytes; - while ( length $str ) { - my $u = substr( $str, 0, 1, '' ); - my $c; - $bytes .= - exists $UNI2GSM{$u} - ? $UNI2GSM{$u} - : $chk ? ref $chk eq 'CODE' - ? $chk->( ord($u) ) - : croak sprintf( "\\x{%04x} does not map to %s", - ord($u), $obj->name ) - : $FBCHAR; - } - $_[1] = $str if $chk; - return $bytes; -} - -1; -__END__ - -=head1 NAME - -Encode::GSM0338 -- ESTI GSM 03.38 Encoding - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $gsm0338 = encode("gsm0338", $utf8); # loads Encode::GSM0338 implicitly - $utf8 = decode("gsm0338", $gsm0338); # ditto - -=head1 DESCRIPTION - -GSM0338 is for GSM handsets. Though it shares alphanumerals with ASCII, -control character ranges and other parts are mapped very differently, -mainly to store Greek characters. There are also escape sequences -(starting with 0x1B) to cover e.g. the Euro sign. - -This was once handled by L<Encode::Bytes> but because of all those -unusual specifications, Encode 2.20 has relocated the support to -this module. - -=head1 NOTES - -Unlike most other encodings, the following aways croaks on error -for any $chk that evaluates to true. - - $gsm0338 = encode("gsm0338", $utf8 $chk); - $utf8 = decode("gsm0338", $gsm0338, $chk); - -So if you want to check the validity of the encoding, surround the -expression with C<eval {}> block as follows; - - eval { - $utf8 = decode("gsm0338", $gsm0338, $chk); - }; - if ($@){ - # handle exception here - } - -=head1 BUGS - -ESTI GSM 03.38 Encoding itself. - -Mapping \x00 to '@' causes too much pain everywhere. - -Its use of \x1b (escape) is also very questionable. - -Because of those two, the code paging approach used use in ucm-based -Encoding SOMETIMES fails so this module was written. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Guess.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Guess.pm deleted file mode 100755 index 1ad7147e7f5..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Guess.pm +++ /dev/null @@ -1,355 +0,0 @@ -package Encode::Guess; -use strict; -use warnings; -use Encode qw(:fallbacks find_encoding); -our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -my $Canon = 'Guess'; -sub DEBUG () { 0 } -our %DEF_SUSPECTS = map { $_ => find_encoding($_) } qw(ascii utf8); -$Encode::Encoding{$Canon} = bless { - Name => $Canon, - Suspects => {%DEF_SUSPECTS}, -} => __PACKAGE__; - -use base qw(Encode::Encoding); -sub needs_lines { 1 } -sub perlio_ok { 0 } - -our @EXPORT = qw(guess_encoding); -our $NoUTFAutoGuess = 0; -our $UTF8_BOM = pack( "C3", 0xef, 0xbb, 0xbf ); - -sub import { # Exporter not used so we do it on our own - my $callpkg = caller; - for my $item (@EXPORT) { - no strict 'refs'; - *{"$callpkg\::$item"} = \&{"$item"}; - } - set_suspects(@_); -} - -sub set_suspects { - my $class = shift; - my $self = ref($class) ? $class : $Encode::Encoding{$Canon}; - $self->{Suspects} = {%DEF_SUSPECTS}; - $self->add_suspects(@_); -} - -sub add_suspects { - my $class = shift; - my $self = ref($class) ? $class : $Encode::Encoding{$Canon}; - for my $c (@_) { - my $e = find_encoding($c) or die "Unknown encoding: $c"; - $self->{Suspects}{ $e->name } = $e; - DEBUG and warn "Added: ", $e->name; - } -} - -sub decode($$;$) { - my ( $obj, $octet, $chk ) = @_; - my $guessed = guess( $obj, $octet ); - unless ( ref($guessed) ) { - require Carp; - Carp::croak($guessed); - } - my $utf8 = $guessed->decode( $octet, $chk ); - $_[1] = $octet if $chk; - return $utf8; -} - -sub guess_encoding { - guess( $Encode::Encoding{$Canon}, @_ ); -} - -sub guess { - my $class = shift; - my $obj = ref($class) ? $class : $Encode::Encoding{$Canon}; - my $octet = shift; - - # sanity check - return "Empty string, empty guess" unless defined $octet and length $octet; - - # cheat 0: utf8 flag; - if ( Encode::is_utf8($octet) ) { - return find_encoding('utf8') unless $NoUTFAutoGuess; - Encode::_utf8_off($octet); - } - - # cheat 1: BOM - use Encode::Unicode; - unless ($NoUTFAutoGuess) { - my $BOM = pack( 'C3', unpack( "C3", $octet ) ); - return find_encoding('utf8') - if ( defined $BOM and $BOM eq $UTF8_BOM ); - $BOM = unpack( 'N', $octet ); - return find_encoding('UTF-32') - if ( defined $BOM and ( $BOM == 0xFeFF or $BOM == 0xFFFe0000 ) ); - $BOM = unpack( 'n', $octet ); - return find_encoding('UTF-16') - if ( defined $BOM and ( $BOM == 0xFeFF or $BOM == 0xFFFe ) ); - if ( $octet =~ /\x00/o ) - { # if \x00 found, we assume UTF-(16|32)(BE|LE) - my $utf; - my ( $be, $le ) = ( 0, 0 ); - if ( $octet =~ /\x00\x00/o ) { # UTF-32(BE|LE) assumed - $utf = "UTF-32"; - for my $char ( unpack( 'N*', $octet ) ) { - $char & 0x0000ffff and $be++; - $char & 0xffff0000 and $le++; - } - } - else { # UTF-16(BE|LE) assumed - $utf = "UTF-16"; - for my $char ( unpack( 'n*', $octet ) ) { - $char & 0x00ff and $be++; - $char & 0xff00 and $le++; - } - } - DEBUG and warn "$utf, be == $be, le == $le"; - $be == $le - and return - "Encodings ambiguous between $utf BE and LE ($be, $le)"; - $utf .= ( $be > $le ) ? 'BE' : 'LE'; - return find_encoding($utf); - } - } - my %try = %{ $obj->{Suspects} }; - for my $c (@_) { - my $e = find_encoding($c) or die "Unknown encoding: $c"; - $try{ $e->name } = $e; - DEBUG and warn "Added: ", $e->name; - } - my $nline = 1; - for my $line ( split /\r\n?|\n/, $octet ) { - - # cheat 2 -- \e in the string - if ( $line =~ /\e/o ) { - my @keys = keys %try; - delete @try{qw/utf8 ascii/}; - for my $k (@keys) { - ref( $try{$k} ) eq 'Encode::XS' and delete $try{$k}; - } - } - my %ok = %try; - - # warn join(",", keys %try); - for my $k ( keys %try ) { - my $scratch = $line; - $try{$k}->decode( $scratch, FB_QUIET ); - if ( $scratch eq '' ) { - DEBUG and warn sprintf( "%4d:%-24s ok\n", $nline, $k ); - } - else { - use bytes (); - DEBUG - and warn sprintf( "%4d:%-24s not ok; %d bytes left\n", - $nline, $k, bytes::length($scratch) ); - delete $ok{$k}; - } - } - %ok or return "No appropriate encodings found!"; - if ( scalar( keys(%ok) ) == 1 ) { - my ($retval) = values(%ok); - return $retval; - } - %try = %ok; - $nline++; - } - $try{ascii} - or return "Encodings too ambiguous: ", join( " or ", keys %try ); - return $try{ascii}; -} - -1; -__END__ - -=head1 NAME - -Encode::Guess -- Guesses encoding from data - -=head1 SYNOPSIS - - # if you are sure $data won't contain anything bogus - - use Encode; - use Encode::Guess qw/euc-jp shiftjis 7bit-jis/; - my $utf8 = decode("Guess", $data); - my $data = encode("Guess", $utf8); # this doesn't work! - - # more elaborate way - use Encode::Guess; - my $enc = guess_encoding($data, qw/euc-jp shiftjis 7bit-jis/); - ref($enc) or die "Can't guess: $enc"; # trap error this way - $utf8 = $enc->decode($data); - # or - $utf8 = decode($enc->name, $data) - -=head1 ABSTRACT - -Encode::Guess enables you to guess in what encoding a given data is -encoded, or at least tries to. - -=head1 DESCRIPTION - -By default, it checks only ascii, utf8 and UTF-16/32 with BOM. - - use Encode::Guess; # ascii/utf8/BOMed UTF - -To use it more practically, you have to give the names of encodings to -check (I<suspects> as follows). The name of suspects can either be -canonical names or aliases. - -CAVEAT: Unlike UTF-(16|32), BOM in utf8 is NOT AUTOMATICALLY STRIPPED. - - # tries all major Japanese Encodings as well - use Encode::Guess qw/euc-jp shiftjis 7bit-jis/; - -If the C<$Encode::Guess::NoUTFAutoGuess> variable is set to a true -value, no heuristics will be applied to UTF8/16/32, and the result -will be limited to the suspects and C<ascii>. - -=over 4 - -=item Encode::Guess->set_suspects - -You can also change the internal suspects list via C<set_suspects> -method. - - use Encode::Guess; - Encode::Guess->set_suspects(qw/euc-jp shiftjis 7bit-jis/); - -=item Encode::Guess->add_suspects - -Or you can use C<add_suspects> method. The difference is that -C<set_suspects> flushes the current suspects list while -C<add_suspects> adds. - - use Encode::Guess; - Encode::Guess->add_suspects(qw/euc-jp shiftjis 7bit-jis/); - # now the suspects are euc-jp,shiftjis,7bit-jis, AND - # euc-kr,euc-cn, and big5-eten - Encode::Guess->add_suspects(qw/euc-kr euc-cn big5-eten/); - -=item Encode::decode("Guess" ...) - -When you are content with suspects list, you can now - - my $utf8 = Encode::decode("Guess", $data); - -=item Encode::Guess->guess($data) - -But it will croak if: - -=over - -=item * - -Two or more suspects remain - -=item * - -No suspects left - -=back - -So you should instead try this; - - my $decoder = Encode::Guess->guess($data); - -On success, $decoder is an object that is documented in -L<Encode::Encoding>. So you can now do this; - - my $utf8 = $decoder->decode($data); - -On failure, $decoder now contains an error message so the whole thing -would be as follows; - - my $decoder = Encode::Guess->guess($data); - die $decoder unless ref($decoder); - my $utf8 = $decoder->decode($data); - -=item guess_encoding($data, [, I<list of suspects>]) - -You can also try C<guess_encoding> function which is exported by -default. It takes $data to check and it also takes the list of -suspects by option. The optional suspect list is I<not reflected> to -the internal suspects list. - - my $decoder = guess_encoding($data, qw/euc-jp euc-kr euc-cn/); - die $decoder unless ref($decoder); - my $utf8 = $decoder->decode($data); - # check only ascii and utf8 - my $decoder = guess_encoding($data); - -=back - -=head1 CAVEATS - -=over 4 - -=item * - -Because of the algorithm used, ISO-8859 series and other single-byte -encodings do not work well unless either one of ISO-8859 is the only -one suspect (besides ascii and utf8). - - use Encode::Guess; - # perhaps ok - my $decoder = guess_encoding($data, 'latin1'); - # definitely NOT ok - my $decoder = guess_encoding($data, qw/latin1 greek/); - -The reason is that Encode::Guess guesses encoding by trial and error. -It first splits $data into lines and tries to decode the line for each -suspect. It keeps it going until all but one encoding is eliminated -out of suspects list. ISO-8859 series is just too successful for most -cases (because it fills almost all code points in \x00-\xff). - -=item * - -Do not mix national standard encodings and the corresponding vendor -encodings. - - # a very bad idea - my $decoder - = guess_encoding($data, qw/shiftjis MacJapanese cp932/); - -The reason is that vendor encoding is usually a superset of national -standard so it becomes too ambiguous for most cases. - -=item * - -On the other hand, mixing various national standard encodings -automagically works unless $data is too short to allow for guessing. - - # This is ok if $data is long enough - my $decoder = - guess_encoding($data, qw/euc-cn - euc-jp shiftjis 7bit-jis - euc-kr - big5-eten/); - -=item * - -DO NOT PUT TOO MANY SUSPECTS! Don't you try something like this! - - my $decoder = guess_encoding($data, - Encode->encodings(":all")); - -=back - -It is, after all, just a guess. You should alway be explicit when it -comes to encodings. But there are some, especially Japanese, -environment that guess-coding is a must. Use this module with care. - -=head1 TO DO - -Encode::Guess does not work on EBCDIC platforms. - -=head1 SEE ALSO - -L<Encode>, L<Encode::Encoding> - -=cut - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/JP.pm b/Master/tlpkg/tlperl.straw/lib/Encode/JP.pm deleted file mode 100755 index 4251170c561..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/JP.pm +++ /dev/null @@ -1,95 +0,0 @@ -package Encode::JP; -BEGIN { - if ( ord("A") == 193 ) { - die "Encode::JP not supported on EBCDIC\n"; - } -} -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -use Encode::JP::JIS7; - -1; -__END__ - -=head1 NAME - -Encode::JP - Japanese Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $euc_jp = encode("euc-jp", $utf8); # loads Encode::JP implicitly - $utf8 = decode("euc-jp", $euc_jp); # ditto - -=head1 ABSTRACT - -This module implements Japanese charset encodings. Encodings -supported are as follows. - - Canonical Alias Description - -------------------------------------------------------------------- - euc-jp /\beuc.*jp$/i EUC (Extended Unix Character) - /\bjp.*euc/i - /\bujis$/i - shiftjis /\bshift.*jis$/i Shift JIS (aka MS Kanji) - /\bsjis$/i - 7bit-jis /\bjis$/i 7bit JIS - iso-2022-jp ISO-2022-JP [RFC1468] - = 7bit JIS with all Halfwidth Kana - converted to Fullwidth - iso-2022-jp-1 ISO-2022-JP-1 [RFC2237] - = ISO-2022-JP with JIS X 0212-1990 - support. See below - MacJapanese Shift JIS + Apple vendor mappings - cp932 /\bwindows-31j$/i Code Page 932 - = Shift JIS + MS/IBM vendor mappings - jis0201-raw JIS0201, raw format - jis0208-raw JIS0201, raw format - jis0212-raw JIS0201, raw format - -------------------------------------------------------------------- - -=head1 DESCRIPTION - -To find out how to use this module in detail, see L<Encode>. - -=head1 Note on ISO-2022-JP(-1)? - -ISO-2022-JP-1 (RFC2237) is a superset of ISO-2022-JP (RFC1468) which -adds support for JIS X 0212-1990. That means you can use the same -code to decode to utf8 but not vice versa. - - $utf8 = decode('iso-2022-jp-1', $stream); - -and - - $utf8 = decode('iso-2022-jp', $stream); - -yield the same result but - - $with_0212 = encode('iso-2022-jp-1', $utf8); - -is now different from - - $without_0212 = encode('iso-2022-jp', $utf8 ); - -In the latter case, characters that map to 0212 are first converted -to U+3013 (0xA2AE in EUC-JP; a white square also known as 'Tofu' or -'geta mark') then fed to the decoding engine. U+FFFD is not used, -in order to preserve text layout as much as possible. - -=head1 BUGS - -The ASCII region (0x00-0x7f) is preserved for all encodings, even -though this conflicts with mappings by the Unicode Consortium. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/JP/H2Z.pm b/Master/tlpkg/tlperl.straw/lib/Encode/JP/H2Z.pm deleted file mode 100755 index f8e2230da11..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/JP/H2Z.pm +++ /dev/null @@ -1,176 +0,0 @@ -# -# $Id: H2Z.pm,v 2.2 2006/06/03 20:28:48 dankogai Exp $ -# - -package Encode::JP::H2Z; - -use strict; -use warnings; - -our $RCSID = q$Id: H2Z.pm,v 2.2 2006/06/03 20:28:48 dankogai Exp $; -our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use Encode::CJKConstants qw(:all); - -use vars qw(%_D2Z $_PAT_D2Z - %_Z2D $_PAT_Z2D - %_H2Z $_PAT_H2Z - %_Z2H $_PAT_Z2H); - -%_H2Z = ( - "\x8e\xa1" => "\xa1\xa3", #¡£ - "\x8e\xa2" => "\xa1\xd6", #¡Ö - "\x8e\xa3" => "\xa1\xd7", #¡× - "\x8e\xa4" => "\xa1\xa2", #¡¢ - "\x8e\xa5" => "\xa1\xa6", #¡¦ - "\x8e\xa6" => "\xa5\xf2", #¥ò - "\x8e\xa7" => "\xa5\xa1", #¥¡ - "\x8e\xa8" => "\xa5\xa3", #¥£ - "\x8e\xa9" => "\xa5\xa5", #¥¥ - "\x8e\xaa" => "\xa5\xa7", #¥§ - "\x8e\xab" => "\xa5\xa9", #¥© - "\x8e\xac" => "\xa5\xe3", #¥ã - "\x8e\xad" => "\xa5\xe5", #¥å - "\x8e\xae" => "\xa5\xe7", #¥ç - "\x8e\xaf" => "\xa5\xc3", #¥Ã - "\x8e\xb0" => "\xa1\xbc", #¡¼ - "\x8e\xb1" => "\xa5\xa2", #¥¢ - "\x8e\xb2" => "\xa5\xa4", #¥¤ - "\x8e\xb3" => "\xa5\xa6", #¥¦ - "\x8e\xb4" => "\xa5\xa8", #¥¨ - "\x8e\xb5" => "\xa5\xaa", #¥ª - "\x8e\xb6" => "\xa5\xab", #¥« - "\x8e\xb7" => "\xa5\xad", #¥ - "\x8e\xb8" => "\xa5\xaf", #¥¯ - "\x8e\xb9" => "\xa5\xb1", #¥± - "\x8e\xba" => "\xa5\xb3", #¥³ - "\x8e\xbb" => "\xa5\xb5", #¥µ - "\x8e\xbc" => "\xa5\xb7", #¥· - "\x8e\xbd" => "\xa5\xb9", #¥¹ - "\x8e\xbe" => "\xa5\xbb", #¥» - "\x8e\xbf" => "\xa5\xbd", #¥½ - "\x8e\xc0" => "\xa5\xbf", #¥¿ - "\x8e\xc1" => "\xa5\xc1", #¥Á - "\x8e\xc2" => "\xa5\xc4", #¥Ä - "\x8e\xc3" => "\xa5\xc6", #¥Æ - "\x8e\xc4" => "\xa5\xc8", #¥È - "\x8e\xc5" => "\xa5\xca", #¥Ê - "\x8e\xc6" => "\xa5\xcb", #¥Ë - "\x8e\xc7" => "\xa5\xcc", #¥Ì - "\x8e\xc8" => "\xa5\xcd", #¥Í - "\x8e\xc9" => "\xa5\xce", #¥Î - "\x8e\xca" => "\xa5\xcf", #¥Ï - "\x8e\xcb" => "\xa5\xd2", #¥Ò - "\x8e\xcc" => "\xa5\xd5", #¥Õ - "\x8e\xcd" => "\xa5\xd8", #¥Ø - "\x8e\xce" => "\xa5\xdb", #¥Û - "\x8e\xcf" => "\xa5\xde", #¥Þ - "\x8e\xd0" => "\xa5\xdf", #¥ß - "\x8e\xd1" => "\xa5\xe0", #¥à - "\x8e\xd2" => "\xa5\xe1", #¥á - "\x8e\xd3" => "\xa5\xe2", #¥â - "\x8e\xd4" => "\xa5\xe4", #¥ä - "\x8e\xd5" => "\xa5\xe6", #¥æ - "\x8e\xd6" => "\xa5\xe8", #¥è - "\x8e\xd7" => "\xa5\xe9", #¥é - "\x8e\xd8" => "\xa5\xea", #¥ê - "\x8e\xd9" => "\xa5\xeb", #¥ë - "\x8e\xda" => "\xa5\xec", #¥ì - "\x8e\xdb" => "\xa5\xed", #¥í - "\x8e\xdc" => "\xa5\xef", #¥ï - "\x8e\xdd" => "\xa5\xf3", #¥ó - "\x8e\xde" => "\xa1\xab", #¡« - "\x8e\xdf" => "\xa1\xac", #¡¬ -); - -%_D2Z = ( - "\x8e\xb6\x8e\xde" => "\xa5\xac", #¥¬ - "\x8e\xb7\x8e\xde" => "\xa5\xae", #¥® - "\x8e\xb8\x8e\xde" => "\xa5\xb0", #¥° - "\x8e\xb9\x8e\xde" => "\xa5\xb2", #¥² - "\x8e\xba\x8e\xde" => "\xa5\xb4", #¥´ - "\x8e\xbb\x8e\xde" => "\xa5\xb6", #¥¶ - "\x8e\xbc\x8e\xde" => "\xa5\xb8", #¥¸ - "\x8e\xbd\x8e\xde" => "\xa5\xba", #¥º - "\x8e\xbe\x8e\xde" => "\xa5\xbc", #¥¼ - "\x8e\xbf\x8e\xde" => "\xa5\xbe", #¥¾ - "\x8e\xc0\x8e\xde" => "\xa5\xc0", #¥À - "\x8e\xc1\x8e\xde" => "\xa5\xc2", #¥Â - "\x8e\xc2\x8e\xde" => "\xa5\xc5", #¥Å - "\x8e\xc3\x8e\xde" => "\xa5\xc7", #¥Ç - "\x8e\xc4\x8e\xde" => "\xa5\xc9", #¥É - "\x8e\xca\x8e\xde" => "\xa5\xd0", #¥Ð - "\x8e\xcb\x8e\xde" => "\xa5\xd3", #¥Ó - "\x8e\xcc\x8e\xde" => "\xa5\xd6", #¥Ö - "\x8e\xcd\x8e\xde" => "\xa5\xd9", #¥Ù - "\x8e\xce\x8e\xde" => "\xa5\xdc", #¥Ü - "\x8e\xca\x8e\xdf" => "\xa5\xd1", #¥Ñ - "\x8e\xcb\x8e\xdf" => "\xa5\xd4", #¥Ô - "\x8e\xcc\x8e\xdf" => "\xa5\xd7", #¥× - "\x8e\xcd\x8e\xdf" => "\xa5\xda", #¥Ú - "\x8e\xce\x8e\xdf" => "\xa5\xdd", #¥Ý - "\x8e\xb3\x8e\xde" => "\xa5\xf4", #¥ô -); - -# init only once; - -#$_PAT_D2Z = join("|", keys %_D2Z); -#$_PAT_H2Z = join("|", keys %_H2Z); - -%_Z2H = reverse %_H2Z; -%_Z2D = reverse %_D2Z; - -#$_PAT_Z2H = join("|", keys %_Z2H); -#$_PAT_Z2D = join("|", keys %_Z2D); - -sub h2z { - no warnings qw(uninitialized); - my $r_str = shift; - my ($keep_dakuten) = @_; - my $n = 0; - unless ($keep_dakuten) { - $n = ( - $$r_str =~ s( - ($RE{EUC_KANA} - (?:\x8e[\xde\xdf])?) - ){ - my $str = $1; - $_D2Z{$str} || $_H2Z{$str} || - # in case dakuten and handakuten are side-by-side! - $_H2Z{substr($str,0,2)} . $_H2Z{substr($str,2,2)}; - }eogx - ); - } - else { - $n = ( - $$r_str =~ s( - ($RE{EUC_KANA}) - ){ - $_H2Z{$1}; - }eogx - ); - } - $n; -} - -sub z2h { - my $r_str = shift; - my $n = ( - $$r_str =~ s( - ($RE{EUC_C}|$RE{EUC_0212}|$RE{EUC_KANA}) - ){ - $_Z2D{$1} || $_Z2H{$1} || $1; - }eogx - ); - $n; -} - -1; -__END__ - - -=head1 NAME - -Encode::JP::H2Z -- internally used by Encode::JP::2022_JP* - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/JP/JIS7.pm b/Master/tlpkg/tlperl.straw/lib/Encode/JP/JIS7.pm deleted file mode 100755 index 3b5699c7fd0..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/JP/JIS7.pm +++ /dev/null @@ -1,165 +0,0 @@ -package Encode::JP::JIS7; -use strict; -use warnings; -our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use Encode qw(:fallbacks); - -for my $name ( '7bit-jis', 'iso-2022-jp', 'iso-2022-jp-1' ) { - my $h2z = ( $name eq '7bit-jis' ) ? 0 : 1; - my $jis0212 = ( $name eq 'iso-2022-jp' ) ? 0 : 1; - - $Encode::Encoding{$name} = bless { - Name => $name, - h2z => $h2z, - jis0212 => $jis0212, - } => __PACKAGE__; -} - -use base qw(Encode::Encoding); - -# we override this to 1 so PerlIO works -sub needs_lines { 1 } - -use Encode::CJKConstants qw(:all); - -# -# decode is identical for all 2022 variants -# - -sub decode($$;$) { - my ( $obj, $str, $chk ) = @_; - my $residue = ''; - if ($chk) { - $str =~ s/([^\x00-\x7f].*)$//so and $residue = $1; - } - $residue .= jis_euc( \$str ); - $_[1] = $residue if $chk; - return Encode::decode( 'euc-jp', $str, FB_PERLQQ ); -} - -# -# encode is different -# - -sub encode($$;$) { - require Encode::JP::H2Z; - my ( $obj, $utf8, $chk ) = @_; - - # empty the input string in the stack so perlio is ok - $_[1] = '' if $chk; - my ( $h2z, $jis0212 ) = @$obj{qw(h2z jis0212)}; - my $octet = Encode::encode( 'euc-jp', $utf8, $chk ); - $h2z and &Encode::JP::H2Z::h2z( \$octet ); - euc_jis( \$octet, $jis0212 ); - return $octet; -} - -# -# cat_decode -# -my $re_scan_jis_g = qr{ - \G ( ($RE{JIS_0212}) | $RE{JIS_0208} | - ($RE{ISO_ASC}) | ($RE{JIS_KANA}) | ) - ([^\e]*) -}x; - -sub cat_decode { # ($obj, $dst, $src, $pos, $trm, $chk) - my ( $obj, undef, undef, $pos, $trm ) = @_; # currently ignores $chk - my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ]; - local ${^ENCODING}; - use bytes; - my $opos = pos($$rsrc); - pos($$rsrc) = $pos; - while ( $$rsrc =~ /$re_scan_jis_g/gc ) { - my ( $esc, $esc_0212, $esc_asc, $esc_kana, $chunk ) = - ( $1, $2, $3, $4, $5 ); - - unless ($chunk) { $esc or last; next; } - - if ( $esc && !$esc_asc ) { - $chunk =~ tr/\x21-\x7e/\xa1-\xfe/; - if ($esc_kana) { - $chunk =~ s/([\xa1-\xdf])/\x8e$1/og; - } - elsif ($esc_0212) { - $chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og; - } - $chunk = Encode::decode( 'euc-jp', $chunk, 0 ); - } - elsif ( ( my $npos = index( $chunk, $trm ) ) >= 0 ) { - $$rdst .= substr( $chunk, 0, $npos + length($trm) ); - $$rpos += length($esc) + $npos + length($trm); - pos($$rsrc) = $opos; - return 1; - } - $$rdst .= $chunk; - $$rpos = pos($$rsrc); - } - $$rpos = pos($$rsrc); - pos($$rsrc) = $opos; - return ''; -} - -# JIS<->EUC -my $re_scan_jis = qr{ - (?:($RE{JIS_0212})|$RE{JIS_0208}|($RE{ISO_ASC})|($RE{JIS_KANA}))([^\e]*) -}x; - -sub jis_euc { - local ${^ENCODING}; - my $r_str = shift; - $$r_str =~ s($re_scan_jis) - { - my ($esc_0212, $esc_asc, $esc_kana, $chunk) = - ($1, $2, $3, $4); - if (!$esc_asc) { - $chunk =~ tr/\x21-\x7e/\xa1-\xfe/; - if ($esc_kana) { - $chunk =~ s/([\xa1-\xdf])/\x8e$1/og; - } - elsif ($esc_0212) { - $chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og; - } - } - $chunk; - }geox; - my ($residue) = ( $$r_str =~ s/(\e.*)$//so ); - return $residue; -} - -sub euc_jis { - no warnings qw(uninitialized); - local ${^ENCODING}; - my $r_str = shift; - my $jis0212 = shift; - $$r_str =~ s{ - ((?:$RE{EUC_C})+|(?:$RE{EUC_KANA})+|(?:$RE{EUC_0212})+) - }{ - my $chunk = $1; - my $esc = - ( $chunk =~ tr/\x8E//d ) ? $ESC{KANA} : - ( $chunk =~ tr/\x8F//d ) ? $ESC{JIS_0212} : - $ESC{JIS_0208}; - if ($esc eq $ESC{JIS_0212} && !$jis0212){ - # fallback to '?' - $chunk =~ tr/\xA1-\xFE/\x3F/; - }else{ - $chunk =~ tr/\xA1-\xFE/\x21-\x7E/; - } - $esc . $chunk . $ESC{ASC}; - }geox; - $$r_str =~ s/\Q$ESC{ASC}\E - (\Q$ESC{KANA}\E|\Q$ESC{JIS_0212}\E|\Q$ESC{JIS_0208}\E)/$1/gox; - $$r_str; -} - -1; -__END__ - - -=head1 NAME - -Encode::JP::JIS7 -- internally used by Encode::JP - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/KR.pm b/Master/tlpkg/tlperl.straw/lib/Encode/KR.pm deleted file mode 100755 index cf2c1174e4b..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/KR.pm +++ /dev/null @@ -1,69 +0,0 @@ -package Encode::KR; -BEGIN { - if ( ord("A") == 193 ) { - die "Encode::KR not supported on EBCDIC\n"; - } -} -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -use Encode::KR::2022_KR; - -1; -__END__ - -=head1 NAME - -Encode::KR - Korean Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $euc_kr = encode("euc-kr", $utf8); # loads Encode::KR implicitly - $utf8 = decode("euc-kr", $euc_kr); # ditto - -=head1 DESCRIPTION - -This module implements Korean charset encodings. Encodings supported -are as follows. - - - Canonical Alias Description - -------------------------------------------------------------------- - euc-kr /\beuc.*kr$/i EUC (Extended Unix Character) - /\bkr.*euc$/i - ksc5601-raw Korean standard code set (as is) - cp949 /(?:x-)?uhc$/i - /(?:x-)?windows-949$/i - /\bks_c_5601-1987$/i - Code Page 949 (EUC-KR + 8,822 - (additional Hangul syllables) - MacKorean EUC-KR + Apple Vendor Mappings - johab JOHAB A supplementary encoding defined in - Annex 3 of KS X 1001:1998 - iso-2022-kr iso-2022-kr [RFC1557] - -------------------------------------------------------------------- - -To find how to use this module in detail, see L<Encode>. - -=head1 BUGS - -When you see C<charset=ks_c_5601-1987> on mails and web pages, they really -mean "cp949" encodings. To fix that, the following aliases are set; - - qr/(?:x-)?uhc$/i => '"cp949"' - qr/(?:x-)?windows-949$/i => '"cp949"' - qr/ks_c_5601-1987$/i => '"cp949"' - -The ASCII region (0x00-0x7f) is preserved for all encodings, even -though this conflicts with mappings by the Unicode Consortium. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/KR/2022_KR.pm b/Master/tlpkg/tlperl.straw/lib/Encode/KR/2022_KR.pm deleted file mode 100755 index 0218d971ee2..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/KR/2022_KR.pm +++ /dev/null @@ -1,81 +0,0 @@ -package Encode::KR::2022_KR; -use strict; -use warnings; -our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use Encode qw(:fallbacks); - -use base qw(Encode::Encoding); -__PACKAGE__->Define('iso-2022-kr'); - -sub needs_lines { 1 } - -sub perlio_ok { - return 0; # for the time being -} - -sub decode { - my ( $obj, $str, $chk ) = @_; - my $res = $str; - my $residue = iso_euc( \$res ); - - # This is for PerlIO - $_[1] = $residue if $chk; - return Encode::decode( 'euc-kr', $res, FB_PERLQQ ); -} - -sub encode { - my ( $obj, $utf8, $chk ) = @_; - - # empty the input string in the stack so perlio is ok - $_[1] = '' if $chk; - my $octet = Encode::encode( 'euc-kr', $utf8, FB_PERLQQ ); - euc_iso( \$octet ); - return $octet; -} - -use Encode::CJKConstants qw(:all); - -# ISO<->EUC - -sub iso_euc { - my $r_str = shift; - $$r_str =~ s/$RE{'2022_KR'}//gox; # remove the designator - $$r_str =~ s{ # replace characters in GL - \x0e # between SO(\x0e) and SI(\x0f) - ([^\x0f]*) # with characters in GR - \x0f - } - { - my $out= $1; - $out =~ tr/\x21-\x7e/\xa1-\xfe/; - $out; - }geox; - my ($residue) = ( $$r_str =~ s/(\e.*)$//so ); - return $residue; -} - -sub euc_iso { - no warnings qw(uninitialized); - my $r_str = shift; - substr( $$r_str, 0, 0 ) = - $ESC{'2022_KR'}; # put the designator at the beg. - $$r_str =~ - s{ # move KS X 1001 characters in GR to GL - ($RE{EUC_C}+) # and enclose them with SO and SI - }{ - my $str = $1; - $str =~ tr/\xA1-\xFE/\x21-\x7E/; - "\x0e" . $str . "\x0f"; - }geox; - $$r_str; -} - -1; -__END__ - -=head1 NAME - -Encode::KR::2022_KR -- internally used by Encode::KR - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Header.pm b/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Header.pm deleted file mode 100755 index 9728dc32d89..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Header.pm +++ /dev/null @@ -1,241 +0,0 @@ -package Encode::MIME::Header; -use strict; -use warnings; -no warnings 'redefine'; - -our $VERSION = do { my @r = ( q$Revision: 2.11 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; -use Encode qw(find_encoding encode_utf8 decode_utf8); -use MIME::Base64; -use Carp; - -my %seed = ( - decode_b => '1', # decodes 'B' encoding ? - decode_q => '1', # decodes 'Q' encoding ? - encode => 'B', # encode with 'B' or 'Q' ? - bpl => 75, # bytes per line -); - -$Encode::Encoding{'MIME-Header'} = - bless { %seed, Name => 'MIME-Header', } => __PACKAGE__; - -$Encode::Encoding{'MIME-B'} = bless { - %seed, - decode_q => 0, - Name => 'MIME-B', -} => __PACKAGE__; - -$Encode::Encoding{'MIME-Q'} = bless { - %seed, - decode_q => 1, - encode => 'Q', - Name => 'MIME-Q', -} => __PACKAGE__; - -use base qw(Encode::Encoding); - -sub needs_lines { 1 } -sub perlio_ok { 0 } - -sub decode($$;$) { - use utf8; - my ( $obj, $str, $chk ) = @_; - - # zap spaces between encoded words - $str =~ s/\?=\s+=\?/\?==\?/gos; - - # multi-line header to single line - $str =~ s/(?:\r\n|[\r\n])[ \t]//gos; - - 1 while ( $str =~ - s/(=\?[-0-9A-Za-z_]+\?[Qq]\?)(.*?)\?=\1(.*?\?=)/$1$2$3/ ) - ; # Concat consecutive QP encoded mime headers - # Fixes breaking inside multi-byte characters - - $str =~ s{ - =\? # begin encoded word - ([-0-9A-Za-z_]+) # charset (encoding) - (?:\*[A-Za-z]{1,8}(?:-[A-Za-z]{1,8})*)? # language (RFC 2231) - \?([QqBb])\? # delimiter - (.*?) # Base64-encodede contents - \?= # end encoded word - }{ - if (uc($2) eq 'B'){ - $obj->{decode_b} or croak qq(MIME "B" unsupported); - decode_b($1, $3, $chk); - } elsif (uc($2) eq 'Q'){ - $obj->{decode_q} or croak qq(MIME "Q" unsupported); - decode_q($1, $3, $chk); - } else { - croak qq(MIME "$2" encoding is nonexistent!); - } - }egox; - $_[1] = $str if $chk; - return $str; -} - -sub decode_b { - my $enc = shift; - my $d = find_encoding($enc) or croak qq(Unknown encoding "$enc"); - my $db64 = decode_base64(shift); - my $chk = shift; - return $d->name eq 'utf8' - ? Encode::decode_utf8($db64) - : $d->decode( $db64, $chk || Encode::FB_PERLQQ ); -} - -sub decode_q { - my ( $enc, $q, $chk ) = @_; - my $d = find_encoding($enc) or croak qq(Unknown encoding "$enc"); - $q =~ s/_/ /go; - $q =~ s/=([0-9A-Fa-f]{2})/pack("C", hex($1))/ego; - return $d->name eq 'utf8' - ? Encode::decode_utf8($q) - : $d->decode( $q, $chk || Encode::FB_PERLQQ ); -} - -my $especials = - join( '|' => map { quotemeta( chr($_) ) } - unpack( "C*", qq{()<>@,;:"'/[]?.=} ) ); - -my $re_encoded_word = qr{ - =\? # begin encoded word - (?:[-0-9A-Za-z_]+) # charset (encoding) - (?:\*[A-Za-z]{1,8}(?:-[A-Za-z]{1,8})*)? # language (RFC 2231) - \?(?:[QqBb])\? # delimiter - (?:.*?) # Base64-encodede contents - \?= # end encoded word -}xo; - -my $re_especials = qr{$re_encoded_word|$especials}xo; - -sub encode($$;$) { - my ( $obj, $str, $chk ) = @_; - my @line = (); - for my $line ( split /\r\n|[\r\n]/o, $str ) { - my ( @word, @subline ); - for my $word ( split /($re_especials)/o, $line ) { - if ( $word =~ /[^\x00-\x7f]/o - or $word =~ /^$re_encoded_word$/o ) - { - push @word, $obj->_encode($word); - } - else { - push @word, $word; - } - } - my $subline = ''; - for my $word (@word) { - use bytes (); - if ( bytes::length($subline) + bytes::length($word) > - $obj->{bpl} ) - { - push @subline, $subline; - $subline = ''; - } - $subline .= $word; - } - $subline and push @subline, $subline; - push @line, join( "\n " => @subline ); - } - $_[1] = '' if $chk; - return join( "\n", @line ); -} - -use constant HEAD => '=?UTF-8?'; -use constant TAIL => '?='; -use constant SINGLE => { B => \&_encode_b, Q => \&_encode_q, }; - -sub _encode { - my ( $o, $str ) = @_; - my $enc = $o->{encode}; - my $llen = ( $o->{bpl} - length(HEAD) - 2 - length(TAIL) ); - - # to coerce a floating-point arithmetics, the following contains - # .0 in numbers -- dankogai - $llen *= $enc eq 'B' ? 3.0 / 4.0 : 1.0 / 3.0; - my @result = (); - my $chunk = ''; - while ( length( my $chr = substr( $str, 0, 1, '' ) ) ) { - use bytes (); - if ( bytes::length($chunk) + bytes::length($chr) > $llen ) { - push @result, SINGLE->{$enc}($chunk); - $chunk = ''; - } - $chunk .= $chr; - } - length($chunk) and push @result, SINGLE->{$enc}($chunk); - return @result; -} - -sub _encode_b { - HEAD . 'B?' . encode_base64( encode_utf8(shift), '' ) . TAIL; -} - -sub _encode_q { - my $chunk = shift; - $chunk = encode_utf8($chunk); - $chunk =~ s{ - ([^0-9A-Za-z]) - }{ - join("" => map {sprintf "=%02X", $_} unpack("C*", $1)) - }egox; - return HEAD . 'Q?' . $chunk . TAIL; -} - -1; -__END__ - -=head1 NAME - -Encode::MIME::Header -- MIME 'B' and 'Q' header encoding - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $utf8 = decode('MIME-Header', $header); - $header = encode('MIME-Header', $utf8); - -=head1 ABSTRACT - -This module implements RFC 2047 Mime Header Encoding. There are 3 -variant encoding names; C<MIME-Header>, C<MIME-B> and C<MIME-Q>. The -difference is described below - - decode() encode() - ---------------------------------------------- - MIME-Header Both B and Q =?UTF-8?B?....?= - MIME-B B only; Q croaks =?UTF-8?B?....?= - MIME-Q Q only; B croaks =?UTF-8?Q?....?= - -=head1 DESCRIPTION - -When you decode(=?I<encoding>?I<X>?I<ENCODED WORD>?=), I<ENCODED WORD> -is extracted and decoded for I<X> encoding (B for Base64, Q for -Quoted-Printable). Then the decoded chunk is fed to -decode(I<encoding>). So long as I<encoding> is supported by Encode, -any source encoding is fine. - -When you encode, it just encodes UTF-8 string with I<X> encoding then -quoted with =?UTF-8?I<X>?....?= . The parts that RFC 2047 forbids to -encode are left as is and long lines are folded within 76 bytes per -line. - -=head1 BUGS - -It would be nice to support encoding to non-UTF8, such as =?ISO-2022-JP? -and =?ISO-8859-1?= but that makes the implementation too complicated. -These days major mail agents all support =?UTF-8? so I think it is -just good enough. - -Due to popular demand, 'MIME-Header-ISO_2022_JP' was introduced by -Makamaka. Thre are still too many MUAs especially cellular phone -handsets which does not grok UTF-8. - -=head1 SEE ALSO - -L<Encode> - -RFC 2047, L<http://www.faqs.org/rfcs/rfc2047.html> and many other -locations. - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Header/ISO_2022_JP.pm b/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Header/ISO_2022_JP.pm deleted file mode 100755 index 4abfbd05ef8..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Header/ISO_2022_JP.pm +++ /dev/null @@ -1,131 +0,0 @@ -package Encode::MIME::Header::ISO_2022_JP; - -use strict; -use warnings; - -use base qw(Encode::MIME::Header); - -$Encode::Encoding{'MIME-Header-ISO_2022_JP'} = - bless { encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP' } => - __PACKAGE__; - -use constant HEAD => '=?ISO-2022-JP?B?'; -use constant TAIL => '?='; - -use Encode::CJKConstants qw(%RE); - -our $VERSION = do { my @r = ( q$Revision: 1.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -# I owe the below codes totally to -# Jcode by Dan Kogai & http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64 - -sub encode { - my $self = shift; - my $str = shift; - - utf8::encode($str) if ( Encode::is_utf8($str) ); - Encode::from_to( $str, 'utf8', 'euc-jp' ); - - my ($trailing_crlf) = ( $str =~ /(\n|\r|\x0d\x0a)$/o ); - - $str = _mime_unstructured_header( $str, $self->{bpl} ); - - not $trailing_crlf and $str =~ s/(\n|\r|\x0d\x0a)$//o; - - return $str; -} - -sub _mime_unstructured_header { - my ( $oldheader, $bpl ) = @_; - my $crlf = $oldheader =~ /\n$/; - my ( $header, @words, @wordstmp, $i ) = (''); - - $oldheader =~ s/\s+$//; - - @wordstmp = split /\s+/, $oldheader; - - for ( $i = 0 ; $i < $#wordstmp ; $i++ ) { - if ( $wordstmp[$i] !~ /^[\x21-\x7E]+$/ - and $wordstmp[ $i + 1 ] !~ /^[\x21-\x7E]+$/ ) - { - $wordstmp[ $i + 1 ] = "$wordstmp[$i] $wordstmp[$i + 1]"; - } - else { - push( @words, $wordstmp[$i] ); - } - } - - push( @words, $wordstmp[-1] ); - - for my $word (@words) { - if ( $word =~ /^[\x21-\x7E]+$/ ) { - $header =~ /(?:.*\n)*(.*)/; - if ( length($1) + length($word) > $bpl ) { - $header .= "\n $word"; - } - else { - $header .= $word; - } - } - else { - $header = _add_encoded_word( $word, $header, $bpl ); - } - - $header =~ /(?:.*\n)*(.*)/; - - if ( length($1) == $bpl ) { - $header .= "\n "; - } - else { - $header .= ' '; - } - } - - $header =~ s/\n? $//mg; - - $crlf ? "$header\n" : $header; -} - -sub _add_encoded_word { - my ( $str, $line, $bpl ) = @_; - my $result = ''; - - while ( length($str) ) { - my $target = $str; - $str = ''; - - if ( - length($line) + 22 + - ( $target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o ) * 8 > $bpl ) - { - $line =~ s/[ \t\n\r]*$/\n/; - $result .= $line; - $line = ' '; - } - - while (1) { - my $iso_2022_jp = $target; - Encode::from_to( $iso_2022_jp, 'euc-jp', 'iso-2022-jp' ); - - my $encoded = - HEAD . MIME::Base64::encode_base64( $iso_2022_jp, '' ) . TAIL; - - if ( length($encoded) + length($line) > $bpl ) { - $target =~ - s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o; - $str = $1 . $str; - } - else { - $line .= $encoded; - last; - } - } - - } - - $result . $line; -} - -1; -__END__ - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Name.pm b/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Name.pm deleted file mode 100755 index 10d86a746dc..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/MIME/Name.pm +++ /dev/null @@ -1,94 +0,0 @@ -package Encode::MIME::Name; -use strict; -use warnings; -our $VERSION = do { my @r = ( q$Revision: 1.1 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -our %MIME_NAME_OF = ( - 'AdobeStandardEncoding' => 'Adobe-Standard-Encoding', - 'AdobeSymbol' => 'Adobe-Symbol-Encoding', - 'ascii' => 'US-ASCII', - 'big5-hkscs' => 'Big5-HKSCS', - 'cp1026' => 'IBM1026', - 'cp1047' => 'IBM1047', - 'cp1250' => 'windows-1250', - 'cp1251' => 'windows-1251', - 'cp1252' => 'windows-1252', - 'cp1253' => 'windows-1253', - 'cp1254' => 'windows-1254', - 'cp1255' => 'windows-1255', - 'cp1256' => 'windows-1256', - 'cp1257' => 'windows-1257', - 'cp1258' => 'windows-1258', - 'cp37' => 'IBM037', - 'cp424' => 'IBM424', - 'cp437' => 'IBM437', - 'cp500' => 'IBM500', - 'cp775' => 'IBM775', - 'cp850' => 'IBM850', - 'cp852' => 'IBM852', - 'cp855' => 'IBM855', - 'cp857' => 'IBM857', - 'cp860' => 'IBM860', - 'cp861' => 'IBM861', - 'cp862' => 'IBM862', - 'cp863' => 'IBM863', - 'cp864' => 'IBM864', - 'cp865' => 'IBM865', - 'cp866' => 'IBM866', - 'cp869' => 'IBM869', - 'cp936' => 'GBK', - 'euc-jp' => 'EUC-JP', - 'euc-kr' => 'EUC-KR', - #'gb2312-raw' => 'GB2312', # no, you're wrong, I18N::Charset - 'hp-roman8' => 'hp-roman8', - 'hz' => 'HZ-GB-2312', - 'iso-2022-jp' => 'ISO-2022-JP', - 'iso-2022-jp-1' => 'ISO-2022-JP', - 'iso-2022-kr' => 'ISO-2022-KR', - 'iso-8859-1' => 'ISO-8859-1', - 'iso-8859-10' => 'ISO-8859-10', - 'iso-8859-13' => 'ISO-8859-13', - 'iso-8859-14' => 'ISO-8859-14', - 'iso-8859-15' => 'ISO-8859-15', - 'iso-8859-16' => 'ISO-8859-16', - 'iso-8859-2' => 'ISO-8859-2', - 'iso-8859-3' => 'ISO-8859-3', - 'iso-8859-4' => 'ISO-8859-4', - 'iso-8859-5' => 'ISO-8859-5', - 'iso-8859-6' => 'ISO-8859-6', - 'iso-8859-7' => 'ISO-8859-7', - 'iso-8859-8' => 'ISO-8859-8', - 'iso-8859-9' => 'ISO-8859-9', - #'jis0201-raw' => 'JIS_X0201', - #'jis0208-raw' => 'JIS_C6226-1983', - #'jis0212-raw' => 'JIS_X0212-1990', - 'koi8-r' => 'KOI8-R', - 'koi8-u' => 'KOI8-U', - #'ksc5601-raw' => 'KS_C_5601-1987', - 'shiftjis' => 'Shift_JIS', - 'UTF-16' => 'UTF-16', - 'UTF-16BE' => 'UTF-16BE', - 'UTF-16LE' => 'UTF-16LE', - 'UTF-32' => 'UTF-32', - 'UTF-32BE' => 'UTF-32BE', - 'UTF-32LE' => 'UTF-32LE', - 'UTF-7' => 'UTF-7', - 'utf8' => 'UTF-8', - 'utf-8-strict' => 'UTF-8', - 'viscii' => 'VISCII', -); - -sub get_mime_name($) { $MIME_NAME_OF{$_[0]} }; - -1; -__END__ - -=head1 NAME - -Encode::MIME::NAME -- internally used by Encode - -=head1 SEE ALSO - -L<I18N::Charset> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Makefile_PL.e2x b/Master/tlpkg/tlperl.straw/lib/Encode/Makefile_PL.e2x deleted file mode 100755 index 1d83a2fbda2..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Makefile_PL.e2x +++ /dev/null @@ -1,180 +0,0 @@ -# -# This file is auto-generated by: -# enc2xs version $_Version_ -# $_Now_ -# -use 5.7.2; -use strict; -use ExtUtils::MakeMaker; -use Config; - -# Please edit the following to the taste! -my $name = '$_Name_'; -my %tables = ( - $_Name__t => [ $_TableFiles_ ], - ); - -#### DO NOT EDIT BEYOND THIS POINT! -require File::Spec; -my ($enc2xs, $encode_h) = (); -PATHLOOP: -for my $d (@Config{qw/bin sitebin vendorbin/}, - (split /$Config{path_sep}/o, $ENV{PATH})){ - for my $f (qw/enc2xs enc2xs5.7.3/){ - my $path = File::Spec->catfile($d, $f); - -r $path and $enc2xs = $path and last PATHLOOP; - } -} -$enc2xs or die "enc2xs not found!"; -print "enc2xs is $enc2xs\n"; -my %encode_h = (); -for my $d (@INC){ - my $dir = File::Spec->catfile($d, "Encode"); - my $file = File::Spec->catfile($dir, "encode.h"); - -f $file and $encode_h{$dir} = -M $file; -} -%encode_h or die "encode.h not found!"; -# find the latest one -($encode_h) = sort {$encode_h{$b} <=> $encode_h{$a}} keys %encode_h; -print "encode.h is at $encode_h\n"; - -WriteMakefile( - INC => "-I$encode_h", -#### END_OF_HEADER -- DO NOT EDIT THIS LINE BY HAND! #### - NAME => 'Encode::'.$name, - VERSION_FROM => "$name.pm", - OBJECT => '$(O_FILES)', - 'dist' => { - COMPRESS => 'gzip -9f', - SUFFIX => 'gz', - DIST_DEFAULT => 'all tardist', - }, - MAN3PODS => {}, - PREREQ_PM => { - 'Encode' => "1.41", - }, - # OS 390 winges about line numbers > 64K ??? - XSOPT => '-nolinenumbers', - ); - -package MY; - -sub post_initialize -{ - my ($self) = @_; - my %o; - my $x = $self->{'OBJ_EXT'}; - # Add the table O_FILES - foreach my $e (keys %tables) - { - $o{$e.$x} = 1; - } - $o{"$name$x"} = 1; - $self->{'O_FILES'} = [sort keys %o]; - my @files = ("$name.xs"); - $self->{'C'} = ["$name.c"]; - # The next two lines to make MacPerl Happy -- dankogai via pudge - $self->{SOURCE} .= " $name.c" - if $^O eq 'MacOS' && $self->{SOURCE} !~ /\b$name\.c\b/; - # $self->{'H'} = [$self->catfile($self->updir,'encode.h')]; - my %xs; - foreach my $table (keys %tables) { - push (@{$self->{'C'}},"$table.c"); - # Do NOT add $table.h etc. to H_FILES unless we own up as to how they - # get built. - foreach my $ext (qw($(OBJ_EXT) .c .h .exh .fnm)) { - push (@files,$table.$ext); - } - } - $self->{'XS'} = { "$name.xs" => "$name.c" }; - $self->{'clean'}{'FILES'} .= join(' ',@files); - open(XS,">$name.xs") || die "Cannot open $name.xs:$!"; - print XS <<'END'; -#include <EXTERN.h> -#include <perl.h> -#include <XSUB.h> -#define U8 U8 -#include "encode.h" -END - foreach my $table (keys %tables) { - print XS qq[#include "${table}.h"\n]; - } - print XS <<"END"; - -static void -Encode_XSEncoding(pTHX_ encode_t *enc) -{ - dSP; - HV *stash = gv_stashpv("Encode::XS", TRUE); - SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash); - int i = 0; - PUSHMARK(sp); - XPUSHs(sv); - while (enc->name[i]) - { - const char *name = enc->name[i++]; - XPUSHs(sv_2mortal(newSVpvn(name,strlen(name)))); - } - PUTBACK; - call_pv("Encode::define_encoding",G_DISCARD); - SvREFCNT_dec(sv); -} - -MODULE = Encode::$name PACKAGE = Encode::$name -PROTOTYPES: DISABLE -BOOT: -{ -END - foreach my $table (keys %tables) { - print XS qq[#include "${table}.exh"\n]; - } - print XS "}\n"; - close(XS); - return "# Built $name.xs\n\n"; -} - -sub postamble -{ - my $self = shift; - my $dir = "."; # $self->catdir('Encode'); - my $str = "# $name\$(OBJ_EXT) depends on .h and .exh files not .c files - but all written by enc2xs\n"; - $str .= "$name.c : $name.xs "; - foreach my $table (keys %tables) - { - $str .= " $table.c"; - } - $str .= "\n\n"; - $str .= "$name\$(OBJ_EXT) : $name.c\n\n"; - - foreach my $table (keys %tables) - { - my $numlines = 1; - my $lengthsofar = length($str); - my $continuator = ''; - $str .= "$table.c : Makefile.PL"; - foreach my $file (@{$tables{$table}}) - { - $str .= $continuator.' '.$self->catfile($dir,$file); - if ( length($str)-$lengthsofar > 128*$numlines ) - { - $continuator .= " \\\n\t"; - $numlines++; - } else { - $continuator = ''; - } - } - my $plib = $self->{PERL_CORE} ? '"-I$(PERL_LIB)"' : ''; - my $ucopts = '-"Q"'; - $str .= - qq{\n\t\$(PERL) $plib $enc2xs $ucopts -o \$\@ -f $table.fnm\n\n}; - open (FILELIST, ">$table.fnm") - || die "Could not open $table.fnm: $!"; - foreach my $file (@{$tables{$table}}) - { - print FILELIST $self->catfile($dir,$file) . "\n"; - } - close(FILELIST); - } - return $str; -} - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/PerlIO.pod b/Master/tlpkg/tlperl.straw/lib/Encode/PerlIO.pod deleted file mode 100755 index 1a9269a9b0c..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/PerlIO.pod +++ /dev/null @@ -1,167 +0,0 @@ -=head1 NAME - -Encode::PerlIO -- a detailed document on Encode and PerlIO - -=head1 Overview - -It is very common to want to do encoding transformations when -reading or writing files, network connections, pipes etc. -If Perl is configured to use the new 'perlio' IO system then -C<Encode> provides a "layer" (see L<PerlIO>) which can transform -data as it is read or written. - -Here is how the blind poet would modernise the encoding: - - use Encode; - open(my $iliad,'<:encoding(iso-8859-7)','iliad.greek'); - open(my $utf8,'>:utf8','iliad.utf8'); - my @epic = <$iliad>; - print $utf8 @epic; - close($utf8); - close($illiad); - -In addition, the new IO system can also be configured to read/write -UTF-8 encoded characters (as noted above, this is efficient): - - open(my $fh,'>:utf8','anything'); - print $fh "Any \x{0021} string \N{SMILEY FACE}\n"; - -Either of the above forms of "layer" specifications can be made the default -for a lexical scope with the C<use open ...> pragma. See L<open>. - -Once a handle is open, its layers can be altered using C<binmode>. - -Without any such configuration, or if Perl itself is built using the -system's own IO, then write operations assume that the file handle -accepts only I<bytes> and will C<die> if a character larger than 255 is -written to the handle. When reading, each octet from the handle becomes -a byte-in-a-character. Note that this default is the same behaviour -as bytes-only languages (including Perl before v5.6) would have, -and is sufficient to handle native 8-bit encodings e.g. iso-8859-1, -EBCDIC etc. and any legacy mechanisms for handling other encodings -and binary data. - -In other cases, it is the program's responsibility to transform -characters into bytes using the API above before doing writes, and to -transform the bytes read from a handle into characters before doing -"character operations" (e.g. C<lc>, C</\W+/>, ...). - -You can also use PerlIO to convert larger amounts of data you don't -want to bring into memory. For example, to convert between ISO-8859-1 -(Latin 1) and UTF-8 (or UTF-EBCDIC in EBCDIC machines): - - open(F, "<:encoding(iso-8859-1)", "data.txt") or die $!; - open(G, ">:utf8", "data.utf") or die $!; - while (<F>) { print G } - - # Could also do "print G <F>" but that would pull - # the whole file into memory just to write it out again. - -More examples: - - open(my $f, "<:encoding(cp1252)") - open(my $g, ">:encoding(iso-8859-2)") - open(my $h, ">:encoding(latin9)") # iso-8859-15 - -See also L<encoding> for how to change the default encoding of the -data in your script. - -=head1 How does it work? - -Here is a crude diagram of how filehandle, PerlIO, and Encode -interact. - - filehandle <-> PerlIO PerlIO <-> scalar (read/printed) - \ / - Encode - -When PerlIO receives data from either direction, it fills a buffer -(currently with 1024 bytes) and passes the buffer to Encode. -Encode tries to convert the valid part and passes it back to PerlIO, -leaving invalid parts (usually a partial character) in the buffer. -PerlIO then appends more data to the buffer, calls Encode again, -and so on until the data stream ends. - -To do so, PerlIO always calls (de|en)code methods with CHECK set to 1. -This ensures that the method stops at the right place when it -encounters partial character. The following is what happens when -PerlIO and Encode tries to encode (from utf8) more than 1024 bytes -and the buffer boundary happens to be in the middle of a character. - - A B C .... ~ \x{3000} .... - 41 42 43 .... 7E e3 80 80 .... - <- buffer ---------------> - << encoded >>>>>>>>>> - <- next buffer ------ - -Encode converts from the beginning to \x7E, leaving \xe3 in the buffer -because it is invalid (partial character). - -Unfortunately, this scheme does not work well with escape-based -encodings such as ISO-2022-JP. - -=head1 Line Buffering - -Now let's see what happens when you try to decode from ISO-2022-JP and -the buffer ends in the middle of a character. - - JIS208-ESC \x{5f3e} - A B C .... ~ \e $ B |DAN | .... - 41 42 43 .... 7E 1b 24 41 43 46 .... - <- buffer ---------------------------> - << encoded >>>>>>>>>>>>>>>>>>>>>>> - -As you see, the next buffer begins with \x43. But \x43 is 'C' in -ASCII, which is wrong in this case because we are now in JISX 0208 -area so it has to convert \x43\x46, not \x43. Unlike utf8 and EUC, -in escape-based encodings you can't tell if a given octet is a whole -character or just part of it. - -Fortunately PerlIO also supports line buffer if you tell PerlIO to use -one instead of fixed buffer. Since ISO-2022-JP is guaranteed to revert to ASCII at the end of the line, partial -character will never happen when line buffer is used. - -To tell PerlIO to use line buffer, implement -E<gt>needs_lines method -for your encoding object. See L<Encode::Encoding> for details. - -Thanks to these efforts most encodings that come with Encode support -PerlIO but that still leaves following encodings. - - iso-2022-kr - MIME-B - MIME-Header - MIME-Q - -Fortunately iso-2022-kr is hardly used (according to Jungshik) and -MIME-* are very unlikely to be fed to PerlIO because they are for mail -headers. See L<Encode::MIME::Header> for details. - -=head2 How can I tell whether my encoding fully supports PerlIO ? - -As of this writing, any encoding whose class belongs to Encode::XS and -Encode::Unicode works. The Encode module has a C<perlio_ok> method -which you can use before applying PerlIO encoding to the filehandle. -Here is an example: - - my $use_perlio = perlio_ok($enc); - my $layer = $use_perlio ? "<:raw" : "<:encoding($enc)"; - open my $fh, $layer, $file or die "$file : $!"; - while(<$fh>){ - $_ = decode($enc, $_) unless $use_perlio; - # .... - } - -=head1 SEE ALSO - -L<Encode::Encoding>, -L<Encode::Supported>, -L<Encode::PerlIO>, -L<encoding>, -L<perlebcdic>, -L<perlfunc/open>, -L<perlunicode>, -L<utf8>, -the Perl Unicode Mailing List E<lt>perl-unicode@perl.orgE<gt> - -=cut - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/README.e2x b/Master/tlpkg/tlperl.straw/lib/Encode/README.e2x deleted file mode 100755 index 28a31a655c2..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/README.e2x +++ /dev/null @@ -1,31 +0,0 @@ -Encode::$_Name_ version 0.1 -======== - -NAME - Encode::$_Name_ - <describe encoding> - -SYNOPSIS - use Encode::$_Name_; - #<put more words here> -ABSTRACT - <fill this in> -INSTALLATION - -To install this module type the following: - - perl Makefile.PL - make - make test - make install - -DEPENDENCIES - -This module requires perl version 5.7.3 or later. - -COPYRIGHT AND LICENCE - -Copyright (C) 2002 Your Name <your@address.domain> - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Supported.pod b/Master/tlpkg/tlperl.straw/lib/Encode/Supported.pod deleted file mode 100755 index e84faafd9e2..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Supported.pod +++ /dev/null @@ -1,901 +0,0 @@ -=head1 NAME - -Encode::Supported -- Encodings supported by Encode - -=head1 DESCRIPTION - -=head2 Encoding Names - -Encoding names are case insensitive. White space in names -is ignored. In addition, an encoding may have aliases. -Each encoding has one "canonical" name. The "canonical" -name is chosen from the names of the encoding by picking -the first in the following sequence (with a few exceptions). - -=over 2 - -=item * - -The name used by the Perl community. That includes 'utf8' and 'ascii'. -Unlike aliases, canonical names directly reach the method so such -frequently used words like 'utf8' don't need to do alias lookups. - -=item * - -The MIME name as defined in IETF RFCs. This includes all "iso-"s. - -=item * - -The name in the IANA registry. - -=item * - -The name used by the organization that defined it. - -=back - -In case I<de jure> canonical names differ from that of the Encode -module, they are always aliased if it ever be implemented. So you can -safely tell if a given encoding is implemented or not just by passing -the canonical name. - -Because of all the alias issues, and because in the general case -encodings have state, "Encode" uses an encoding object internally -once an operation is in progress. - -=head1 Supported Encodings - -As of Perl 5.8.0, at least the following encodings are recognized. -Note that unless otherwise specified, they are all case insensitive -(via alias) and all occurrence of spaces are replaced with '-'. -In other words, "ISO 8859 1" and "iso-8859-1" are identical. - -Encodings are categorized and implemented in several different modules -but you don't have to C<use Encode::XX> to make them available for -most cases. Encode.pm will automatically load those modules on demand. - -=head2 Built-in Encodings - -The following encodings are always available. - - Canonical Aliases Comments & References - ---------------------------------------------------------------- - ascii US-ascii ISO-646-US [ECMA] - ascii-ctrl Special Encoding - iso-8859-1 latin1 [ISO] - null Special Encoding - utf8 UTF-8 [RFC2279] - ---------------------------------------------------------------- - -I<null> and I<ascii-ctrl> are special. "null" fails for all character -so when you set fallback mode to PERLQQ, HTMLCREF or XMLCREF, ALL -CHARACTERS will fall back to character references. Ditto for -"ascii-ctrl" except for control characters. For fallback modes, see -L<Encode>. - -=head2 Encode::Unicode -- other Unicode encodings - -Unicode coding schemes other than native utf8 are supported by -Encode::Unicode, which will be autoloaded on demand. - - ---------------------------------------------------------------- - UCS-2BE UCS-2, iso-10646-1 [IANA, UC] - UCS-2LE [UC] - UTF-16 [UC] - UTF-16BE [UC] - UTF-16LE [UC] - UTF-32 [UC] - UTF-32BE UCS-4 [UC] - UTF-32LE [UC] - UTF-7 [RFC2152] - ---------------------------------------------------------------- - -To find how (UCS-2|UTF-(16|32))(LE|BE)? differ from one another, -see L<Encode::Unicode>. - -UTF-7 is a special encoding which "re-encodes" UTF-16BE into a 7-bit -encoding. It is implemented seperately by Encode::Unicode::UTF7. - -=head2 Encode::Byte -- Extended ASCII - -Encode::Byte implements most single-byte encodings except for -Symbols and EBCDIC. The following encodings are based on single-byte -encodings implemented as extended ASCII. Most of them map -\x80-\xff (upper half) to non-ASCII characters. - -=over 2 - -=item ISO-8859 and corresponding vendor mappings - -Since there are so many, they are presented in table format with -languages and corresponding encoding names by vendors. Note that -the table is sorted in order of ISO-8859 and the corresponding vendor -mappings are slightly different from that of ISO. See -L<http://czyborra.com/charsets/iso8859.html> for details. - - Lang/Regions ISO/Other Std. DOS Windows Macintosh Others - ---------------------------------------------------------------- - N. America (ASCII) cp437 AdobeStandardEncoding - cp863 (DOSCanadaF) - W. Europe iso-8859-1 cp850 cp1252 MacRoman nextstep - hp-roman8 - cp860 (DOSPortuguese) - Cntrl. Europe iso-8859-2 cp852 cp1250 MacCentralEurRoman - MacCroatian - MacRomanian - MacRumanian - Latin3[1] iso-8859-3 - Latin4[2] iso-8859-4 - Cyrillics iso-8859-5 cp855 cp1251 MacCyrillic - (See also next section) cp866 MacUkrainian - Arabic iso-8859-6 cp864 cp1256 MacArabic - cp1006 MacFarsi - Greek iso-8859-7 cp737 cp1253 MacGreek - cp869 (DOSGreek2) - Hebrew iso-8859-8 cp862 cp1255 MacHebrew - Turkish iso-8859-9 cp857 cp1254 MacTurkish - Nordics iso-8859-10 cp865 - cp861 MacIcelandic - MacSami - Thai iso-8859-11[3] cp874 MacThai - (iso-8859-12 is nonexistent. Reserved for Indics?) - Baltics iso-8859-13 cp775 cp1257 - Celtics iso-8859-14 - Latin9 [4] iso-8859-15 - Latin10 iso-8859-16 - Vietnamese viscii cp1258 MacVietnamese - ---------------------------------------------------------------- - - [1] Esperanto, Maltese, and Turkish. Turkish is now on 8859-9. - [2] Baltics. Now on 8859-10, except for Latvian. - [3] TIS 620 + Non-Breaking Space (0xA0 / U+00A0) - [4] Nicknamed Latin0; the Euro sign as well as French and Finnish - letters that are missing from 8859-1 were added. - -All cp* are also available as ibm-*, ms-*, and windows-* . See also -L<http://czyborra.com/charsets/codepages.html>. - -Macintosh encodings don't seem to be registered in such entities as -IANA. "Canonical" names in Encode are based upon Apple's Tech Note -1150. See L<http://developer.apple.com/technotes/tn/tn1150.html> -for details. - -=item KOI8 - De Facto Standard for the Cyrillic world - -Though ISO-8859 does have ISO-8859-5, the KOI8 series is far more -popular in the Net. L<Encode> comes with the following KOI charsets. -For gory details, see L<http://czyborra.com/charsets/cyrillic.html> - - ---------------------------------------------------------------- - koi8-f - koi8-r cp878 [RFC1489] - koi8-u [RFC2319] - ---------------------------------------------------------------- - -=back - -=head2 gsm0338 - Hentai Latin 1 - -GSM0338 is for GSM handsets. Though it shares alphanumerals with -ASCII, control character ranges and other parts are mapped very -differently, mainly to store Greek characters. There are also escape -sequences (starting with 0x1B) to cover e.g. the Euro sign. - -This was once handled by L<Encode::Bytes> but because of all those -unusual specifications, Encode 2.20 has relocated the support to -L<Encode::GSM0338>. See L<Encode::GSM0338> for details. - -=over 2 - -=item gsm0338 support before 2.19 - -Some special cases like a trailing 0x00 byte or a lone 0x1B byte are not -well-defined and decode() will return an empty string for them. -One possible workaround is - - $gsm =~ s/\x00\z/\x00\x00/; - $uni = decode("gsm0338", $gsm); - $uni .= "\xA0" if $gsm =~ /\x1B\z/; - -Note that the Encode implementation of GSM0338 does not implement the -reuse of Latin capital letters as Greek capital letters (for example, -the 0x5A is U+005A (LATIN CAPITAL LETTER Z), not U+0396 (GREEK CAPITAL -LETTER ZETA). - -The GSM0338 is also covered in Encode::Byte even though it is not -an "extended ASCII" encoding. - -=back - -=head2 CJK: Chinese, Japanese, Korean (Multibyte) - -Note that Vietnamese is listed above. Also read "Encoding vs Charset" -below. Also note that these are implemented in distinct modules by -countries, due to the size concerns (simplified Chinese is mapped -to 'CN', continental China, while traditional Chinese is mapped to -'TW', Taiwan). Please refer to their respective documentation pages. - -=over 2 - -=item Encode::CN -- Continental China - - Standard DOS/Win Macintosh Comment/Reference - ---------------------------------------------------------------- - euc-cn [1] MacChineseSimp - (gbk) cp936 [2] - gb12345-raw { GB12345 without CES } - gb2312-raw { GB2312 without CES } - hz - iso-ir-165 - ---------------------------------------------------------------- - - [1] GB2312 is aliased to this. See L<Microsoft-related naming mess> - [2] gbk is aliased to this. See L<Microsoft-related naming mess> - -=item Encode::JP -- Japan - - Standard DOS/Win Macintosh Comment/Reference - ---------------------------------------------------------------- - euc-jp - shiftjis cp932 macJapanese - 7bit-jis - iso-2022-jp [RFC1468] - iso-2022-jp-1 [RFC2237] - jis0201-raw { JIS X 0201 (roman + halfwidth kana) without CES } - jis0208-raw { JIS X 0208 (Kanji + fullwidth kana) without CES } - jis0212-raw { JIS X 0212 (Extended Kanji) without CES } - ---------------------------------------------------------------- - -=item Encode::KR -- Korea - - Standard DOS/Win Macintosh Comment/Reference - ---------------------------------------------------------------- - euc-kr MacKorean [RFC1557] - cp949 [1] - iso-2022-kr [RFC1557] - johab [KS X 1001:1998, Annex 3] - ksc5601-raw { KSC5601 without CES } - ---------------------------------------------------------------- - - [1] ks_c_5601-1987, (x-)?windows-949, and uhc are aliased to this. - See below. - -=item Encode::TW -- Taiwan - - Standard DOS/Win Macintosh Comment/Reference - ---------------------------------------------------------------- - big5-eten cp950 MacChineseTrad {big5 aliased to big5-eten} - big5-hkscs - ---------------------------------------------------------------- - -=item Encode::HanExtra -- More Chinese via CPAN - -Due to the size concerns, additional Chinese encodings below are -distributed separately on CPAN, under the name Encode::HanExtra. - - Standard DOS/Win Macintosh Comment/Reference - ---------------------------------------------------------------- - big5ext CMEX's Big5e Extension - big5plus CMEX's Big5+ Extension - cccii Chinese Character Code for Information Interchange - euc-tw EUC (Extended Unix Character) - gb18030 GBK with Traditional Characters - ---------------------------------------------------------------- - -=item Encode::JIS2K -- JIS X 0213 encodings via CPAN - -Due to size concerns, additional Japanese encodings below are -distributed separately on CPAN, under the name Encode::JIS2K. - - Standard DOS/Win Macintosh Comment/Reference - ---------------------------------------------------------------- - euc-jisx0213 - shiftjisx0123 - iso-2022-jp-3 - jis0213-1-raw - jis0213-2-raw - ---------------------------------------------------------------- - -=back - -=head2 Miscellaneous encodings - -=over 2 - -=item Encode::EBCDIC - -See L<perlebcdic> for details. - - ---------------------------------------------------------------- - cp37 - cp500 - cp875 - cp1026 - cp1047 - posix-bc - ---------------------------------------------------------------- - -=item Encode::Symbols - -For symbols and dingbats. - - ---------------------------------------------------------------- - symbol - dingbats - MacDingbats - AdobeZdingbat - AdobeSymbol - ---------------------------------------------------------------- - -=item Encode::MIME::Header - -Strictly speaking, MIME header encoding documented in RFC 2047 is more -of encapsulation than encoding. However, their support in modern -world is imperative so they are supported. - - ---------------------------------------------------------------- - MIME-Header [RFC2047] - MIME-B [RFC2047] - MIME-Q [RFC2047] - ---------------------------------------------------------------- - -=item Encode::Guess - -This one is not a name of encoding but a utility that lets you pick up -the most appropriate encoding for a data out of given I<suspects>. See -L<Encode::Guess> for details. - -=back - -=head1 Unsupported encodings - -The following encodings are not supported as yet; some because they -are rarely used, some because of technical difficulties. They may -be supported by external modules via CPAN in the future, however. - -=over 2 - -=item ISO-2022-JP-2 [RFC1554] - -Not very popular yet. Needs Unicode Database or equivalent to -implement encode() (because it includes JIS X 0208/0212, KSC5601, and -GB2312 simultaneously, whose code points in Unicode overlap. So you -need to lookup the database to determine to what character set a given -Unicode character should belong). - -=item ISO-2022-CN [RFC1922] - -Not very popular. Needs CNS 11643-1 and -2 which are not available in -this module. CNS 11643 is supported (via euc-tw) in Encode::HanExtra. -Autrijus Tang may add support for this encoding in his module in future. - -=item Various HP-UX encodings - -The following are unsupported due to the lack of mapping data. - - '8' - arabic8, greek8, hebrew8, kana8, thai8, and turkish8 - '15' - japanese15, korean15, and roi15 - -=item Cyrillic encoding ISO-IR-111 - -Anton Tagunov doubts its usefulness. - -=item ISO-8859-8-1 [Hebrew] - -None of the Encode team knows Hebrew enough (ISO-8859-8, cp1255 and -MacHebrew are supported because and just because there were mappings -available at L<http://www.unicode.org/>). Contributions welcome. - -=item ISIRI 3342, Iran System, ISIRI 2900 [Farsi] - -Ditto. - -=item Thai encoding TCVN - -Ditto. - -=item Vietnamese encodings VPS - -Though Jungshik Shin has reported that Mozilla supports this encoding, -it was too late before 5.8.0 for us to add it. In the future, it -may be available via a separate module. See -L<http://lxr.mozilla.org/seamonkey/source/intl/uconv/ucvlatin/vps.uf> -and -L<http://lxr.mozilla.org/seamonkey/source/intl/uconv/ucvlatin/vps.ut> -if you are interested in helping us. - -=item Various Mac encodings - -The following are unsupported due to the lack of mapping data. - - MacArmenian, MacBengali, MacBurmese, MacEthiopic - MacExtArabic, MacGeorgian, MacKannada, MacKhmer - MacLaotian, MacMalayalam, MacMongolian, MacOriya - MacSinhalese, MacTamil, MacTelugu, MacTibetan - MacVietnamese - -The rest which are already available are based upon the vendor mappings -at L<http://www.unicode.org/Public/MAPPINGS/VENDORS/APPLE/> . - -=item (Mac) Indic encodings - -The maps for the following are available at L<http://www.unicode.org/> -but remain unsupport because those encodings need algorithmical -approach, currently unsupported by F<enc2xs>: - - MacDevanagari - MacGurmukhi - MacGujarati - -For details, please see C<Unicode mapping issues and notes:> at -L<http://www.unicode.org/Public/MAPPINGS/VENDORS/APPLE/DEVANAGA.TXT> . - -I believe this issue is prevalent not only for Mac Indics but also in -other Indic encodings, but the above were the only Indic encodings -maps that I could find at L<http://www.unicode.org/> . - -=back - -=head1 Encoding vs. Charset -- terminology - -We are used to using the term (character) I<encoding> and I<character -set> interchangeably. But just as confusing the terms byte and -character is dangerous and the terms should be differentiated when -needed, we need to differentiate I<encoding> and I<character set>. - -To understand that, here is a description of how we make computers -grok our characters. - -=over 2 - -=item * - -First we start with which characters to include. We call this -collection of characters I<character repertoire>. - -=item * - -Then we have to give each character a unique ID so your computer can -tell the difference between 'a' and 'A'. This itemized character -repertoire is now a I<character set>. - -=item * - -If your computer can grow the character set without further -processing, you can go ahead and use it. This is called a I<coded -character set> (CCS) or I<raw character encoding>. ASCII is used this -way for most cases. - -=item * - -But in many cases, especially multi-byte CJK encodings, you have to -tweak a little more. Your network connection may not accept any data -with the Most Significant Bit set, and your computer may not be able to -tell if a given byte is a whole character or just half of it. So you -have to I<encode> the character set to use it. - -A I<character encoding scheme> (CES) determines how to encode a given -character set, or a set of multiple character sets. 7bit ISO-2022 is -an example of a CES. You switch between character sets via I<escape -sequences>. - -=back - -Technically, or mathematically, speaking, a character set encoded in -such a CES that maps character by character may form a CCS. EUC is such -an example. The CES of EUC is as follows: - -=over 2 - -=item * - -Map ASCII unchanged. - -=item * - -Map such a character set that consists of 94 or 96 powered by N -members by adding 0x80 to each byte. - -=item * - -You can also use 0x8e and 0x8f to indicate that the following sequence of -characters belongs to yet another character set. To each following byte -is added the value 0x80. - -=back - -By carefully looking at the encoded byte sequence, you can find that the -byte sequence conforms a unique number. In that sense, EUC is a CCS -generated by a CES above from up to four CCS (complicated?). UTF-8 -falls into this category. See L<perlUnicode/"UTF-8"> to find out how -UTF-8 maps Unicode to a byte sequence. - -You may also have found out by now why 7bit ISO-2022 cannot comprise -a CCS. If you look at a byte sequence \x21\x21, you can't tell if -it is two !'s or IDEOGRAPHIC SPACE. EUC maps the latter to \xA1\xA1 -so you have no trouble differentiating between "!!". and S<" ">. - -=head1 Encoding Classification (by Anton Tagunov and Dan Kogai) - -This section tries to classify the supported encodings by their -applicability for information exchange over the Internet and to -choose the most suitable aliases to name them in the context of -such communication. - -=over 2 - -=item * - -To (en|de)code encodings marked by C<(**)>, you need -C<Encode::HanExtra>, available from CPAN. - -=back - -Encoding names - - US-ASCII UTF-8 ISO-8859-* KOI8-R - Shift_JIS EUC-JP ISO-2022-JP ISO-2022-JP-1 - EUC-KR Big5 GB2312 - -are registered with IANA as preferred MIME names and may -be used over the Internet. - -C<Shift_JIS> has been officialized by JIS X 0208:1997. -L<Microsoft-related naming mess> gives details. - -C<GB2312> is the IANA name for C<EUC-CN>. -See L<Microsoft-related naming mess> for details. - -C<GB_2312-80> I<raw> encoding is available as C<gb2312-raw> -with Encode. See L<Encode::CN> for details. - - EUC-CN - KOI8-U [RFC2319] - -have not been registered with IANA (as of March 2002) but -seem to be supported by major web browsers. -The IANA name for C<EUC-CN> is C<GB2312>. - - KS_C_5601-1987 - -is heavily misused. -See L<Microsoft-related naming mess> for details. - -C<KS_C_5601-1987> I<raw> encoding is available as C<kcs5601-raw> -with Encode. See L<Encode::KR> for details. - - UTF-16 UTF-16BE UTF-16LE - -are IANA-registered C<charset>s. See [RFC 2781] for details. -Jungshik Shin reports that UTF-16 with a BOM is well accepted -by MS IE 5/6 and NS 4/6. Beware however that - -=over 2 - -=item * - -C<UTF-16> support in any software you're going to be -using/interoperating with has probably been less tested -then C<UTF-8> support - -=item * - -C<UTF-8> coded data seamlessly passes traditional -command piping (C<cat>, C<more>, etc.) while C<UTF-16> coded -data is likely to cause confusion (with its zero bytes, -for example) - -=item * - -it is beyond the power of words to describe the way HTML browsers -encode non-C<ASCII> form data. To get a general impression, visit -L<http://www.alanflavell.org.uk/charset/form-i18n.html>. -While encoding of form data has stabilized for C<UTF-8> encoded pages -(at least IE 5/6, NS 6, and Opera 6 behave consistently), be sure to -expect fun (and cross-browser discrepancies) with C<UTF-16> encoded -pages! - -=back - -The rule of thumb is to use C<UTF-8> unless you know what -you're doing and unless you really benefit from using C<UTF-16>. - - ISO-IR-165 [RFC1345] - VISCII - GB 12345 - GB 18030 (**) (see links bellow) - EUC-TW (**) - -are totally valid encodings but not registered at IANA. -The names under which they are listed here are probably the -most widely-known names for these encodings and are recommended -names. - - BIG5PLUS (**) - -is a proprietary name. - -=head2 Microsoft-related naming mess - -Microsoft products misuse the following names: - -=over 2 - -=item KS_C_5601-1987 - -Microsoft extension to C<EUC-KR>. - -Proper names: C<CP949>, C<UHC>, C<x-windows-949> (as used by Mozilla). - -See L<http://lists.w3.org/Archives/Public/ietf-charsets/2001AprJun/0033.html> -for details. - -Encode aliases C<KS_C_5601-1987> to C<cp949> to reflect this common -misusage. I<Raw> C<KS_C_5601-1987> encoding is available as -C<kcs5601-raw>. - -See L<Encode::KR> for details. - -=item GB2312 - -Microsoft extension to C<EUC-CN>. - -Proper names: C<CP936>, C<GBK>. - -C<GB2312> has been registered in the C<EUC-CN> meaning at -IANA. This has partially repaired the situation: Microsoft's -C<GB2312> has become a superset of the official C<GB2312>. - -Encode aliases C<GB2312> to C<euc-cn> in full agreement with -IANA registration. C<cp936> is supported separately. -I<Raw> C<GB_2312-80> encoding is available as C<gb2312-raw>. - -See L<Encode::CN> for details. - -=item Big5 - -Microsoft extension to C<Big5>. - -Proper name: C<CP950>. - -Encode separately supports C<Big5> and C<cp950>. - -=item Shift_JIS - -Microsoft's understanding of C<Shift_JIS>. - -JIS has not endorsed the full Microsoft standard however. -The official C<Shift_JIS> includes only JIS X 0201 and JIS X 0208 -character sets, while Microsoft has always used C<Shift_JIS> -to encode a wider character repertoire. See C<IANA> registration for -C<Windows-31J>. - -As a historical predecessor, Microsoft's variant -probably has more rights for the name, though it may be objected -that Microsoft shouldn't have used JIS as part of the name -in the first place. - -Unambiguous name: C<CP932>. C<IANA> name (also used by Mozilla, and -provided as an alias by Encode): C<Windows-31J>. - -Encode separately supports C<Shift_JIS> and C<cp932>. - -=back - -=head1 Glossary - -=over 2 - -=item character repertoire - -A collection of unique characters. A I<character> set in the strictest -sense. At this stage, characters are not numbered. - -=item coded character set (CCS) - -A character set that is mapped in a way computers can use directly. -Many character encodings, including EUC, fall in this category. - -=item character encoding scheme (CES) - -An algorithm to map a character set to a byte sequence. You don't -have to be able to tell which character set a given byte sequence -belongs. 7-bit ISO-2022 is a CES but it cannot be a CCS. EUC is an -example of being both a CCS and CES. - -=item charset (in MIME context) - -has long been used in the meaning of C<encoding>, CES. - -While the word combination C<character set> has lost this meaning -in MIME context since [RFC 2130], the C<charset> abbreviation has -retained it. This is how [RFC 2277] and [RFC 2278] bless C<charset>: - - This document uses the term "charset" to mean a set of rules for - mapping from a sequence of octets to a sequence of characters, such - as the combination of a coded character set and a character encoding - scheme; this is also what is used as an identifier in MIME "charset=" - parameters, and registered in the IANA charset registry ... (Note - that this is NOT a term used by other standards bodies, such as ISO). - [RFC 2277] - -=item EUC - -Extended Unix Character. See ISO-2022. - -=item ISO-2022 - -A CES that was carefully designed to coexist with ASCII. There are a 7 -bit version and an 8 bit version. - -The 7 bit version switches character set via escape sequence so it -cannot form a CCS. Since this is more difficult to handle in programs -than the 8 bit version, the 7 bit version is not very popular except for -iso-2022-jp, the I<de facto> standard CES for e-mails. - -The 8 bit version can form a CCS. EUC and ISO-8859 are two examples -thereof. Pre-5.6 perl could use them as string literals. - -=item UCS - -Short for I<Universal Character Set>. When you say just UCS, it means -I<Unicode>. - -=item UCS-2 - -ISO/IEC 10646 encoding form: Universal Character Set coded in two -octets. - -=item Unicode - -A character set that aims to include all character repertoires of the -world. Many character sets in various national as well as industrial -standards have become, in a way, just subsets of Unicode. - -=item UTF - -Short for I<Unicode Transformation Format>. Determines how to map a -Unicode character into a byte sequence. - -=item UTF-16 - -A UTF in 16-bit encoding. Can either be in big endian or little -endian. The big endian version is called UTF-16BE (equal to UCS-2 + -surrogate support) and the little endian version is called UTF-16LE. - -=back - -=head1 See Also - -L<Encode>, -L<Encode::Byte>, -L<Encode::CN>, L<Encode::JP>, L<Encode::KR>, L<Encode::TW>, -L<Encode::EBCDIC>, L<Encode::Symbol> -L<Encode::MIME::Header>, L<Encode::Guess> - -=head1 References - -=over 2 - -=item ECMA - -European Computer Manufacturers Association -L<http://www.ecma.ch> - -=over 2 - -=item ECMA-035 (eq C<ISO-2022>) - -L<http://www.ecma.ch/ecma1/STAND/ECMA-035.HTM> - -The specification of ISO-2022 is available from the link above. - -=back - -=item IANA - -Internet Assigned Numbers Authority -L<http://www.iana.org/> - -=over 2 - -=item Assigned Charset Names by IANA - -L<http://www.iana.org/assignments/character-sets> - -Most of the C<canonical names> in Encode derive from this list -so you can directly apply the string you have extracted from MIME -header of mails and web pages. - -=back - -=item ISO - -International Organization for Standardization -L<http://www.iso.ch/> - -=item RFC - -Request For Comments -- need I say more? -L<http://www.rfc-editor.org/>, L<http://www.ietf.org/rfc.html>, -L<http://www.faqs.org/rfcs/> - -=item UC - -Unicode Consortium -L<http://www.unicode.org/> - -=over 2 - -=item Unicode Glossary - -L<http://www.unicode.org/glossary/> - -The glossary of this document is based upon this site. - -=back - -=back - -=head2 Other Notable Sites - -=over 2 - -=item czyborra.com - -L<http://czyborra.com/> - -Contains a lot of useful information, especially gory details of ISO -vs. vendor mappings. - -=item CJK.inf - -L<http://examples.oreilly.com/cjkvinfo/doc/cjk.inf> - -Somewhat obsolete (last update in 1996), but still useful. Also try - -L<ftp://ftp.oreilly.com/pub/examples/nutshell/cjkv/pdf/GB18030_Summary.pdf> - -You will find brief info on C<EUC-CN>, C<GBK> and mostly on C<GB 18030>. - -=item Jungshik Shin's Hangul FAQ - -L<http://jshin.net/faq> - -And especially its subject 8. - -L<http://jshin.net/faq/qa8.html> - -A comprehensive overview of the Korean (C<KS *>) standards. - -=item debian.org: "Introduction to i18n" - -A brief description for most of the mentioned CJK encodings is -contained in -L<http://www.debian.org/doc/manuals/intro-i18n/ch-codes.en.html> - -=back - -=head2 Offline sources - -=over 2 - -=item C<CJKV Information Processing> by Ken Lunde - -CJKV Information Processing -1999 O'Reilly & Associates, ISBN : 1-56592-224-7 - -The modern successor of C<CJK.inf>. - -Features a comprehensive coverage of CJKV character sets and -encodings along with many other issues faced by anyone trying -to better support CJKV languages/scripts in all the areas of -information processing. - -To purchase this book, visit -L<http://oreilly.com/catalog/9780596514471/> -or your favourite bookstore. - -=back - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Symbol.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Symbol.pm deleted file mode 100755 index 77031aad75c..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Symbol.pm +++ /dev/null @@ -1,44 +0,0 @@ -package Encode::Symbol; -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -1; -__END__ - -=head1 NAME - -Encode::Symbol - Symbol Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $symbol = encode("symbol", $utf8); # loads Encode::Symbol implicitly - $utf8 = decode("", $symbol); # ditto - -=head1 ABSTRACT - -This module implements symbol and dingbats encodings. Encodings -supported are as follows. - - Canonical Alias Description - -------------------------------------------------------------------- - symbol - dingbats - AdobeZDingbat - AdobeSymbol - MacDingbats - -=head1 DESCRIPTION - -To find out how to use this module in detail, see L<Encode>. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/TW.pm b/Master/tlpkg/tlperl.straw/lib/Encode/TW.pm deleted file mode 100755 index c30499bee1e..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/TW.pm +++ /dev/null @@ -1,75 +0,0 @@ -package Encode::TW; -BEGIN { - if ( ord("A") == 193 ) { - die "Encode::TW not supported on EBCDIC\n"; - } -} -use strict; -use warnings; -use Encode; -our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -1; -__END__ - -=head1 NAME - -Encode::TW - Taiwan-based Chinese Encodings - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $big5 = encode("big5", $utf8); # loads Encode::TW implicitly - $utf8 = decode("big5", $big5); # ditto - -=head1 DESCRIPTION - -This module implements tradition Chinese charset encodings as used -in Taiwan and Hong Kong. -Encodings supported are as follows. - - Canonical Alias Description - -------------------------------------------------------------------- - big5-eten /\bbig-?5$/i Big5 encoding (with ETen extensions) - /\bbig5-?et(en)?$/i - /\btca-?big5$/i - big5-hkscs /\bbig5-?hk(scs)?$/i - /\bhk(scs)?-?big5$/i - Big5 + Cantonese characters in Hong Kong - MacChineseTrad Big5 + Apple Vendor Mappings - cp950 Code Page 950 - = Big5 + Microsoft vendor mappings - -------------------------------------------------------------------- - -To find out how to use this module in detail, see L<Encode>. - -=head1 NOTES - -Due to size concerns, C<EUC-TW> (Extended Unix Character), C<CCCII> -(Chinese Character Code for Information Interchange), C<BIG5PLUS> -(CMEX's Big5+) and C<BIG5EXT> (CMEX's Big5e) are distributed separately -on CPAN, under the name L<Encode::HanExtra>. That module also contains -extra China-based encodings. - -=head1 BUGS - -Since the original C<big5> encoding (1984) is not supported anywhere -(glibc and DOS-based systems uses C<big5> to mean C<big5-eten>; Microsoft -uses C<big5> to mean C<cp950>), a conscious decision was made to alias -C<big5> to C<big5-eten>, which is the de facto superset of the original -big5. - -The C<CNS11643> encoding files are not complete. For common C<CNS11643> -manipulation, please use C<EUC-TW> in L<Encode::HanExtra>, which contains -planes 1-7. - -The ASCII region (0x00-0x7f) is preserved for all encodings, even -though this conflicts with mappings by the Unicode Consortium. - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Unicode.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Unicode.pm deleted file mode 100755 index f71567c6196..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Unicode.pm +++ /dev/null @@ -1,270 +0,0 @@ -package Encode::Unicode; - -use strict; -use warnings; -no warnings 'redefine'; - -our $VERSION = do { my @r = ( q$Revision: 2.7 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; - -use XSLoader; -XSLoader::load( __PACKAGE__, $VERSION ); - -# -# Object Generator 8 transcoders all at once! -# - -require Encode; - -our %BOM_Unknown = map { $_ => 1 } qw(UTF-16 UTF-32); - -for my $name ( - qw(UTF-16 UTF-16BE UTF-16LE - UTF-32 UTF-32BE UTF-32LE - UCS-2BE UCS-2LE) - ) -{ - my ( $size, $endian, $ucs2, $mask ); - $name =~ /^(\w+)-(\d+)(\w*)$/o; - if ( $ucs2 = ( $1 eq 'UCS' ) ) { - $size = 2; - } - else { - $size = $2 / 8; - } - $endian = ( $3 eq 'BE' ) ? 'n' : ( $3 eq 'LE' ) ? 'v' : ''; - $size == 4 and $endian = uc($endian); - - $Encode::Encoding{$name} = bless { - Name => $name, - size => $size, - endian => $endian, - ucs2 => $ucs2, - } => __PACKAGE__; -} - -use base qw(Encode::Encoding); - -sub renew { - my $self = shift; - $BOM_Unknown{ $self->name } or return $self; - my $clone = bless {%$self} => ref($self); - $clone->{renewed}++; # so the caller knows it is renewed. - return $clone; -} - -# There used to be a perl implemntation of (en|de)code but with -# XS version is ripe, perl version is zapped for optimal speed - -*decode = \&decode_xs; -*encode = \&encode_xs; - -1; -__END__ - -=head1 NAME - -Encode::Unicode -- Various Unicode Transformation Formats - -=cut - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $ucs2 = encode("UCS-2BE", $utf8); - $utf8 = decode("UCS-2BE", $ucs2); - -=head1 ABSTRACT - -This module implements all Character Encoding Schemes of Unicode that -are officially documented by Unicode Consortium (except, of course, -for UTF-8, which is a native format in perl). - -=over 4 - -=item L<http://www.unicode.org/glossary/> says: - -I<Character Encoding Scheme> A character encoding form plus byte -serialization. There are Seven character encoding schemes in Unicode: -UTF-8, UTF-16, UTF-16BE, UTF-16LE, UTF-32 (UCS-4), UTF-32BE (UCS-4BE) and -UTF-32LE (UCS-4LE), and UTF-7. - -Since UTF-7 is a 7-bit (re)encoded version of UTF-16BE, It is not part of -Unicode's Character Encoding Scheme. It is separately implemented in -Encode::Unicode::UTF7. For details see L<Encode::Unicode::UTF7>. - -=item Quick Reference - - Decodes from ord(N) Encodes chr(N) to... - octet/char BOM S.P d800-dfff ord > 0xffff \x{1abcd} == - ---------------+-----------------+------------------------------ - UCS-2BE 2 N N is bogus Not Available - UCS-2LE 2 N N bogus Not Available - UTF-16 2/4 Y Y is S.P S.P BE/LE - UTF-16BE 2/4 N Y S.P S.P 0xd82a,0xdfcd - UTF-16LE 2/4 N Y S.P S.P 0x2ad8,0xcddf - UTF-32 4 Y - is bogus As is BE/LE - UTF-32BE 4 N - bogus As is 0x0001abcd - UTF-32LE 4 N - bogus As is 0xcdab0100 - UTF-8 1-4 - - bogus >= 4 octets \xf0\x9a\af\8d - ---------------+-----------------+------------------------------ - -=back - -=head1 Size, Endianness, and BOM - -You can categorize these CES by 3 criteria: size of each character, -endianness, and Byte Order Mark. - -=head2 by size - -UCS-2 is a fixed-length encoding with each character taking 16 bits. -It B<does not> support I<surrogate pairs>. When a surrogate pair -is encountered during decode(), its place is filled with \x{FFFD} -if I<CHECK> is 0, or the routine croaks if I<CHECK> is 1. When a -character whose ord value is larger than 0xFFFF is encountered, -its place is filled with \x{FFFD} if I<CHECK> is 0, or the routine -croaks if I<CHECK> is 1. - -UTF-16 is almost the same as UCS-2 but it supports I<surrogate pairs>. -When it encounters a high surrogate (0xD800-0xDBFF), it fetches the -following low surrogate (0xDC00-0xDFFF) and C<desurrogate>s them to -form a character. Bogus surrogates result in death. When \x{10000} -or above is encountered during encode(), it C<ensurrogate>s them and -pushes the surrogate pair to the output stream. - -UTF-32 (UCS-4) is a fixed-length encoding with each character taking 32 bits. -Since it is 32-bit, there is no need for I<surrogate pairs>. - -=head2 by endianness - -The first (and now failed) goal of Unicode was to map all character -repertoires into a fixed-length integer so that programmers are happy. -Since each character is either a I<short> or I<long> in C, you have to -pay attention to the endianness of each platform when you pass data -to one another. - -Anything marked as BE is Big Endian (or network byte order) and LE is -Little Endian (aka VAX byte order). For anything not marked either -BE or LE, a character called Byte Order Mark (BOM) indicating the -endianness is prepended to the string. - -CAVEAT: Though BOM in utf8 (\xEF\xBB\xBF) is valid, it is meaningless -and as of this writing Encode suite just leave it as is (\x{FeFF}). - -=over 4 - -=item BOM as integer when fetched in network byte order - - 16 32 bits/char - ------------------------- - BE 0xFeFF 0x0000FeFF - LE 0xFFFe 0xFFFe0000 - ------------------------- - -=back - -This modules handles the BOM as follows. - -=over 4 - -=item * - -When BE or LE is explicitly stated as the name of encoding, BOM is -simply treated as a normal character (ZERO WIDTH NO-BREAK SPACE). - -=item * - -When BE or LE is omitted during decode(), it checks if BOM is at the -beginning of the string; if one is found, the endianness is set to -what the BOM says. If no BOM is found, the routine dies. - -=item * - -When BE or LE is omitted during encode(), it returns a BE-encoded -string with BOM prepended. So when you want to encode a whole text -file, make sure you encode() the whole text at once, not line by line -or each line, not file, will have a BOM prepended. - -=item * - -C<UCS-2> is an exception. Unlike others, this is an alias of UCS-2BE. -UCS-2 is already registered by IANA and others that way. - -=back - -=head1 Surrogate Pairs - -To say the least, surrogate pairs were the biggest mistake of the -Unicode Consortium. But according to the late Douglas Adams in I<The -Hitchhiker's Guide to the Galaxy> Trilogy, C<In the beginning the -Universe was created. This has made a lot of people very angry and -been widely regarded as a bad move>. Their mistake was not of this -magnitude so let's forgive them. - -(I don't dare make any comparison with Unicode Consortium and the -Vogons here ;) Or, comparing Encode to Babel Fish is completely -appropriate -- if you can only stick this into your ear :) - -Surrogate pairs were born when the Unicode Consortium finally -admitted that 16 bits were not big enough to hold all the world's -character repertoires. But they already made UCS-2 16-bit. What -do we do? - -Back then, the range 0xD800-0xDFFF was not allocated. Let's split -that range in half and use the first half to represent the C<upper -half of a character> and the second half to represent the C<lower -half of a character>. That way, you can represent 1024 * 1024 = -1048576 more characters. Now we can store character ranges up to -\x{10ffff} even with 16-bit encodings. This pair of half-character is -now called a I<surrogate pair> and UTF-16 is the name of the encoding -that embraces them. - -Here is a formula to ensurrogate a Unicode character \x{10000} and -above; - - $hi = ($uni - 0x10000) / 0x400 + 0xD800; - $lo = ($uni - 0x10000) % 0x400 + 0xDC00; - -And to desurrogate; - - $uni = 0x10000 + ($hi - 0xD800) * 0x400 + ($lo - 0xDC00); - -Note this move has made \x{D800}-\x{DFFF} into a forbidden zone but -perl does not prohibit the use of characters within this range. To perl, -every one of \x{0000_0000} up to \x{ffff_ffff} (*) is I<a character>. - - (*) or \x{ffff_ffff_ffff_ffff} if your perl is compiled with 64-bit - integer support! - -=head1 Error Checking - -Unlike most encodings which accept various ways to handle errors, -Unicode encodings simply croaks. - - % perl -MEncode -e'$_ = "\xfe\xff\xd8\xd9\xda\xdb\0\n"' \ - -e'Encode::from_to($_, "utf16","shift_jis", 0); print' - UTF-16:Malformed LO surrogate d8d9 at /path/to/Encode.pm line 184. - % perl -MEncode -e'$a = "BOM missing"' \ - -e' Encode::from_to($a, "utf16", "shift_jis", 0); print' - UTF-16:Unrecognised BOM 424f at /path/to/Encode.pm line 184. - -Unlike other encodings where mappings are not one-to-one against -Unicode, UTFs are supposed to map 100% against one another. So Encode -is more strict on UTFs. - -Consider that "division by zero" of Encode :) - -=head1 SEE ALSO - -L<Encode>, L<Encode::Unicode::UTF7>, L<http://www.unicode.org/glossary/>, -L<http://www.unicode.org/unicode/faq/utf_bom.html>, - -RFC 2781 L<http://www.ietf.org/rfc/rfc2781.txt>, - -The whole Unicode standard L<http://www.unicode.org/unicode/uni2book/u2.html> - -Ch. 15, pp. 403 of C<Programming Perl (3rd Edition)> -by Larry Wall, Tom Christiansen, Jon Orwant; -O'Reilly & Associates; ISBN 0-596-00027-8 - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/Unicode/UTF7.pm b/Master/tlpkg/tlperl.straw/lib/Encode/Unicode/UTF7.pm deleted file mode 100755 index 6ee46195854..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/Unicode/UTF7.pm +++ /dev/null @@ -1,128 +0,0 @@ -# -# $Id: UTF7.pm,v 2.4 2006/06/03 20:28:48 dankogai Exp $ -# -package Encode::Unicode::UTF7; -use strict; -use warnings; -no warnings 'redefine'; -use base qw(Encode::Encoding); -__PACKAGE__->Define('UTF-7'); -our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; -use MIME::Base64; -use Encode; - -# -# Algorithms taken from Unicode::String by Gisle Aas -# - -our $OPTIONAL_DIRECT_CHARS = 1; -my $specials = quotemeta "\'(),-./:?"; -$OPTIONAL_DIRECT_CHARS - and $specials .= quotemeta "!\"#$%&*;<=>@[]^_`{|}"; - -# \s will not work because it matches U+3000 DEOGRAPHIC SPACE -# We use qr/[\n\r\t\ ] instead -my $re_asis = qr/(?:[\n\r\t\ A-Za-z0-9$specials])/; -my $re_encoded = qr/(?:[^\n\r\t\ A-Za-z0-9$specials])/; -my $e_utf16 = find_encoding("UTF-16BE"); - -sub needs_lines { 1 } - -sub encode($$;$) { - my ( $obj, $str, $chk ) = @_; - my $len = length($str); - pos($str) = 0; - my $bytes = ''; - while ( pos($str) < $len ) { - if ( $str =~ /\G($re_asis+)/ogc ) { - $bytes .= $1; - } - elsif ( $str =~ /\G($re_encoded+)/ogsc ) { - if ( $1 eq "+" ) { - $bytes .= "+-"; - } - else { - my $s = $1; - my $base64 = encode_base64( $e_utf16->encode($s), '' ); - $base64 =~ s/=+$//; - $bytes .= "+$base64-"; - } - } - else { - die "This should not happen! (pos=" . pos($str) . ")"; - } - } - $_[1] = '' if $chk; - return $bytes; -} - -sub decode($$;$) { - my ( $obj, $bytes, $chk ) = @_; - my $len = length($bytes); - my $str = ""; - no warnings 'uninitialized'; - while ( pos($bytes) < $len ) { - if ( $bytes =~ /\G([^+]+)/ogc ) { - $str .= $1; - } - elsif ( $bytes =~ /\G\+-/ogc ) { - $str .= "+"; - } - elsif ( $bytes =~ /\G\+([A-Za-z0-9+\/]+)-?/ogsc ) { - my $base64 = $1; - my $pad = length($base64) % 4; - $base64 .= "=" x ( 4 - $pad ) if $pad; - $str .= $e_utf16->decode( decode_base64($base64) ); - } - elsif ( $bytes =~ /\G\+/ogc ) { - $^W and warn "Bad UTF7 data escape"; - $str .= "+"; - } - else { - die "This should not happen " . pos($bytes); - } - } - $_[1] = '' if $chk; - return $str; -} -1; -__END__ - -=head1 NAME - -Encode::Unicode::UTF7 -- UTF-7 encoding - -=head1 SYNOPSIS - - use Encode qw/encode decode/; - $utf7 = encode("UTF-7", $utf8); - $utf8 = decode("UTF-7", $ucs2); - -=head1 ABSTRACT - -This module implements UTF-7 encoding documented in RFC 2152. UTF-7, -as its name suggests, is a 7-bit re-encoded version of UTF-16BE. It -is designed to be MTA-safe and expected to be a standard way to -exchange Unicoded mails via mails. But with the advent of UTF-8 and -8-bit compliant MTAs, UTF-7 is hardly ever used. - -UTF-7 was not supported by Encode until version 1.95 because of that. -But Unicode::String, a module by Gisle Aas which adds Unicode supports -to non-utf8-savvy perl did support UTF-7, the UTF-7 support was added -so Encode can supersede Unicode::String 100%. - -=head1 In Practice - -When you want to encode Unicode for mails and web pages, however, do -not use UTF-7 unless you are sure your recipients and readers can -handle it. Very few MUAs and WWW Browsers support these days (only -Mozilla seems to support one). For general cases, use UTF-8 for -message body and MIME-Header for header instead. - -=head1 SEE ALSO - -L<Encode>, L<Encode::Unicode>, L<Unicode::String> - -RFC 2781 L<http://www.ietf.org/rfc/rfc2152.txt> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/_PM.e2x b/Master/tlpkg/tlperl.straw/lib/Encode/_PM.e2x deleted file mode 100755 index eb59cd1b520..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/_PM.e2x +++ /dev/null @@ -1,23 +0,0 @@ -package Encode::$_Name_; -our $VERSION = "0.01"; - -use Encode; -use XSLoader; -XSLoader::load(__PACKAGE__,$VERSION); - -1; -__END__ - -=head1 NAME - -Encode::$_Name_ - New Encoding - -=head1 SYNOPSIS - -You got to fill this in! - -=head1 SEE ALSO - -L<Encode> - -=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/_T.e2x b/Master/tlpkg/tlperl.straw/lib/Encode/_T.e2x deleted file mode 100755 index 6cf5f293d54..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/_T.e2x +++ /dev/null @@ -1,7 +0,0 @@ -use strict; -# Adjust the number here! -use Test::More tests => 2; - -use_ok('Encode'); -use_ok('Encode::$_Name_'); -# Add more test here! diff --git a/Master/tlpkg/tlperl.straw/lib/Encode/encode.h b/Master/tlpkg/tlperl.straw/lib/Encode/encode.h deleted file mode 100755 index 0dcf83d32bc..00000000000 --- a/Master/tlpkg/tlperl.straw/lib/Encode/encode.h +++ /dev/null @@ -1,113 +0,0 @@ -#ifndef ENCODE_H -#define ENCODE_H - -#ifndef U8 -/* - A tad devious this: - perl normally has a #define for U8 - if that isn't present then we - typedef it - leaving it #ifndef so we can do data parts without - getting extern references to the code parts -*/ -typedef unsigned char U8; -#endif - -typedef struct encpage_s encpage_t; - -struct encpage_s -{ - /* fields ordered to pack nicely on 32-bit machines */ - const U8 *const seq; /* Packed output sequences we generate - if we match */ - const encpage_t *const next; /* Page to go to if we match */ - const U8 min; /* Min value of octet to match this entry */ - const U8 max; /* Max value of octet to match this entry */ - const U8 dlen; /* destination length - - size of entries in seq */ - const U8 slen; /* source length - - number of source octets needed */ -}; - -/* - At any point in a translation there is a page pointer which points - at an array of the above structures. - - Basic operation : - get octet from source stream. - if (octet >= min && octet < max) { - if slen is 0 then we cannot represent this character. - if we have less than slen octets (including this one) then - we have a partial character. - otherwise - copy dlen octets from seq + dlen*(octet-min) to output - (dlen may be zero if we don't know yet.) - load page pointer with next to continue. - (is slen is one this is end of a character) - get next octet. - } - else { - increment the page pointer to look at next slot in the array - } - - arrays SHALL be constructed so there is an entry which matches - ..0xFF at the end, and either maps it or indicates no - representation. - - if MSB of slen is set then mapping is an approximate "FALLBACK" entry. - -*/ - - -typedef struct encode_s encode_t; -struct encode_s -{ - const encpage_t *const t_utf8; /* Starting table for translation from - the encoding to UTF-8 form */ - const encpage_t *const f_utf8; /* Starting table for translation - from UTF-8 to the encoding */ - const U8 *const rep; /* Replacement character in this - encoding e.g. "?" */ - int replen; /* Number of octets in rep */ - U8 min_el; /* Minimum octets to represent a - character */ - U8 max_el; /* Maximum octets to represent a - character */ - const char *const name[2]; /* name(s) of this encoding */ -}; - -#ifdef U8 -/* See comment at top of file for deviousness */ - -extern int do_encode(const encpage_t *enc, const U8 *src, STRLEN *slen, - U8 *dst, STRLEN dlen, STRLEN *dout, int approx, - const U8 *term, STRLEN tlen); - -extern void Encode_DefineEncoding(encode_t *enc); - -#endif /* U8 */ - -#define ENCODE_NOSPACE 1 -#define ENCODE_PARTIAL 2 -#define ENCODE_NOREP 3 -#define ENCODE_FALLBACK 4 -#define ENCODE_FOUND_TERM 5 - -#define FBCHAR_UTF8 "\xEF\xBF\xBD" - -#define ENCODE_DIE_ON_ERR 0x0001 /* croaks immediately */ -#define ENCODE_WARN_ON_ERR 0x0002 /* warn on error; may proceed */ -#define ENCODE_RETURN_ON_ERR 0x0004 /* immediately returns on NOREP */ -#define ENCODE_LEAVE_SRC 0x0008 /* $src updated unless set */ -#define ENCODE_PERLQQ 0x0100 /* perlqq fallback string */ -#define ENCODE_HTMLCREF 0x0200 /* HTML character ref. fb mode */ -#define ENCODE_XMLCREF 0x0400 /* XML character ref. fb mode */ -#define ENCODE_STOP_AT_PARTIAL 0x0800 /* stop at partial explicitly */ - -#define ENCODE_FB_DEFAULT 0x0000 -#define ENCODE_FB_CROAK 0x0001 -#define ENCODE_FB_QUIET ENCODE_RETURN_ON_ERR -#define ENCODE_FB_WARN (ENCODE_RETURN_ON_ERR|ENCODE_WARN_ON_ERR) -#define ENCODE_FB_PERLQQ (ENCODE_PERLQQ|ENCODE_LEAVE_SRC) -#define ENCODE_FB_HTMLCREF (ENCODE_HTMLCREF|ENCODE_LEAVE_SRC) -#define ENCODE_FB_XMLCREF (ENCODE_XMLCREF|ENCODE_LEAVE_SRC) - -#endif /* ENCODE_H */ |