summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorSteve Hay <steve.m.hay@googlemail.com>2012-08-09 12:51:05 +0100
committerSteve Hay <steve.m.hay@googlemail.com>2012-08-09 12:51:05 +0100
commit84678a67ca259ccbce00ff78d3f1e977efab9dcc (patch)
treec8b5ed091d1b0484a4803d3c5fcb9e5f17ab0df4 /cpan
parent62e824cfa5c39d1f0c3dd440e018928522eda88c (diff)
downloadperl-84678a67ca259ccbce00ff78d3f1e977efab9dcc.tar.gz
Upgrade Encode to 2.45
Diffstat (limited to 'cpan')
-rw-r--r--cpan/Encode/Changes25
-rw-r--r--cpan/Encode/Encode.pm177
-rw-r--r--cpan/Encode/MANIFEST1
-rw-r--r--cpan/Encode/META.json39
-rw-r--r--cpan/Encode/META.yml37
-rw-r--r--cpan/Encode/Unicode/Unicode.xs30
-rw-r--r--cpan/Encode/encoding.pm6
-rw-r--r--cpan/Encode/lib/Encode/Alias.pm5
-rw-r--r--cpan/Encode/lib/Encode/Encoder.pm2
-rw-r--r--cpan/Encode/lib/Encode/Unicode/UTF7.pm5
-rw-r--r--cpan/Encode/t/Unicode.t50
11 files changed, 261 insertions, 116 deletions
diff --git a/cpan/Encode/Changes b/cpan/Encode/Changes
index 54234214ca..f48a02f5cf 100644
--- a/cpan/Encode/Changes
+++ b/cpan/Encode/Changes
@@ -1,8 +1,29 @@
# Revision history for Perl extension Encode.
#
-# $Id: Changes,v 2.44 2011/08/09 07:49:44 dankogai Exp dankogai $
+# $Id: Changes,v 2.45 2012/08/05 23:08:49 dankogai Exp dankogai $
#
-$Revision: 2.44 $ $Date: 2011/08/09 07:49:44 $
+$Revision: 2.45 $ $Date: 2012/08/05 23:08:49 $
+! lib/Encode/Alias.pm
+ Addressed RT#78125: Missed Mac Alias x-mac-ce
+ https://rt.cpan.org/Ticket/Display.html?id=78125
+! lib/Encode/Unicode/UTF7.pm
+ Applied the patch in RT#76711
+ https://rt.cpan.org/Ticket/Display.html?id=76711
+! ucm/gsm0338.ucm
+ Addressed RT#75670: Wrong decoding for GSM 3.38 character \x09
+ https://rt.cpan.org/Ticket/Display.html?id=75670
+! Encode.pm
+ Applied the patch in RT#72519
+ https://rt.cpan.org/Ticket/Display.html?id=72519
+! Unicode/Unicode.xs
+ t/Unicode.t
+ Bug fixes in Unicode.xs by chansen
+ https://github.com/dankogai/p5-encode/pull/5
+! Encode.pm
+ various POD improvements by daxim
+ https://github.com/dankogai/p5-encode/pull/4
+
+2.44 2011/08/09 07:49:44
! Unicode/Unicode.xs
Addressed the following:
Date: Fri, 22 Jul 2011 13:58:43 +0200
diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm
index 171b2da056..ed3c6e387f 100644
--- a/cpan/Encode/Encode.pm
+++ b/cpan/Encode/Encode.pm
@@ -1,10 +1,10 @@
#
-# $Id: Encode.pm,v 2.44 2011/08/09 07:49:44 dankogai Exp dankogai $
+# $Id: Encode.pm,v 2.45 2012/08/05 23:08:49 dankogai Exp dankogai $
#
package Encode;
use strict;
use warnings;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.44 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.45 $ =~ /(\d+)/g;
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
use XSLoader ();
XSLoader::load( __PACKAGE__, $VERSION );
@@ -61,7 +61,7 @@ eval {
};
sub encodings {
- my $class = shift;
+ #my $class = shift;
my %enc;
if ( @_ and $_[0] eq ":all" ) {
%enc = ( %Encoding, %ExtModule );
@@ -247,7 +247,7 @@ sub predefine_encodings {
package Encode::UTF_EBCDIC;
push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding';
*decode = sub {
- my ( $obj, $str, $chk ) = @_;
+ my ( undef, $str, $chk ) = @_;
my $res = '';
for ( my $i = 0 ; $i < length($str) ; $i++ ) {
$res .=
@@ -259,7 +259,7 @@ sub predefine_encodings {
return $res;
};
*encode = sub {
- my ( $obj, $str, $chk ) = @_;
+ my ( undef, $str, $chk ) = @_;
my $res = '';
for ( my $i = 0 ; $i < length($str) ; $i++ ) {
$res .=
@@ -278,7 +278,7 @@ sub predefine_encodings {
package Encode::Internal;
push @Encode::Internal::ISA, 'Encode::Encoding';
*decode = sub {
- my ( $obj, $str, $chk ) = @_;
+ my ( undef, $str, $chk ) = @_;
utf8::upgrade($str);
$_[1] = '' if $chk;
return $str;
@@ -303,7 +303,7 @@ sub predefine_encodings {
else {
Encode::DEBUG and warn __PACKAGE__, " XS off";
*decode = sub {
- my ( $obj, $octets, $chk ) = @_;
+ my ( undef, $octets, $chk ) = @_;
my $str = Encode::decode_utf8($octets);
if ( defined $str ) {
$_[1] = '' if $chk;
@@ -312,7 +312,7 @@ sub predefine_encodings {
return undef;
};
*encode = sub {
- my ( $obj, $string, $chk ) = @_;
+ my ( undef, $string, $chk ) = @_;
my $octets = Encode::encode_utf8($string);
$_[1] = '' if $chk;
return $octets;
@@ -320,7 +320,7 @@ sub predefine_encodings {
}
*cat_decode = sub { # ($obj, $dst, $src, $pos, $trm, $chk)
# currently ignores $chk
- my ( $obj, undef, undef, $pos, $trm ) = @_;
+ my ( undef, undef, undef, $pos, $trm ) = @_;
my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
use bytes;
if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
@@ -351,7 +351,9 @@ Encode - character encodings in Perl
=head1 SYNOPSIS
- use Encode;
+ use Encode qw(decode encode);
+ $characters = decode('UTF-8', $octets, Encode::FB_CROAK);
+ $octets = encode('UTF-8', $characters, Encode::FB_CROAK);
=head2 Table of Contents
@@ -360,16 +362,23 @@ to fit in one document. This one itself explains the top-level APIs
and general topics at a glance. For other topics and more details,
see the documentation for these modules:
- Name Description
- --------------------------------------------------------
- Encode::Alias Alias definitions to encodings
- Encode::Encoding Encode Implementation Base Class
- Encode::Supported List of Supported Encodings
- Encode::CN Simplified Chinese Encodings
- Encode::JP Japanese Encodings
- Encode::KR Korean Encodings
- Encode::TW Traditional Chinese Encodings
- --------------------------------------------------------
+=over 2
+
+=item L<Encode::Alias> - Alias definitions to encodings
+
+=item L<Encode::Encoding> - Encode Implementation Base Class
+
+=item L<Encode::Supported> - List of Supported Encodings
+
+=item L<Encode::CN> - Simplified Chinese Encodings
+
+=item L<Encode::JP> - Japanese Encodings
+
+=item L<Encode::KR> - Korean Encodings
+
+=item L<Encode::TW> - Traditional Chinese Encodings
+
+=back
=head1 DESCRIPTION
@@ -396,32 +405,35 @@ process "sequences of bytes". This is not a problem for Perl: because a
byte has 256 possible values, it easily fits in Perl's much larger
"logical character".
-=head2 TERMINOLOGY
+This document mostly explains the I<how>. L<perlunitut> and L<perlunifaq>
+explain the I<why>.
-=over 2
+=head2 TERMINOLOGY
-=item *
+=head3 character
-I<character>: a character in the range 0 .. 2**32-1 (or more);
+A character in the range 0 .. 2**32-1 (or more);
what Perl's strings are made of.
-=item *
+=head3 byte
-I<byte>: a character in the range 0..255;
-A special case of a Perl character.
+A character in the range 0..255;
+a special case of a Perl character.
-=item *
+=head3 octet
-I<octet>: 8 bits of data, with ordinal values 0..255;
-Term for bytes passed to or from a non-Perl context, such as a disk file.
-
-=back
+8 bits of data, with ordinal values 0..255;
+term for bytes passed to or from a non-Perl context, such as a disk file,
+standard I/O stream, database, command-line argument, environment variable,
+socket etc.
=head1 THE PERL ENCODING API
-=over 2
+=head2 Basic methods
+
+=head3 encode
-=item $octets = encode(ENCODING, STRING[, CHECK])
+ $octets = encode(ENCODING, STRING[, CHECK])
Encodes the scalar value I<STRING> from Perl's internal form into
I<ENCODING> and returns a sequence of octets. I<ENCODING> can be either a
@@ -441,7 +453,9 @@ contains a completely valid utf8 string. See L</"The UTF8 flag"> below.
If the $string is C<undef>, then C<undef> is returned.
-=item $string = decode(ENCODING, OCTETS[, CHECK])
+=head3 decode
+
+ $string = decode(ENCODING, OCTETS[, CHECK])
This function returns the string that results from decoding the scalar
value I<OCTETS>, assumed to be a sequence of octets in I<ENCODING>, into
@@ -463,7 +477,9 @@ below.
If the $string is C<undef>, then C<undef> is returned.
-=item [$obj =] find_encoding(ENCODING)
+=head3 find_encoding
+
+ [$obj =] find_encoding(ENCODING)
Returns the I<encoding object> corresponding to I<ENCODING>. Returns
C<undef> if no matching I<ENCODING> is find. The returned object is
@@ -489,15 +505,17 @@ You can therefore save time by reusing this object as follows;
... # now do something with $utf8;
}
-Besides C<< ->decode >> and C<< ->encode >>, other methods are
-available as well. For instance, C<< ->name >> returns the canonical
+Besides L</decode> and L</encode>, other methods are
+available as well. For instance, C<name()> returns the canonical
name of the encoding object.
find_encoding("latin1")->name; # iso-8859-1
See L<Encode::Encoding> for details.
-=item [$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK])
+=head3 from_to
+
+ [$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK])
Converts I<in-place> data between two encodings. The data in $octets
must be encoded as octets and I<not> as characters in Perl's internal
@@ -513,7 +531,7 @@ and to convert it back:
Because the conversion happens in place, the data to be
converted cannot be a string constant: it must be a scalar variable.
-from_to() returns the length of the converted string in octets on success,
+C<from_to()> returns the length of the converted string in octets on success,
and C<undef> on error.
B<CAVEAT>: The following operations may look the same, but are not:
@@ -542,14 +560,18 @@ followed by C<encode> as follows:
$octets = encode($to, decode($from, $octets, $check_from), $check_to);
-=item $octets = encode_utf8($string);
+=head3 encode_utf8
+
+ $octets = encode_utf8($string);
Equivalent to C<$octets = encode("utf8", $string)>. The characters in
$string are encoded in Perl's internal format, and the result is returned
as a sequence of octets. Because all possible characters in Perl have a
(loose, not strict) UTF-8 representation, this function cannot fail.
-=item $string = decode_utf8($octets [, CHECK]);
+=head3 decode_utf8
+
+ $string = decode_utf8($octets [, CHECK]);
Equivalent to C<$string = decode("utf8", $octets [, CHECK])>.
The sequence of octets represented by $octets is decoded
@@ -558,8 +580,6 @@ Because not all sequences of octets are valid UTF-8,
it is quite possible for this function to fail.
For CHECK, see L</"Handling Malformed Data">.
-=back
-
=head2 Listing available encodings
use Encode;
@@ -591,7 +611,7 @@ To add a new alias to a given encoding, use:
define_alias(NEWNAME => ENCODING);
After that, I<NEWNAME> can be used as an alias for I<ENCODING>.
-<ENCODING> may be either the name of an encoding or an
+I<ENCODING> may be either the name of an encoding or an
I<encoding object>.
Before you do that, first make sure the alias is nonexistent using
@@ -602,7 +622,7 @@ For example:
Encode::resolve_alias("iso-8859-12") # false; nonexistent
Encode::resolve_alias($name) eq $name # true if $name is canonical
-resolve_alias() does not need C<use Encode::Alias>; it can be
+C<resolve_alias()> does not need C<use Encode::Alias>; it can be
imported via C<use Encode qw(resolve_alias)>.
See L<Encode::Alias> for details.
@@ -614,7 +634,7 @@ IANA Character Set Registry, commonly seen as C<< Content-Type:
text/plain; charset=I<WHATEVER> >>. For most cases, the canonical name
works, but sometimes it does not, most notably with "utf-8-strict".
-As of C<Encode> version 2.21, a new method C<mime_name()> is thereforeadded.
+As of C<Encode> version 2.21, a new method C<mime_name()> is therefore added.
use Encode;
my $enc = find_encoding("UTF-8");
@@ -668,7 +688,7 @@ C<perlio_ok> method on it:
perlio_ok("euc-jp")
Fortunately, all encodings that come with C<Encode> core are C<PerlIO>-savvy
-except for "hz" and "ISO-2022-kr". For the gory details, see
+except for C<hz> and C<ISO-2022-kr>. For the gory details, see
L<Encode::Encoding> and L<Encode::PerlIO>.
=head1 Handling Malformed Data
@@ -680,20 +700,15 @@ encountering malformed data. Without I<CHECK>, C<Encode::FB_DEFAULT>
As of version 2.12, C<Encode> supports coderef values for C<CHECK>;
see below.
-=over 2
-
-=item B<NOTE:> Not all encoding support this feature
-
-Some encodings ignore I<CHECK> argument. For example,
+B<NOTE:> Not all encodings support this feature.
+Some encodings ignore the I<CHECK> argument. For example,
L<Encode::Unicode> ignores I<CHECK> and it always croaks on error.
-=back
-
-Now here is the list of I<CHECK> values available
+=head2 List of I<CHECK> values
-=over 2
+=head3 FB_DEFAULT
-=item I<CHECK> = Encode::FB_DEFAULT ( == 0)
+ I<CHECK> = Encode::FB_DEFAULT ( == 0)
If I<CHECK> is 0, encoding and decoding replace any malformed character
with a I<substitution character>. When you encode, I<SUBCHAR> is used.
@@ -701,13 +716,17 @@ When you decode, the Unicode REPLACEMENT CHARACTER, code point U+FFFD, is
used. If the data is supposed to be UTF-8, an optional lexical warning of
warning category C<"utf8"> is given.
-=item I<CHECK> = Encode::FB_CROAK ( == 1)
+=head3 FB_CROAK
+
+ I<CHECK> = Encode::FB_CROAK ( == 1)
If I<CHECK> is 1, methods immediately die with an error
message. Therefore, when I<CHECK> is 1, you should trap
exceptions with C<eval{}>, unless you really want to let it C<die>.
-=item I<CHECK> = Encode::FB_QUIET
+=head3 FB_QUIET
+
+ I<CHECK> = Encode::FB_QUIET
If I<CHECK> is set to C<Encode::FB_QUIET>, encoding and decoding immediately
return the portion of the data that has been processed so far when an
@@ -724,17 +743,25 @@ code to do exactly that:
# $buffer now contains the unprocessed partial character
}
-=item I<CHECK> = Encode::FB_WARN
+=head3 FB_WARN
+
+ I<CHECK> = Encode::FB_WARN
This is the same as C<FB_QUIET> above, except that instead of being silent
on errors, it issues a warning. This is handy for when you are debugging.
+=head3 FB_PERLQQ FB_HTMLCREF FB_XMLCREF
+
+=over 2
+
=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)
+=back
+
For encodings that are implemented by the C<Encode::XS> module, C<CHECK> C<==>
C<Encode::FB_PERLQQ> puts C<encode> and C<decode> into C<perlqq> fallback mode.
@@ -750,7 +777,7 @@ XML uses C<&#xI<HHHH>;> where I<HHHH> is the hexadecimal number.
In C<Encode> 2.10 or later, C<LEAVE_SRC> is also implied.
-=item The bitmask
+=head3 The bitmask
These modes are all actually set via a bitmask. Here is how the C<FB_I<XXX>>
constants are laid out. You can import the C<FB_I<XXX>> constants via
@@ -766,22 +793,18 @@ constants via C<use Encode qw(:fallback_all)>.
HTMLCREF 0x0200
XMLCREF 0x0400
-=back
-
-=over 2
+=head3 LEAVE_SRC
-=item Encode::LEAVE_SRC
+ Encode::LEAVE_SRC
If the C<Encode::LEAVE_SRC> bit is I<not> set but I<CHECK> is set, then the
second argument to encode() or decode() will be overwritten in place.
If you're not interested in this, then bitwise-OR it with the bitmask.
-=back
-
=head2 coderef for CHECK
As of C<Encode> 2.12, C<CHECK> can also be a code reference which takes the
-ordinal value of the unmapped caharacter as an argument and returns a string
+ordinal value of the unmapped character as an argument and returns a string
that represents the fallback character. For instance:
$ascii = encode("ascii", $utf8, sub{ sprintf "<U+%04X>", shift });
@@ -880,9 +903,9 @@ The following API uses parts of Perl's internals in the current
implementation. As such, they are efficient but may change in a future
release.
-=over 2
+=head3 is_utf8
-=item is_utf8(STRING [, CHECK])
+ is_utf8(STRING [, CHECK])
[INTERNAL] Tests whether the UTF8 flag is turned on in the I<STRING>.
If I<CHECK> is true, also checks whether I<STRING> contains well-formed
@@ -890,7 +913,9 @@ UTF-8. Returns true if successful, false otherwise.
As of Perl 5.8.1, L<utf8> also has the C<utf8::is_utf8> function.
-=item _utf8_on(STRING)
+=head3 _utf8_on
+
+ _utf8_on(STRING)
[INTERNAL] Turns the I<STRING>'s internal UTF8 flag B<on>. The I<STRING>
is I<not> checked for containing only well-formed UTF-8. Do not use this
@@ -901,7 +926,9 @@ if I<STRING> is not a string.
B<NOTE>: For security reasons, this function does not work on tainted values.
-=item _utf8_off(STRING)
+=head3 _utf8_off
+
+ _utf8_off(STRING)
[INTERNAL] Turns the I<STRING>'s internal UTF8 flag B<off>. Do not use
frivolously. Returns the previous state of the UTF8 flag, or C<undef> if
@@ -911,8 +938,6 @@ previous setting.
B<NOTE>: For security reasons, this function does not work on tainted values.
-=back
-
=head1 UTF-8 vs. utf8 vs. UTF8
....We now view strings not as sequences of bytes, but as sequences
@@ -981,7 +1006,7 @@ L<perlebcdic>,
L<perlfunc/open>,
L<perlunicode>, L<perluniintro>, L<perlunifaq>, L<perlunitut>
L<utf8>,
-the Perl Unicode Mailing List E<lt>perl-unicode@perl.orgE<gt>
+the Perl Unicode Mailing List L<http://lists.perl.org/list/perl-unicode.html>
=head1 MAINTAINER
diff --git a/cpan/Encode/MANIFEST b/cpan/Encode/MANIFEST
index 3fe6582a22..830cebcc6b 100644
--- a/cpan/Encode/MANIFEST
+++ b/cpan/Encode/MANIFEST
@@ -202,3 +202,4 @@ ucm/posix-bc.ucm Unicode Character Map
ucm/shiftjis.ucm Unicode Character Map
ucm/symbol.ucm Unicode Character Map
ucm/viscii.ucm Unicode Character Map
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/cpan/Encode/META.json b/cpan/Encode/META.json
new file mode 100644
index 0000000000..d35ca3f070
--- /dev/null
+++ b/cpan/Encode/META.json
@@ -0,0 +1,39 @@
+{
+ "abstract" : "unknown",
+ "author" : [
+ "unknown"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Encode",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {}
+ }
+ },
+ "release_status" : "stable",
+ "version" : "2.45"
+}
diff --git a/cpan/Encode/META.yml b/cpan/Encode/META.yml
index d73458f7bd..bcd3f7b204 100644
--- a/cpan/Encode/META.yml
+++ b/cpan/Encode/META.yml
@@ -1,20 +1,21 @@
---- #YAML:1.0
-name: Encode
-version: 2.44
-abstract: ~
-author: []
-license: unknown
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+---
+abstract: unknown
+author:
+ - unknown
build_requires:
- ExtUtils::MakeMaker: 0
-requires: {}
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.57_05
+ ExtUtils::MakeMaker: 0
+configure_requires:
+ ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921'
+license: unknown
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Encode
+no_index:
+ directory:
+ - t
+ - inc
+requires: {}
+version: 2.45
diff --git a/cpan/Encode/Unicode/Unicode.xs b/cpan/Encode/Unicode/Unicode.xs
index 039f1559a3..84dfd46436 100644
--- a/cpan/Encode/Unicode/Unicode.xs
+++ b/cpan/Encode/Unicode/Unicode.xs
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 2.8 2011/08/09 07:49:44 dankogai Exp dankogai $
+ $Id: Unicode.xs,v 2.9 2012/08/05 23:08:49 dankogai Exp dankogai $
*/
#define PERL_NO_GET_CONTEXT
@@ -199,10 +199,6 @@ CODE:
*hv_fetch((HV *)SvRV(obj),"Name",4,0),
ord);
}
- if (s+size <= e) {
- /* skip the next one as well */
- enc_unpack(aTHX_ &s,e,size,endian);
- }
ord = FBCHAR;
}
else {
@@ -217,12 +213,23 @@ CODE:
ord = FBCHAR;
}
}
- else {
- if (s+size > e) {
- /* Partial character */
- s -= size; /* back up to 1st half */
- break; /* And exit loop */
+ else if (s+size > e) {
+ if (check) {
+ if (check & ENCODE_STOP_AT_PARTIAL) {
+ s -= size;
+ break;
+ }
+ else {
+ croak("%"SVf":Malformed HI surrogate %"UVxf,
+ *hv_fetch((HV *)SvRV(obj),"Name",4,0),
+ ord);
+ }
}
+ else {
+ ord = FBCHAR;
+ }
+ }
+ else {
lo = enc_unpack(aTHX_ &s,e,size,endian);
if (!isLoSurrogate(lo)) {
if (check) {
@@ -231,6 +238,7 @@ CODE:
ord);
}
else {
+ s -= size;
ord = FBCHAR;
}
}
@@ -348,7 +356,7 @@ CODE:
if (ucs2 == -1) {
ucs2 = SvTRUE(attr("ucs2", 4));
}
- if (ucs2) {
+ if (ucs2 || ord > 0x10FFFF) {
if (check) {
croak("%"SVf":code point \"\\x{%"UVxf"}\" too high",
*hv_fetch((HV *)SvRV(obj),"Name",4,0),ord);
diff --git a/cpan/Encode/encoding.pm b/cpan/Encode/encoding.pm
index 24d6e5b66c..b5335ea37c 100644
--- a/cpan/Encode/encoding.pm
+++ b/cpan/Encode/encoding.pm
@@ -1,4 +1,4 @@
-# $Id: encoding.pm,v 2.9 2011/08/09 07:49:44 dankogai Exp dankogai $
+# $Id: encoding.pm,v 2.10 2012/08/05 23:08:49 dankogai Exp dankogai $
package encoding;
our $VERSION = '2.6_01';
@@ -104,6 +104,10 @@ sub _get_locale_encoding {
sub import {
my $class = shift;
my $name = shift;
+ if (!$name){
+ require Carp;
+ Carp::croak("encoding: no encoding specified.");
+ }
if ( $name eq ':_get_locale_encoding' ) { # used by lib/open.pm
my $caller = caller();
{
diff --git a/cpan/Encode/lib/Encode/Alias.pm b/cpan/Encode/lib/Encode/Alias.pm
index d744cc5e93..9e15fe3c8c 100644
--- a/cpan/Encode/lib/Encode/Alias.pm
+++ b/cpan/Encode/lib/Encode/Alias.pm
@@ -2,7 +2,7 @@ package Encode::Alias;
use strict;
use warnings;
no warnings 'redefine';
-our $VERSION = do { my @r = ( q$Revision: 2.15 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
+our $VERSION = do { my @r = ( q$Revision: 2.16 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
use base qw(Exporter);
@@ -209,7 +209,8 @@ sub init_aliases {
define_alias( qr/^(?:x[_-])?mac[_-](.*)$/i => '"mac$1"' );
# http://rt.cpan.org/Ticket/Display.html?id=36326
define_alias( qr/^macintosh$/i => '"MacRoman"' );
-
+ # https://rt.cpan.org/Ticket/Display.html?id=78125
+ define_alias( qr/^macce$/i => '"MacCentralEurRoman"' );
# Ououououou. gone. They are differente!
# define_alias( qr/\bmacRomanian$/i => '"macRumanian"');
diff --git a/cpan/Encode/lib/Encode/Encoder.pm b/cpan/Encode/lib/Encode/Encoder.pm
index 9a46d36743..2cde1e865f 100644
--- a/cpan/Encode/lib/Encode/Encoder.pm
+++ b/cpan/Encode/lib/Encode/Encoder.pm
@@ -1,5 +1,5 @@
#
-# $Id: Encoder.pm,v 2.2 2011/08/09 07:49:44 dankogai Exp dankogai $
+# $Id: Encoder.pm,v 2.2 2011/08/09 07:49:44 dankogai Exp $
#
package Encode::Encoder;
use strict;
diff --git a/cpan/Encode/lib/Encode/Unicode/UTF7.pm b/cpan/Encode/lib/Encode/Unicode/UTF7.pm
index 1d63962754..2e0e4d174a 100644
--- a/cpan/Encode/lib/Encode/Unicode/UTF7.pm
+++ b/cpan/Encode/lib/Encode/Unicode/UTF7.pm
@@ -1,5 +1,5 @@
#
-# $Id: UTF7.pm,v 2.5 2010/09/18 18:39:51 dankogai Exp $
+# $Id: UTF7.pm,v 2.6 2012/08/05 23:08:49 dankogai Exp dankogai $
#
package Encode::Unicode::UTF7;
use strict;
@@ -7,7 +7,7 @@ use warnings;
no warnings 'redefine';
use base qw(Encode::Encoding);
__PACKAGE__->Define('UTF-7');
-our $VERSION = do { my @r = ( q$Revision: 2.5 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
+our $VERSION = do { my @r = ( q$Revision: 2.6 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
use MIME::Base64;
use Encode;
@@ -62,6 +62,7 @@ sub decode($$;$) {
my ( $obj, $bytes, $chk ) = @_;
my $len = length($bytes);
my $str = "";
+ pos($bytes) = 0;
no warnings 'uninitialized';
while ( pos($bytes) < $len ) {
if ( $bytes =~ /\G([^+]+)/ogc ) {
diff --git a/cpan/Encode/t/Unicode.t b/cpan/Encode/t/Unicode.t
index baa502c1f9..b86ed06987 100644
--- a/cpan/Encode/t/Unicode.t
+++ b/cpan/Encode/t/Unicode.t
@@ -1,5 +1,5 @@
#
-# $Id: Unicode.t,v 2.2 2009/11/16 14:08:13 dankogai Exp $
+# $Id: Unicode.t,v 2.3 2012/08/05 23:08:49 dankogai Exp dankogai $
#
# This script is written entirely in ASCII, even though quoted literals
# do include non-BMP unicode characters -- Are you happy, jhi?
@@ -20,7 +20,7 @@ BEGIN {
use strict;
#use Test::More 'no_plan';
-use Test::More tests => 38;
+use Test::More tests => 56;
use Encode qw(encode decode find_encoding);
#
@@ -30,7 +30,7 @@ use Encode qw(encode decode find_encoding);
my $dankogai = "\x{5c0f}\x{98fc}\x{3000}\x{5f3e}";
my $nasty = "$dankogai\x{1abcd}";
-my $fallback = "$dankogai\x{fffd}";
+my $fallback = "$dankogai\x{fffd}\x{fffd}";
#hi: (0x1abcd - 0x10000) / 0x400 + 0xD800 = 0xd82a
#lo: (0x1abcd - 0x10000) % 0x400 + 0xDC00 = 0xdfcd
@@ -85,6 +85,50 @@ is(index($@, 'UCS-2BE'), 0, "encode UCS-2BE: exception");
eval { encode('UCS-2LE', $nasty, 1) };
is(index($@, 'UCS-2LE'), 0, "encode UCS-2LE: exception");
+{
+ my %tests = (
+ 'UCS-2BE' => 'n*',
+ 'UCS-2LE' => 'v*',
+ 'UTF-16BE' => 'n*',
+ 'UTF-16LE' => 'v*',
+ 'UTF-32BE' => 'N*',
+ 'UTF-32LE' => 'V*',
+ );
+
+ while (my ($enc, $pack) = each(%tests)) {
+ is(decode($enc, pack($pack, 0xD800, 0x263A)), "\x{FFFD}\x{263A}",
+ "decode $enc (HI surrogate followed by WHITE SMILING FACE)");
+ is(decode($enc, pack($pack, 0xDC00, 0x263A)), "\x{FFFD}\x{263A}",
+ "decode $enc (LO surrogate followed by WHITE SMILING FACE)");
+ }
+}
+
+{
+ my %tests = (
+ 'UTF-16BE' => 'n*',
+ 'UTF-16LE' => 'v*',
+ );
+
+ while (my ($enc, $pack) = each(%tests)) {
+ is(decode($enc, pack($pack, 0xD800)), "\x{FFFD}",
+ "decode $enc (HI surrogate)");
+ is(decode($enc, pack($pack, 0x263A, 0xD800)), "\x{263A}\x{FFFD}",
+ "decode $enc (WHITE SMILING FACE followed by HI surrogate)");
+ }
+}
+
+{
+ my %tests = (
+ 'UTF-16BE' => 'n*',
+ 'UTF-16LE' => 'v*',
+ );
+
+ while (my ($enc, $pack) = each(%tests)) {
+ is(encode($enc, "\x{110000}"), pack($pack, 0xFFFD),
+ "ordinals greater than U+10FFFF is replaced with U+FFFD");
+ }
+}
+
#
# SvGROW test for (en|de)code_xs
#