summaryrefslogtreecommitdiff
path: root/ext/Encode
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2002-04-26 17:36:16 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2002-04-26 17:36:16 +0000
commit5f228b1d3feafe3247efca23709f3c7bd5daf91b (patch)
treef917a045995abe71f5d8c726bebf6768680e3d73 /ext/Encode
parent2583bd17aea1ca96fac50929c91872157a7782b3 (diff)
parentcb5780feb6b3d31503eb651fb2d3d543cc89f6c6 (diff)
downloadperl-5f228b1d3feafe3247efca23709f3c7bd5daf91b.tar.gz
Integrate mainline
p4raw-id: //depot/perlio@16194
Diffstat (limited to 'ext/Encode')
-rw-r--r--ext/Encode/AUTHORS1
-rw-r--r--ext/Encode/CN/Makefile.PL15
-rw-r--r--ext/Encode/Changes50
-rw-r--r--ext/Encode/Encode.pm185
-rw-r--r--ext/Encode/Encode.xs50
-rw-r--r--ext/Encode/Encode/encode.h4
-rw-r--r--ext/Encode/JP/Makefile.PL15
-rw-r--r--ext/Encode/KR/Makefile.PL15
-rw-r--r--ext/Encode/MANIFEST6
-rw-r--r--ext/Encode/TW/Makefile.PL15
-rw-r--r--ext/Encode/Unicode/Unicode.xs6
-rw-r--r--ext/Encode/lib/Encode/Config.pm7
-rw-r--r--ext/Encode/lib/Encode/Guess.pm297
-rw-r--r--ext/Encode/lib/Encode/JP/JIS7.pm12
-rw-r--r--ext/Encode/lib/Encode/MIME/Header.pm212
-rw-r--r--ext/Encode/t/CJKT.t3
-rw-r--r--ext/Encode/t/at-cn.t4
-rw-r--r--ext/Encode/t/at-tw.t4
-rw-r--r--ext/Encode/t/fallback.t19
-rw-r--r--ext/Encode/t/guess.t83
-rw-r--r--ext/Encode/t/jperl.t4
-rw-r--r--ext/Encode/t/mime-header.t77
22 files changed, 1023 insertions, 61 deletions
diff --git a/ext/Encode/AUTHORS b/ext/Encode/AUTHORS
index 2ba72f844f..86100126b5 100644
--- a/ext/Encode/AUTHORS
+++ b/ext/Encode/AUTHORS
@@ -27,6 +27,7 @@ Nicholas Clark <nick@ccl4.org>
Nick Ing-Simmons <nick@ing-simmons.net>
Paul Marquess <paul_marquess@yahoo.co.uk>
Philip Newton <pne@cpan.org>
+Robin Barker <rmb1@cise.npl.co.uk>
SADAHIRO Tomoyuki <SADAHIRO@cpan.org>
Spider Boardman <spider@web.zk3.dec.com>
Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
diff --git a/ext/Encode/CN/Makefile.PL b/ext/Encode/CN/Makefile.PL
index 46b262dacd..775a8f5b38 100644
--- a/ext/Encode/CN/Makefile.PL
+++ b/ext/Encode/CN/Makefile.PL
@@ -1,6 +1,7 @@
use 5.7.2;
use strict;
use ExtUtils::MakeMaker;
+use strict;
my %tables = (euc_cn_t => ['euc-cn.ucm',
'cp936.ucm',
@@ -11,6 +12,20 @@ my %tables = (euc_cn_t => ['euc-cn.ucm',
ir_165_t => ['ir-165.ucm'],
);
+unless ($ENV{AGGREGATE_TABLES}){
+ my @ucm;
+ for my $k (keys %tables){
+ push @ucm, @{$tables{$k}};
+ }
+ %tables = ();
+ my $seq = 0;
+ for my $ucm (sort @ucm){
+ # 8.3 compliance !
+ my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++);
+ $tables{$t} = [ $ucm ];
+ }
+}
+
my $name = 'CN';
WriteMakefile(
diff --git a/ext/Encode/Changes b/ext/Encode/Changes
index 77a5f04120..ad4fabb76a 100644
--- a/ext/Encode/Changes
+++ b/ext/Encode/Changes
@@ -1,9 +1,53 @@
# Revision history for Perl extension Encode.
#
-# $Id: Changes,v 1.58 2002/04/22 23:54:22 dankogai Exp $
+# $Id: Changes,v 1.61 2002/04/26 03:02:04 dankogai Exp $
#
-$Revision: 1.58 $ $Date: 2002/04/22 23:54:22 $
+$Revision: 1.61 $ $Date: 2002/04/26 03:02:04 $
+! t/mime-header.t
+ Now does decent tests besides use_ok()
+! lib/Encode/Guess.pm t/guess.t
+ UI streamlined, document added
+! Unicode/Unicode.xs
+ various signed/unsigned mismatch nits (#16173)
+ http://public.activestate.com/cgi-bin/perlbrowse?patch=16173
+! Encode.pm
+ POD: utf8-flag-related caveats added. A few sections completely
+ rewritten.
+! Encode.xs
+! AUTHORS
+ Thou shalt not assume %d works, either!
+ Robin Baker added to AUTHORS for this
+ Message-Id: <200204251132.MAA28237@tempest.npl.co.uk>
+! t/CJKT.t
+ "Change 16144 by gsar@onru on 2002/04/24 18:59:05"
+
+1.60 2002/04/24 20:06:52
+! Encode.xs
+ "Thou shalt not assume %x works." -- jhi
+ Message-Id: <20020424210618.E24347@alpha.hut.fi>
+! CN/Makefile.PL JP/Makefile.PL KR/Makefile.PL TW/Makefile.PL To make
+ low-memory build machines happy, now *.c is created for each *.ucm
+ (no table aggregation). You can still override this by setting
+ $ENV{AGGREGATE_TABLES}.
+ Message-Id: <00B1B3E4-579F-11D6-A441-00039301D480@dan.co.jp>
++ lib/Encode/Guess.pm
++ lib/Encode/JP/JIS7.pm
+ Encoding-autodetect (mainly for Japanese encoding) added. In a
+ course of development, JIS7.pm was improved.
++ lib/Encode/HTML/Header.pm
++ lib/Encode/Config.pm
+ MIME B/Q Header Encoding Added!
+! Encode.pm Encode.xs t/fallback.t
+ new fallbacks; XMLCREF and HTMLCREF upon Bart's request.
+ Message-Id: <20020424130709.GA14211@tanglefoot>
+
+1.59 $ 2002/04/22 23:54:22
+! Encode.pm Encode.xs
+ needs_lines() and perlio_ok() are added to Internal encodings such
+ as utf8 so XML::SAX is happy. FB_* stub xsubs are now prototyped.
+
+1.58 2002/04/22 23:54:22
! TW/TW.pm
s/MacChineseSimp/MacChineseTrad/ # ... oops.
! bin/ucm2text
@@ -467,7 +511,7 @@ $Revision: 1.58 $ $Date: 2002/04/22 23:54:22 $
Typo fixes and improvements by jhi
Message-Id: <200204010201.FAA03564@alpha.hut.fi>, et al.
-1.11 $Date: 2002/04/22 23:54:22 $
+1.11 $Date: 2002/04/26 03:02:04 $
+ t/encoding.t
+ t/jperl.t
! MANIFEST
diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm
index b03d93d707..e6c54f0a9f 100644
--- a/ext/Encode/Encode.pm
+++ b/ext/Encode/Encode.pm
@@ -1,12 +1,12 @@
package Encode;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.58 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.61 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
our $DEBUG = 0;
use XSLoader ();
XSLoader::load 'Encode';
require Exporter;
-our @ISA = qw(Exporter);
+use base qw/Exporter/;
# Public, encouraged API is exported by default
@@ -15,8 +15,10 @@ our @EXPORT = qw(
encodings find_encoding
);
-our @FB_FLAGS = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC PERLQQ);
-our @FB_CONSTS = qw(FB_DEFAULT FB_QUIET FB_WARN FB_PERLQQ FB_CROAK);
+our @FB_FLAGS = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
+ PERLQQ HTMLCREF XMLCREF);
+our @FB_CONSTS = qw(FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
+ FB_PERLQQ FB_HTMLCREF FB_XMLCREF);
our @EXPORT_OK =
(
@@ -194,6 +196,11 @@ sub predefine_encodings{
package Encode::UTF_EBCDIC;
*name = sub{ shift->{'Name'} };
*new_sequence = sub{ return $_[0] };
+ *needs_lines = sub{ 0 };
+ *perlio_ok = sub {
+ eval{ require PerlIO::encoding };
+ return $@ ? 0 : 1;
+ };
*decode = sub{
my ($obj,$str,$chk) = @_;
my $res = '';
@@ -221,6 +228,11 @@ sub predefine_encodings{
package Encode::Internal;
*name = sub{ shift->{'Name'} };
*new_sequence = sub{ return $_[0] };
+ *needs_lines = sub{ 0 };
+ *perlio_ok = sub {
+ eval{ require PerlIO::encoding };
+ return $@ ? 0 : 1;
+ };
*decode = sub{
my ($obj,$str,$chk) = @_;
utf8::upgrade($str);
@@ -237,6 +249,11 @@ sub predefine_encodings{
package Encode::utf8;
*name = sub{ shift->{'Name'} };
*new_sequence = sub{ return $_[0] };
+ *needs_lines = sub{ 0 };
+ *perlio_ok = sub {
+ eval{ require PerlIO::encoding };
+ return $@ ? 0 : 1;
+ };
*decode = sub{
my ($obj,$octets,$chk) = @_;
my $str = Encode::decode_utf8($octets);
@@ -314,7 +331,7 @@ byte has 256 possible values, it easily fits in Perl's much larger
=head2 TERMINOLOGY
-=over 4
+=over 2
=item *
@@ -339,7 +356,7 @@ and such details may change in future releases.
=head1 PERL ENCODING API
-=over 4
+=over 2
=item $octets = encode(ENCODING, $string[, CHECK])
@@ -351,7 +368,13 @@ For CHECK, see L</"Handling Malformed Data">.
For example, to convert (internally UTF-8 encoded) Unicode string to
iso-8859-1 (also known as Latin1),
- $octets = encode("iso-8859-1", $unicode);
+ $octets = encode("iso-8859-1", $utf8);
+
+B<CAVEAT>: When you C<$octets = encode("utf8", $utf8)>, then $octets
+B<ne> $utf8. Though they both contain the same data, the utf8 flag
+for $octets is B<always> off. When you encode anything, utf8 flag of
+the result is always off, even when it contains completely valid utf8
+string. See L</"The UTF-8 flag"> below.
=item $string = decode(ENCODING, $octets[, CHECK])
@@ -365,16 +388,22 @@ For example, to convert ISO-8859-1 data to UTF-8:
$utf8 = decode("iso-8859-1", $latin1);
-=item [$length =] from_to($string, FROM_ENCODING, TO_ENCODING [,CHECK])
+B<CAVEAT>: When you C<$utf8 = encode("utf8", $octets)>, then $utf8
+B<may not be equal to> $utf8. Though they both contain the same data,
+the utf8 flag for $utf8 is on unless $octets entirely conststs of
+ASCII data (or EBCDIC on EBCDIC machines). See L</"The UTF-8 flag">
+below.
-Converts B<in-place> data between two encodings.
-For example, to convert ISO-8859-1 data to UTF-8:
+=item [$length =] from_to($string, FROM_ENC, TO_ENC [, CHECK])
+
+Converts B<in-place> data between two encodings. For example, to
+convert ISO-8859-1 data to UTF-8:
- from_to($data, "iso-8859-1", "utf-8");
+ from_to($data, "iso-8859-1", "utf8");
and to convert it back:
- from_to($data, "utf-8", "iso-8859-1");
+ from_to($data, "utf8", "iso-8859-1");
Note that because the conversion happens in place, the data to be
converted cannot be a string constant; it must be a scalar variable.
@@ -382,32 +411,34 @@ converted cannot be a string constant; it must be a scalar variable.
from_to() returns the length of the converted string on success, undef
otherwise.
-=back
+B<CAVEAT>: The following operations look the same but not quite so;
+
+ from_to($data, "iso-8859-1", "utf8"); #1
+ $data = decode("iso-8859-1", $data); #2
-=head2 UTF-8 / utf8
+Both #1 and #2 makes $data consists of completely valid UTF-8 string
+but only #2 turns utf8 flag on. #1 is equivalent to
-The Unicode Consortium defines the UTF-8 transformation format as a
-way of encoding the entire Unicode repertoire as sequences of octets.
-This encoding is expected to become very widespread. Perl can use this
-form internally to represent strings, so conversions to and from this
-form are particularly efficient (as octets in memory do not have to
-change, just the meta-data that tells Perl how to treat them).
+ $data = encode("utf8", decode("iso-8859-1", $data));
-=over 4
+See L</"The UTF-8 flag"> below.
=item $octets = encode_utf8($string);
-The characters that comprise $string are encoded in Perl's superset of
-UTF-8 and the resulting octets are returned as a sequence of bytes. All
-possible characters have a UTF-8 representation so this function cannot
-fail.
+Equivalent to C<$octets = encode("utf8", $string);> The characters
+that comprise $string are encoded in Perl's superset of UTF-8 and the
+resulting octets are returned as a sequence of bytes. All possible
+characters have a UTF-8 representation so this function cannot fail.
+
=item $string = decode_utf8($octets [, CHECK]);
-The sequence of octets represented by $octets is decoded from UTF-8
-into a sequence of logical characters. Not all sequences of octets
-form valid UTF-8 encodings, so it is possible for this call to fail.
-For CHECK, see L</"Handling Malformed Data">.
+equivalent to C<$string = decode("utf8", $octets [, CHECK])>.
+decode_utf8($octets [, CHECK]); The sequence of octets represented by
+$octets is decoded from UTF-8 into a sequence of logical
+characters. Not all sequences of octets form valid UTF-8 encodings, so
+it is possible for this call to fail. For CHECK, see
+L</"Handling Malformed Data">.
=back
@@ -493,7 +524,7 @@ For gory details, see L<Encode::PerlIO>.
=head1 Handling Malformed Data
-=over 4
+=over 2
The I<CHECK> argument is used as follows. When you omit it,
the behaviour is the same as if you had passed a value of 0 for
@@ -507,7 +538,7 @@ E<lt>subcharE<gt> will be used. For Unicode, "\x{FFFD}" is used.
If the data is supposed to be UTF-8, an optional lexical warning
(category utf8) is given.
-=item I<CHECK> = Encode::DIE_ON_ERROR (== 1)
+=item I<CHECK> = Encode::FB_CROAK ( == 1)
If I<CHECK> is 1, methods will die immediately with an error
message. Therefore, when I<CHECK> is set to 1, you should trap the
@@ -539,6 +570,10 @@ you are debugging the mode above.
=item perlqq mode (I<CHECK> = Encode::FB_PERLQQ)
+=item HTML charref mode (I<CHECK> = Encode::FB_HTMLCREF)
+
+=item XML charref mode (I<CHECK> = Encode::FB_XMLCREF)
+
For encodings that are implemented by Encode::XS, CHECK ==
Encode::FB_PERLQQ turns (en|de)code into C<perlqq> fallback mode.
@@ -548,6 +583,10 @@ decoded to utf8. And when you encode, '\x{I<xxxx>}' will be inserted,
where I<xxxx> is the Unicode ID of the character that cannot be found
in the character repertoire of the encoding.
+HTML/XML character reference modes are about the same, in place of
+\x{I<xxxx>}, HTML uses &#I<1234>; where I<1234> is a decimal digit and
+XML uses &#xI<abcd>; where I<abcd> is the hexadecimal digit.
+
=item The bitmask
These modes are actually set via a bitmask. Here is how the FB_XX
@@ -561,6 +600,8 @@ constants via C<use Encode qw(:fallback_all)>.
RETURN_ON_ERR 0x0004 X X
LEAVE_SRC 0x0008
PERLQQ 0x0100 X
+ HTMLCREF 0x0200
+ XMLCREF 0x0400
=head2 Unimplemented fallback schemes
@@ -581,12 +622,84 @@ arguments are taken as aliases for I<$object>, as for C<define_alias>.
See L<Encode::Encoding> for more details.
-=head1 Messing with Perl's Internals
+=head1 The UTF-8 flag
+
+Before the introduction of utf8 support in perl, The C<eq> operator
+just compares internal data of the scalars. Now C<eq> means internal
+data equality AND I<the utf8 flag>. To explain why we made it so, I
+will quote page 402 of C<Programming Perl, 3rd ed.>
+
+=over 2
+
+=item Goal #1:
+
+Old byte-oriented programs should not spontaneously break on the old
+byte-oriented data they used to work on.
+
+=item Goal #2:
+
+Old byte-oriented programs should magically start working on the new
+character-oriented data when appropriate.
+
+=item Goal #3:
+
+Programs should run just as fast in the new character-oriented mode
+as in the old byte-oriented mode.
+
+=item Goal #4:
+
+Perl should remain one language, rather than forking into a
+byte-oriented Perl and a character-oriented Perl.
+
+=back
+
+Back when C<Programming Perl, 3rd ed.> was written, not even Perl 5.6.0
+was born and many features documented in the book remained
+unimplemented. Perl 5.8 hopefully correct this and the introduction
+of UTF-8 flag is one of them. You can think this perl notion of
+byte-oriented mode (utf8 flag off) and character-oriented mode (utf8
+flag on).
+
+Here is how Encode takes care of the utf8 flag.
+
+=over 2
+
+=item *
+
+When you encode, the resulting utf8 flag is always off.
+
+=item
+
+When you decode, the resuting utf8 flag is on unless you can
+unambiguously represent data. Here is the definition of
+dis-ambiguity.
+
+ After C<$utf8 = decode('foo', $octet);>,
+
+ When $octet is... The utf8 flag in $utf8 is
+ ---------------------------------------------
+ In ASCII only (or EBCDIC only) OFF
+ In ISO-8859-1 ON
+ In any other Encoding ON
+ ---------------------------------------------
+
+As you see, there is one exception, In ASCII. That way you can assue
+Goal #1. And with Encode Goal #2 is assumed but you still have to be
+careful in such cases mentioned in B<CAVEAT> paragraphs.
+
+This utf8 flag is not visible in perl scripts, exactly for the same
+reason you cannot (or you I<don't have to>) see if a scalar contains a
+string, integer, or floating point number. But you can still peek
+and poke these if you will. See the section below.
+
+=back
+
+=head2 Messing with Perl's Internals
The following API uses parts of Perl's internals in the current
implementation. As such, they are efficient but may change.
-=over 4
+=over 2
=item is_utf8(STRING [, CHECK])
@@ -626,8 +739,8 @@ the Perl Unicode Mailing List E<lt>perl-unicode@perl.orgE<gt>
=head1 MAINTAINER
This project was originated by Nick Ing-Simmons and later maintained
-by Dan Kogai E<lt>dankogai@dan.co.jpE<gt>. See AUTHORS for a full list
-of people involved. For any questions, use
-E<lt>perl-unicode@perl.orgE<gt> so others can share.
+by Dan Kogai E<lt>dankogai@dan.co.jpE<gt>. See AUTHORS for a full
+list of people involved. For any questions, use
+E<lt>perl-unicode@perl.orgE<gt> so we can all share share.
=cut
diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs
index be69c33352..1311d8dacb 100644
--- a/ext/Encode/Encode.xs
+++ b/ext/Encode/Encode.xs
@@ -1,5 +1,5 @@
/*
- $Id: Encode.xs,v 1.34 2002/04/22 20:27:30 dankogai Exp $
+ $Id: Encode.xs,v 1.39 2002/04/26 03:02:04 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
@@ -141,10 +141,22 @@ encode_method(pTHX_ encode_t * enc, encpage_t * dir, SV * src,
goto ENCODE_SET_SRC;
}else if (check & ENCODE_PERLQQ){
SV* perlqq =
- sv_2mortal(newSVpvf("\\x{%04x}", ch));
+ sv_2mortal(newSVpvf("\\x{%04"UVxf"}", ch));
sdone += slen + clen;
ddone += dlen + SvCUR(perlqq);
sv_catsv(dst, perlqq);
+ }else if (check & ENCODE_HTMLCREF){
+ SV* htmlcref =
+ sv_2mortal(newSVpvf("&#%" UVuf ";", ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(htmlcref);
+ sv_catsv(dst, htmlcref);
+ }else if (check & ENCODE_XMLCREF){
+ SV* xmlcref =
+ sv_2mortal(newSVpvf("&#x%" UVxf ";", ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(xmlcref);
+ sv_catsv(dst, xmlcref);
} else {
/* fallback char */
sdone += slen + clen;
@@ -168,7 +180,8 @@ encode_method(pTHX_ encode_t * enc, encpage_t * dir, SV * src,
enc->name[0], (U8) s[slen], code);
}
goto ENCODE_SET_SRC;
- }else if (check & ENCODE_PERLQQ){
+ }else if (check &
+ (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
SV* perlqq =
sv_2mortal(newSVpvf("\\x%02X", s[slen]));
sdone += slen + 1;
@@ -441,9 +454,6 @@ CODE:
OUTPUT:
RETVAL
-PROTOTYPES: DISABLE
-
-
int
DIE_ON_ERR()
CODE:
@@ -480,6 +490,20 @@ OUTPUT:
RETVAL
int
+HTMLCREF()
+CODE:
+ RETVAL = ENCODE_HTMLCREF;
+OUTPUT:
+ RETVAL
+
+int
+XMLCREF()
+CODE:
+ RETVAL = ENCODE_XMLCREF;
+OUTPUT:
+ RETVAL
+
+int
FB_DEFAULT()
CODE:
RETVAL = ENCODE_FB_DEFAULT;
@@ -514,6 +538,20 @@ CODE:
OUTPUT:
RETVAL
+int
+FB_HTMLCREF()
+CODE:
+ RETVAL = ENCODE_FB_HTMLCREF;
+OUTPUT:
+ RETVAL
+
+int
+FB_XMLCREF()
+CODE:
+ RETVAL = ENCODE_FB_XMLCREF;
+OUTPUT:
+ RETVAL
+
BOOT:
{
#include "def_t.h"
diff --git a/ext/Encode/Encode/encode.h b/ext/Encode/Encode/encode.h
index 04df7f9b38..b860578f22 100644
--- a/ext/Encode/Encode/encode.h
+++ b/ext/Encode/Encode/encode.h
@@ -94,11 +94,15 @@ extern void Encode_DefineEncoding(encode_t *enc);
#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_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
+#define ENCODE_FB_HTMLCREF ENCODE_HTMLCREF
+#define ENCODE_FB_XMLCREF ENCODE_XMLCREF
#endif /* ENCODE_H */
diff --git a/ext/Encode/JP/Makefile.PL b/ext/Encode/JP/Makefile.PL
index ce47d2fc97..a1df35d169 100644
--- a/ext/Encode/JP/Makefile.PL
+++ b/ext/Encode/JP/Makefile.PL
@@ -1,6 +1,7 @@
use 5.7.2;
use strict;
use ExtUtils::MakeMaker;
+use strict;
my %tables = (
euc_jp_t => ['euc-jp.ucm'],
@@ -12,6 +13,20 @@ my %tables = (
],
);
+unless ($ENV{AGGREGATE_TABLES}){
+ my @ucm;
+ for my $k (keys %tables){
+ push @ucm, @{$tables{$k}};
+ }
+ %tables = ();
+ my $seq = 0;
+ for my $ucm (sort @ucm){
+ # 8.3 compliance !
+ my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++);
+ $tables{$t} = [ $ucm ];
+ }
+}
+
my $name = 'JP';
WriteMakefile(
diff --git a/ext/Encode/KR/Makefile.PL b/ext/Encode/KR/Makefile.PL
index df0eeb68b2..4ba99ab82d 100644
--- a/ext/Encode/KR/Makefile.PL
+++ b/ext/Encode/KR/Makefile.PL
@@ -1,6 +1,7 @@
use 5.7.2;
use strict;
use ExtUtils::MakeMaker;
+use strict;
my %tables = (euc_kr_t => ['euc-kr.ucm',
'macKorean.ucm',
@@ -10,6 +11,20 @@ my %tables = (euc_kr_t => ['euc-kr.ucm',
johab_t => ['johab.ucm'],
);
+unless ($ENV{AGGREGATE_TABLES}){
+ my @ucm;
+ for my $k (keys %tables){
+ push @ucm, @{$tables{$k}};
+ }
+ %tables = ();
+ my $seq = 0;
+ for my $ucm (sort @ucm){
+ # 8.3 compliance !
+ my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++);
+ $tables{$t} = [ $ucm ];
+ }
+}
+
my $name = 'KR';
WriteMakefile(
diff --git a/ext/Encode/MANIFEST b/ext/Encode/MANIFEST
index 2a35d9f6ec..cc6a1414c9 100644
--- a/ext/Encode/MANIFEST
+++ b/ext/Encode/MANIFEST
@@ -42,12 +42,13 @@ lib/Encode/CN/HZ.pm Encode extension
lib/Encode/Config.pm Encode configuration module
lib/Encode/Encoder.pm OO Encoder
lib/Encode/Encoding.pm Encode extension
+lib/Encode/Guess.pm Encode Extension
lib/Encode/JP/H2Z.pm Encode extension
lib/Encode/JP/JIS7.pm Encode extension
lib/Encode/KR/2022_KR.pm Encode extension
+lib/Encode/MIME/Header.pm Encode extension
lib/Encode/PerlIO.pod Documents for Encode & PerlIO
lib/Encode/Supported.pod Documents for supported encodings
-t/unibench.pl benchmark script
t/Aliases.t test script
t/CJKT.t test script
t/Encode.t test script
@@ -64,6 +65,7 @@ t/fallback.t test script
t/gb2312.enc test data
t/gb2312.utf test data
t/grow.t test script
+t/guess.t test script
t/jisx0201.enc test data
t/jisx0201.utf test data
t/jisx0208.enc test data
@@ -73,7 +75,9 @@ t/jisx0212.utf test data
t/jperl.t test script
t/ksc5601.enc test data
t/ksc5601.utf test data
+t/mime-header.t test script
t/perlio.t test script
+t/unibench.pl benchmark script
ucm/8859-1.ucm Unicode Character Map
ucm/8859-10.ucm Unicode Character Map
ucm/8859-11.ucm Unicode Character Map
diff --git a/ext/Encode/TW/Makefile.PL b/ext/Encode/TW/Makefile.PL
index 4fdae9e3f5..8f12a81aee 100644
--- a/ext/Encode/TW/Makefile.PL
+++ b/ext/Encode/TW/Makefile.PL
@@ -1,6 +1,7 @@
use 5.7.2;
use strict;
use ExtUtils::MakeMaker;
+use strict;
my %tables = (big5_t => ['big5-eten.ucm',
'big5-hkscs.ucm',
@@ -8,6 +9,20 @@ my %tables = (big5_t => ['big5-eten.ucm',
'cp950.ucm'],
);
+unless ($ENV{AGGREGATE_TABLES}){
+ my @ucm;
+ for my $k (keys %tables){
+ push @ucm, @{$tables{$k}};
+ }
+ %tables = ();
+ my $seq = 0;
+ for my $ucm (sort @ucm){
+ # 8.3 compliance !
+ my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++);
+ $tables{$t} = [ $ucm ];
+ }
+}
+
my $name = 'TW';
WriteMakefile(
diff --git a/ext/Encode/Unicode/Unicode.xs b/ext/Encode/Unicode/Unicode.xs
index 4689b498e1..e3ad82c7f0 100644
--- a/ext/Encode/Unicode/Unicode.xs
+++ b/ext/Encode/Unicode/Unicode.xs
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 1.3 2002/04/20 23:43:47 dankogai Exp $
+ $Id: Unicode.xs,v 1.4 2002/04/26 03:02:04 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
@@ -61,7 +61,7 @@ enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
d += SvCUR(result);
SvCUR_set(result,SvCUR(result)+size);
while (size--) {
- *d++ = value & 0xFF;
+ *d++ = (U8)(value & 0xFF);
value >>= 8;
}
break;
@@ -70,7 +70,7 @@ enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
SvCUR_set(result,SvCUR(result)+size);
d += SvCUR(result);
while (size--) {
- *--d = value & 0xFF;
+ *--d = (U8)(value & 0xFF);
value >>= 8;
}
break;
diff --git a/ext/Encode/lib/Encode/Config.pm b/ext/Encode/lib/Encode/Config.pm
index dcbc524b7b..a834967a11 100644
--- a/ext/Encode/lib/Encode/Config.pm
+++ b/ext/Encode/lib/Encode/Config.pm
@@ -2,7 +2,7 @@
# Demand-load module list
#
package Encode::Config;
-our $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use strict;
@@ -139,6 +139,11 @@ unless (ord("A") == 193){
#'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',
+
);
}
diff --git a/ext/Encode/lib/Encode/Guess.pm b/ext/Encode/lib/Encode/Guess.pm
new file mode 100644
index 0000000000..d2aac44565
--- /dev/null
+++ b/ext/Encode/lib/Encode/Guess.pm
@@ -0,0 +1,297 @@
+package Encode::Guess;
+use strict;
+use Carp;
+
+use Encode qw(:fallbacks find_encoding);
+our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+my $Canon = 'Guess';
+our $DEBUG = 0;
+our %DEF_SUSPECTS = map { $_ => find_encoding($_) } qw(ascii utf8);
+$Encode::Encoding{$Canon} =
+ bless {
+ Name => $Canon,
+ Suspects => { %DEF_SUSPECTS },
+ } => __PACKAGE__;
+
+sub name { shift->{'Name'} }
+sub new_sequence { $_[0] }
+sub needs_lines { 1 }
+sub perlio_ok { 0 }
+sub DESTROY{}
+
+our @EXPORT = qw(guess_encoding);
+
+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);
+ ref($guessed) or croak $guessed;
+ my $utf8 = $guessed->decode($octet, $chk);
+ $_[1] = $octet if $chk;
+ return $utf8;
+}
+
+sub encode{
+ croak "Tsk, tsk, tsk. You can't be too lazy here!";
+}
+
+sub guess_encoding{
+ guess($Encode::Encoding{$Canon}, @_);
+}
+
+sub guess {
+ my $class = shift;
+ my $obj = ref($class) ? $class : $Encode::Encoding{$Canon};
+ my $octet = shift;
+ # cheat 0: utf8 flag;
+ Encode::is_utf8($octet) and return find_encoding('utf8');
+ # cheat 1: BOM
+ use Encode::Unicode;
+ my $BOM = unpack('n', $octet);
+ return find_encoding('UTF-16')
+ if ($BOM == 0xFeFF or $BOM == 0xFFFe);
+ $BOM = unpack('N', $octet);
+ return find_encoding('UTF-32')
+ if ($BOM == 0xFeFF or $BOM == 0xFFFe0000);
+
+ 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|\r\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::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.
+
+ # tries all major Japanese Encodings as well
+ use Encode::Guess qw/euc-jp shiftjis 7bit-jis/;
+
+=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 Encode::Guess fails to eliminate all other
+suspects but the right one or no suspect was good. 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 was 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 SEE ALSO
+
+L<Encode>, L<Encode::Encoding>
+
+=cut
+
diff --git a/ext/Encode/lib/Encode/JP/JIS7.pm b/ext/Encode/lib/Encode/JP/JIS7.pm
index c0a0d0622a..09ec94f9d6 100644
--- a/ext/Encode/lib/Encode/JP/JIS7.pm
+++ b/ext/Encode/lib/Encode/JP/JIS7.pm
@@ -1,7 +1,7 @@
package Encode::JP::JIS7;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.7 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use Encode qw(:fallbacks);
@@ -42,9 +42,13 @@ our $DEBUG = 0;
sub decode($$;$)
{
- my ($obj,$str,$chk) = @_;
- my $residue = jis_euc(\$str);
- # This is for PerlIO
+ my ($obj, $str, $chk) = @_;
+ my $residue = '';
+ if ($chk){
+ $str =~ s/([^\x00-\x7f].*)$//so;
+ $1 and $residue = $1;
+ }
+ $residue .= jis_euc(\$str);
$_[1] = $residue if $chk;
return Encode::decode('euc-jp', $str, FB_PERLQQ);
}
diff --git a/ext/Encode/lib/Encode/MIME/Header.pm b/ext/Encode/lib/Encode/MIME/Header.pm
new file mode 100644
index 0000000000..ce7b872876
--- /dev/null
+++ b/ext/Encode/lib/Encode/MIME/Header.pm
@@ -0,0 +1,212 @@
+package Encode::MIME::Header;
+use strict;
+# use warnings;
+our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+use Encode qw(find_encoding encode_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__;
+
+sub name { shift->{'Name'} }
+sub new_sequence { $_[0] }
+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;
+ $str =~
+ s{
+ =\? # begin encoded word
+ ([0-9A-Za-z\-]+) # charset (encoding)
+ \?([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);
+ }elsif(uc($2) eq 'Q'){
+ $obj->{decode_q} or croak qq(MIME "Q" unsupported);
+ decode_q($1, $3);
+ }else{
+ croak qq(MIME "$2" encoding is nonexistent!);
+ }
+ }egox;
+ $_[1] = '' if $chk;
+ return $str;
+}
+
+sub decode_b{
+ my $enc = shift;
+ my $d = find_encoding($enc) or croak(Unknown encoding "$enc");
+ my $db64 = decode_base64(shift);
+ return $d->decode($db64, Encode::FB_PERLQQ);
+}
+
+sub decode_q{
+ my ($enc, $q) = @_;
+ my $d = find_encoding($enc) or croak(Unknown encoding "$enc");
+ $q =~ s/_/ /go;
+ $q =~ s/=([0-9A-Fa-f]{2})/pack("C", hex($1))/ego;
+ return $d->decode($q, Encode::FB_PERLQQ);
+}
+
+my $especials =
+ join('|' =>
+ map {quotemeta(chr($_))}
+ unpack("C*", qq{()<>@,;:\"\'/[]?.=}));
+
+my $re_especials = qr/$especials/o;
+
+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){
+ 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));
+ $llen *= $enc eq 'B' ? 3/4 : 1/3;
+ my @result = ();
+ my $chunk = '';
+ while(my $chr = substr($str, 0, 1, '')){
+ use bytes ();
+ if (bytes::length($chunk) + bytes::length($chr) > $llen){
+ push @result, SINGLE->{$enc}($chunk);
+ $chunk = '';
+ }
+ $chunk .= $chr;
+ }
+ $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 =~ 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.
+
+=head1 SEE ALSO
+
+L<Encode>
+
+RFC 2047, L<http://www.faqs.org/rfcs/rfc2047.html> and many other
+locations.
+
+=cut
diff --git a/ext/Encode/t/CJKT.t b/ext/Encode/t/CJKT.t
index 4540034e55..31c0aa1916 100644
--- a/ext/Encode/t/CJKT.t
+++ b/ext/Encode/t/CJKT.t
@@ -55,7 +55,8 @@ for my $charset (sort keys %Charset){
open $src, "<$src_enc" or die "$src_enc : $!";
- binmode($src);
+ # binmode($src); # not needed!
+
$txt = join('',<$src>);
close($src);
diff --git a/ext/Encode/t/at-cn.t b/ext/Encode/t/at-cn.t
index 893c29fa6d..6249feee38 100644
--- a/ext/Encode/t/at-cn.t
+++ b/ext/Encode/t/at-cn.t
@@ -19,9 +19,11 @@ use strict;
use Test::More tests => 29;
use Encode;
+no utf8; # we have raw Chinese encodings here
+
use_ok('Encode::CN');
-# Since JP.t already test basic file IO, we will just focus on
+# Since JP.t already tests basic file IO, we will just focus on
# internal encode / decode test here. Unfortunately, to test
# against all the UniHan characters will take a huge disk space,
# not to mention the time it will take, and the fact that Perl
diff --git a/ext/Encode/t/at-tw.t b/ext/Encode/t/at-tw.t
index 830eb8686a..11abbf3807 100644
--- a/ext/Encode/t/at-tw.t
+++ b/ext/Encode/t/at-tw.t
@@ -21,9 +21,11 @@ use strict;
use Test::More tests => 17;
use Encode;
+no utf8; # we have raw Chinese encodings here
+
use_ok('Encode::TW');
-# Since JP.t already test basic file IO, we will just focus on
+# Since JP.t already tests basic file IO, we will just focus on
# internal encode / decode test here. Unfortunately, to test
# against all the UniHan characters will take a huge disk space,
# not to mention the time it will take, and the fact that Perl
diff --git a/ext/Encode/t/fallback.t b/ext/Encode/t/fallback.t
index cf867beb01..3b6625851c 100644
--- a/ext/Encode/t/fallback.t
+++ b/ext/Encode/t/fallback.t
@@ -13,17 +13,18 @@ BEGIN {
use strict;
#use Test::More qw(no_plan);
-use Test::More tests => 15;
+use Test::More tests => 19;
use Encode q(:all);
my $original = '';
my $nofallback = '';
-my ($fallenback, $quiet, $perlqq);
+my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref);
for my $i (0x20..0x7e){
$original .= chr($i);
}
-$fallenback = $quiet = $perlqq = $nofallback = $original;
+$fallenback = $quiet =
+$perlqq = $htmlcref = $xmlcref = $nofallback = $original;
my $residue = '';
for my $i (0x80..0xff){
@@ -31,6 +32,8 @@ for my $i (0x80..0xff){
$residue .= chr($i);
$fallenback .= '?';
$perlqq .= sprintf("\\x{%04x}", $i);
+ $htmlcref .= sprintf("&#%d;", $i);
+ $xmlcref .= sprintf("&#x%x;", $i);
}
utf8::upgrade($original);
my $meth = find_encoding('ascii');
@@ -75,3 +78,13 @@ $src = $original;
$dst = $meth->encode($src, FB_PERLQQ);
is($dst, $perlqq, "FB_PERLQQ");
is($src, '', "FB_PERLQQ residue");
+
+$src = $original;
+$dst = $meth->encode($src, FB_HTMLCREF);
+is($dst, $htmlcref, "FB_HTMLCREF");
+is($src, '', "FB_HTMLCREF residue");
+
+$src = $original;
+$dst = $meth->encode($src, FB_XMLCREF);
+is($dst, $xmlcref, "FB_XMLCREF");
+is($src, '', "FB_XMLCREF residue");
diff --git a/ext/Encode/t/guess.t b/ext/Encode/t/guess.t
new file mode 100644
index 0000000000..ace13ddec7
--- /dev/null
+++ b/ext/Encode/t/guess.t
@@ -0,0 +1,83 @@
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bEncode\b/) {
+ print "1..0 # Skip: Encode was not built\n";
+ exit 0;
+ }
+ $| = 1;
+}
+
+use strict;
+use File::Basename;
+use File::Spec;
+use Encode qw(decode encode find_encoding _utf8_off);
+
+#use Test::More qw(no_plan);
+use Test::More tests => 17;
+use_ok("Encode::Guess");
+{
+ no warnings;
+ $Encode::Guess::DEBUG = shift || 0;
+}
+
+my $ascii = join('' => map {chr($_)}(0x21..0x7e));
+my $latin1 = join('' => map {chr($_)}(0xa1..0xfe));
+my $utf8on = join('' => map {chr($_)}(0x3000..0x30fe));
+my $utf8off = $utf8on; _utf8_off($utf8off);
+my $utf16 = encode('UTF-16', $utf8on);
+my $utf32 = encode('UTF-32', $utf8on);
+
+is(guess_encoding($ascii)->name, 'ascii', 'ascii');
+like(guess_encoding($latin1), qr/No appropriate encoding/io, 'no ascii');
+is(guess_encoding($latin1, 'latin1')->name, 'iso-8859-1', 'iso-8859-1');
+is(guess_encoding($utf8on)->name, 'utf8', 'utf8 w/ flag');
+is(guess_encoding($utf8off)->name, 'utf8', 'utf8 w/o flag');
+is(guess_encoding($utf16)->name, 'UTF-16', 'UTF-16');
+is(guess_encoding($utf32)->name, 'UTF-32', 'UTF-32');
+
+my $jisx0201 = File::Spec->catfile(dirname(__FILE__), 'jisx0201.utf');
+my $jisx0208 = File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf');
+my $jisx0212 = File::Spec->catfile(dirname(__FILE__), 'jisx0212.utf');
+
+open my $fh, $jisx0208 or die "$jisx0208: $!";
+$utf8off = join('' => <$fh>);
+close $fh;
+$utf8on = decode('utf8', $utf8off);
+
+my @jp = qw(7bit-jis shiftjis euc-jp);
+
+Encode::Guess->set_suspects(@jp);
+
+for my $jp (@jp){
+ my $test = encode($jp, $utf8on);
+ is(guess_encoding($test)->name, $jp, "JP:$jp");
+}
+
+is (decode('Guess', encode('euc-jp', $utf8on)), $utf8on, "decode('Guess')");
+eval{ encode('Guess', $utf8on) };
+like($@, qr/lazy/io, "no encode()");
+
+my %CJKT =
+ (
+ 'euc-cn' => File::Spec->catfile(dirname(__FILE__), 'gb2312.utf'),
+ 'euc-jp' => File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf'),
+ 'euc-kr' => File::Spec->catfile(dirname(__FILE__), 'ksc5601.utf'),
+ 'big5-eten' => File::Spec->catfile(dirname(__FILE__), 'big5-eten.utf'),
+);
+
+Encode::Guess->set_suspects(keys %CJKT);
+
+for my $name (keys %CJKT){
+ open my $fh, $CJKT{$name} or die "$CJKT{$name}: $!";
+ $utf8off = join('' => <$fh>);
+ close $fh;
+
+ my $test = encode($name, decode('utf8', $utf8off));
+ is(guess_encoding($test)->name, $name, "CJKT:$name");
+}
+
+__END__;
diff --git a/ext/Encode/t/jperl.t b/ext/Encode/t/jperl.t
index faaf743f89..82f7a84dd6 100644
--- a/ext/Encode/t/jperl.t
+++ b/ext/Encode/t/jperl.t
@@ -1,5 +1,5 @@
#
-# $Id: jperl.t,v 1.23 2002/04/22 09:48:07 dankogai Exp $
+# $Id: jperl.t,v 1.24 2002/04/26 03:02:04 dankogai Exp $
#
# This script is written in euc-jp
@@ -20,6 +20,8 @@ BEGIN {
$| = 1;
}
+no utf8; # we have raw Japanese encodings here
+
use strict;
use Test::More tests => 18;
my $Debug = shift;
diff --git a/ext/Encode/t/mime-header.t b/ext/Encode/t/mime-header.t
new file mode 100644
index 0000000000..826efbfddd
--- /dev/null
+++ b/ext/Encode/t/mime-header.t
@@ -0,0 +1,77 @@
+#
+# $Id: mime-header.t,v 1.3 2002/04/26 03:07:59 dankogai Exp $
+# This script is written in utf8
+#
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bEncode\b/) {
+ print "1..0 # Skip: Encode was not built\n";
+ exit 0;
+ }
+ $| = 1;
+}
+
+use strict;
+#use Test::More qw(no_plan);
+use Test::More tests => 6;
+use_ok("Encode::MIME::Header");
+
+my $eheader =<<'EOS';
+From: =?US-ASCII?Q?Keith_Moore?= <moore@cs.utk.edu>
+To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <keld@dkuug.dk>
+CC: =?ISO-8859-1?Q?Andr=E9?= Pirard <PIRARD@vm1.ulg.ac.be>
+Subject: =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
+ =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
+EOS
+
+my $dheader=<<"EOS";
+From: Keith Moore <moore\@cs.utk.edu>
+To: Keld J\xF8rn Simonsen <keld\@dkuug.dk>
+CC: Andr\xE9 Pirard <PIRARD\@vm1.ulg.ac.be>
+Subject: If you can read this you understand the example.
+EOS
+
+is(Encode::decode('MIME-Header', $eheader), $dheader, "decode (RFC2047)");
+
+use utf8;
+
+$dheader=<<'EOS';
+From: 小飼 弾 <dankogai@dan.co.jp>
+To: dankogai@dan.co.jp (小飼=Kogai, 弾=Dan)
+Subject: 漢字、カタカナ、ひらがなを含む、非常に長いタイトル行が一体全体どのようにしてEncodeされるのか?
+EOS
+
+my $bheader =<<'EOS';
+From:=?UTF-8?B?IOWwj+mjvCDlvL4g?=<dankogai@dan.co.jp>
+To: dankogai@dan.co.jp (=?UTF-8?B?5bCP6aO8?==Kogai,=?UTF-8?B?IOW8vg==?==Dan
+ )
+Subject:
+ =?UTF-8?B?IOa8ouWtl+OAgeOCq+OCv+OCq+ODiuOAgeOBsuOCieOBjOOBquOCkuWQq+OCgA==?=
+ =?UTF-8?B?44CB6Z2e5bi444Gr6ZW344GE44K/44Kk44OI44Or6KGM44GM5LiA5L2T5YWo?=
+ =?UTF-8?B?5L2T44Gp44Gu44KI44GG44Gr44GX44GmRW5jb2Rl44GV44KM44KL44Gu44GL?=
+ =?UTF-8?B?77yf?=
+EOS
+
+my $qheader=<<'EOS';
+From:=?UTF-8?Q?=20=E5=B0=8F=E9=A3=BC=20=E5=BC=BE=20?=<dankogai@dan.co.jp>
+To: dankogai@dan.co.jp (=?UTF-8?Q?=E5=B0=8F=E9=A3=BC?==Kogai,
+ =?UTF-8?Q?=20=E5=BC=BE?==Dan)
+Subject:
+ =?UTF-8?Q?=20=E6=BC=A2=E5=AD=97=E3=80=81=E3=82=AB=E3=82=BF=E3=82=AB?=
+ =?UTF-8?Q?=E3=83=8A=E3=80=81=E3=81=B2=E3=82=89=E3=81=8C=E3=81=AA=E3=82=92?=
+ =?UTF-8?Q?=E5=90=AB=E3=82=80=E3=80=81=E9=9D=9E=E5=B8=B8=E3=81=AB=E9=95=B7?=
+ =?UTF-8?Q?=E3=81=84=E3=82=BF=E3=82=A4=E3=83=88=E3=83=AB=E8=A1=8C=E3=81=8C?=
+ =?UTF-8?Q?=E4=B8=80=E4=BD=93=E5=85=A8=E4=BD=93=E3=81=A9=E3=81=AE=E3=82=88?=
+ =?UTF-8?Q?=E3=81=86=E3=81=AB=E3=81=97=E3=81=A6Encode=E3=81=95?=
+ =?UTF-8?Q?=E3=82=8C=E3=82=8B=E3=81=AE=E3=81=8B=EF=BC=9F?=
+EOS
+
+is(Encode::decode('MIME-Header', $bheader), $dheader, "decode B");
+is(Encode::decode('MIME-Header', $qheader), $dheader, "decode Q");
+is(Encode::encode('MIME-B', $dheader)."\n", $bheader, "encode B");
+is(Encode::encode('MIME-Q', $dheader)."\n", $qheader, "encode Q");
+__END__;