#
# $Id: Encode.pm,v 3.06 2020/05/02 02:31:14 dankogai Exp $
#
package Encode;
use strict;
use warnings;
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
our $VERSION;
BEGIN {
$VERSION = sprintf "%d.%02d", q$Revision: 3.06 $ =~ /(\d+)/g;
require XSLoader;
XSLoader::load( __PACKAGE__, $VERSION );
}
use Exporter 5.57 'import';
use Carp ();
our @CARP_NOT = qw(Encode::Encoder);
# Public, encouraged API is exported by default
our @EXPORT = qw(
decode decode_utf8 encode encode_utf8 str2bytes bytes2str
encodings find_encoding find_mime_encoding clone_encoding
);
our @FB_FLAGS = qw(
DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
);
our @FB_CONSTS = qw(
FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
FB_PERLQQ FB_HTMLCREF FB_XMLCREF
);
our @EXPORT_OK = (
qw(
_utf8_off _utf8_on define_encoding from_to is_16bit is_8bit
is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade
),
@FB_FLAGS, @FB_CONSTS,
);
our %EXPORT_TAGS = (
all => [ @EXPORT, @EXPORT_OK ],
default => [ @EXPORT ],
fallbacks => [ @FB_CONSTS ],
fallback_all => [ @FB_CONSTS, @FB_FLAGS ],
);
# Documentation moved after __END__ for speed - NI-S
our $ON_EBCDIC = ( ord("A") == 193 );
use Encode::Alias ();
use Encode::MIME::Name;
use Storable;
# Make a %Encoding package variable to allow a certain amount of cheating
our %Encoding;
our %ExtModule;
require Encode::Config;
# See
# https://bugzilla.redhat.com/show_bug.cgi?id=435505#c2
# to find why sig handlers inside eval{} are disabled.
eval {
local $SIG{__DIE__};
local $SIG{__WARN__};
local @INC = @INC || ();
pop @INC if $INC[-1] eq '.';
require Encode::ConfigLocal;
};
sub encodings {
my %enc;
my $arg = $_[1] || '';
if ( $arg eq ":all" ) {
%enc = ( %Encoding, %ExtModule );
}
else {
%enc = %Encoding;
for my $mod ( map { m/::/ ? $_ : "Encode::$_" } @_ ) {
DEBUG and warn $mod;
for my $enc ( keys %ExtModule ) {
$ExtModule{$enc} eq $mod and $enc{$enc} = $mod;
}
}
}
return sort { lc $a cmp lc $b }
grep { !/^(?:Internal|Unicode|Guess)$/o } keys %enc;
}
sub perlio_ok {
my $obj = ref( $_[0] ) ? $_[0] : find_encoding( $_[0] );
$obj->can("perlio_ok") and return $obj->perlio_ok();
return 0; # safety net
}
sub define_encoding {
my $obj = shift;
my $name = shift;
$Encoding{$name} = $obj;
my $lc = lc($name);
define_alias( $lc => $obj ) unless $lc eq $name;
while (@_) {
my $alias = shift;
define_alias( $alias, $obj );
}
my $class = ref($obj);
push @Encode::CARP_NOT, $class unless grep { $_ eq $class } @Encode::CARP_NOT;
push @Encode::Encoding::CARP_NOT, $class unless grep { $_ eq $class } @Encode::Encoding::CARP_NOT;
return $obj;
}
sub getEncoding {
my ( $class, $name, $skip_external ) = @_;
defined($name) or return;
$name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796
ref($name) && $name->can('renew') and return $name;
exists $Encoding{$name} and return $Encoding{$name};
my $lc = lc $name;
exists $Encoding{$lc} and return $Encoding{$lc};
my $oc = $class->find_alias($name);
defined($oc) and return $oc;
$lc ne $name and $oc = $class->find_alias($lc);
defined($oc) and return $oc;
unless ($skip_external) {
if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) {
$mod =~ s,::,/,g;
$mod .= '.pm';
eval { require $mod; };
exists $Encoding{$name} and return $Encoding{$name};
}
}
return;
}
# HACK: These two functions must be defined in Encode and because of
# cyclic dependency between Encode and Encode::Alias, Exporter does not work
sub find_alias {
goto &Encode::Alias::find_alias;
}
sub define_alias {
goto &Encode::Alias::define_alias;
}
sub find_encoding($;$) {
my ( $name, $skip_external ) = @_;
return __PACKAGE__->getEncoding( $name, $skip_external );
}
sub find_mime_encoding($;$) {
my ( $mime_name, $skip_external ) = @_;
my $name = Encode::MIME::Name::get_encode_name( $mime_name );
return find_encoding( $name, $skip_external );
}
sub resolve_alias($) {
my $obj = find_encoding(shift);
defined $obj and return $obj->name;
return;
}
sub clone_encoding($) {
my $obj = find_encoding(shift);
ref $obj or return;
return Storable::dclone($obj);
}
onBOOT;
if ($ON_EBCDIC) {
package Encode::UTF_EBCDIC;
use parent 'Encode::Encoding';
my $obj = bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC";
Encode::define_encoding($obj, 'Unicode');
sub decode {
my ( undef, $str, $chk ) = @_;
my $res = '';
for ( my $i = 0 ; $i "Internal" } => "Encode::Internal";
Encode::define_encoding($obj, 'Unicode');
sub decode {
my ( undef, $str, $chk ) = @_;
utf8::upgrade($str);
$_[1] = '' if $chk;
return $str;
}
*encode = \&decode;
}
{
# https://rt.cpan.org/Public/Bug/Display.html?id=103253
package Encode::XS;
use parent 'Encode::Encoding';
}
{
package Encode::utf8;
use parent 'Encode::Encoding';
my %obj = (
'utf8' => { Name => 'utf8' },
'utf-8-strict' => { Name => 'utf-8-strict', strict_utf8 => 1 }
);
for ( keys %obj ) {
bless $obj{$_} => __PACKAGE__;
Encode::define_encoding( $obj{$_} => $_ );
}
sub cat_decode {
# ($obj, $dst, $src, $pos, $trm, $chk)
# currently ignores $chk
my ( undef, undef, undef, $pos, $trm ) = @_;
my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
use bytes;
if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
$$rdst .=
substr( $$rsrc, $pos, $npos - $pos + length($trm) );
$$rpos = $npos + length($trm);
return 1;
}
$$rdst .= substr( $$rsrc, $pos );
$$rpos = length($$rsrc);
return '';
}
}
1;
__END__
=head1 NAME
Encode - character encodings in Perl
=head1 SYNOPSIS
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
Encode consists of a collection of modules whose details are too extensive
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:
=over 2
=item L<:alias> - Alias definitions to encodings
=item L<:encoding> - Encode Implementation Base Class
=item L<:supported> - List of Supported Encodings
=item L<:cn> - Simplified Chinese Encodings
=item L<:jp> - Japanese Encodings
=item L<:kr> - Korean Encodings
=item L<:tw> - Traditional Chinese Encodings
=back
=head1 DESCRIPTION
The C module provides the interface between Perl strings
and the rest of the system. Perl strings are sequences of
I.
The repertoire of characters that Perl can represent is a superset of those
defined by the Unicode Consortium. On most platforms the ordinal
values of a character as returned by C)> is the I for that character. The exceptions are platforms where
the legacy encoding is some variant of EBCDIC rather than a superset
of ASCII; see L.
During recent history, data is moved around a computer in 8-bit chunks,
often called "bytes" but also known as "octets" in standards documents.
Perl is widely used to manipulate data of many types: not only strings of
characters representing human or computer languages, but also "binary"
data, being the machine's representation of numbers, pixels in an image, or
just about anything.
When Perl is processing "binary data", the programmer wants Perl to
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".
This document mostly explains the I. L and L
explain the I.
=head2 TERMINOLOGY
=head3 character
A character in the range 0 .. 2**32-1 (or more);
what Perl's strings are made of.
=head3 byte
A character in the range 0..255;
a special case of a Perl character.
=head3 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,
standard I/O stream, database, command-line argument, environment variable,
socket etc.
=head1 THE PERL ENCODING API
=head2 Basic methods
=head3 encode
$octets = encode(ENCODING, STRING[, CHECK])
Encodes the scalar value I from Perl's internal form into
I and returns a sequence of octets. I can be either a
canonical name or an alias. For encoding names and aliases, see
L"Defining Aliases">. For CHECK, see L"Handling Malformed Data">.
B: the input scalar I might be modified in-place depending
on what is set in CHECK. See L if you want your inputs to be
left unchanged.
For example, to convert a string from Perl's internal format into
ISO-8859-1, also known as Latin1:
$octets = encode("iso-8859-1", $string);
B: When you run C, then
$octets I $string. Though both contain the
same data, the UTF8 flag for $octets is I off. When you
encode anything, the UTF8 flag on the result is always off, even when it
contains a completely valid UTF-8 string. See L"The UTF8 flag"> below.
If the $string is C, then C is returned.
C may be used as an alias for C.
=head3 decode
$string = decode(ENCODING, OCTETS[, CHECK])
This function returns the string that results from decoding the scalar
value I, assumed to be a sequence of octets in I, into
Perl's internal form. As with encode(),
I can be either a canonical name or an alias. For encoding names
and aliases, see L"Defining Aliases">; for I, see L"Handling
Malformed Data">.
B: the input scalar I might be modified in-place depending
on what is set in CHECK. See L if you want your inputs to be
left unchanged.
For example, to convert ISO-8859-1 data into a string in Perl's
internal format:
$string = decode("iso-8859-1", $octets);
B: When you run C, then $string
I $octets. Though both contain the same data, the
UTF8 flag for $string is on. See L"The UTF8 flag">
below.
If the $string is C, then C is returned.
C may be used as an alias for C.
=head3 find_encoding
[$obj =] find_encoding(ENCODING)
Returns the I corresponding to I. Returns
C if no matching I is find. The returned object is
what does the actual encoding or decoding.
$string = decode($name, $bytes);
is in fact
$string = do {
$obj = find_encoding($name);
croak qq(encoding "$name" not found) unless ref $obj;
$obj->decode($bytes);
};
with more error checking.
You can therefore save time by reusing this object as follows;
my $enc = find_encoding("iso-8859-1");
while() {
my $string = $enc->decode($_);
... # now do something with $string;
}
Besides L and L, other methods are
available as well. For instance, C returns the canonical
name of the encoding object.
find_encoding("latin1")->name; # iso-8859-1
See L<:encoding> for details.
=head3 find_mime_encoding
[$obj =] find_mime_encoding(MIME_ENCODING)
Returns the I corresponding to I. Acts
same as C but C of returned object must
match to I. So as opposite of C
canonical names and aliases are not used when searching for object.
find_mime_encoding("utf8"); # returns undef because "utf8" is not valid I
find_mime_encoding("utf-8"); # returns encode object "utf-8-strict"
find_mime_encoding("UTF-8"); # same as "utf-8" because I is case insensitive
find_mime_encoding("utf-8-strict"); returns undef because "utf-8-strict" is not valid I
=head3 from_to
[$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK])
Converts I data between two encodings. The data in $octets
must be encoded as octets and I as characters in Perl's internal
format. For example, to convert ISO-8859-1 data into Microsoft's CP1250
encoding:
from_to($octets, "iso-8859-1", "cp1250");
and to convert it back:
from_to($octets, "cp1250", "iso-8859-1");
Because the conversion happens in place, the data to be
converted cannot be a string constant: it must be a scalar variable.
C returns the length of the converted string in octets on success,
and C on error.
B: The following operations may look the same, but are not:
from_to($data, "iso-8859-1", "UTF-8"); #1
$data = decode("iso-8859-1", $data); #2
Both #1 and #2 make $data consist of a completely valid UTF-8 string,
but only #2 turns the UTF8 flag on. #1 is equivalent to:
$data = encode("UTF-8", decode("iso-8859-1", $data));
See L"The UTF8 flag"> below.
Also note that:
from_to($octets, $from, $to, $check);
is equivalent to:
$octets = encode($to, decode($from, $octets), $check);
Yes, it does I respect the $check during decoding. It is
deliberately done that way. If you need minute control, use C
followed by C as follows:
$octets = encode($to, decode($from, $octets, $check_from), $check_to);
=head3 encode_utf8
$octets = encode_utf8($string);
Equivalent to C. 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) utf8 representation, this function cannot fail.
B: do not use this function for data exchange as it can produce
not strict utf8 $octets! For strictly valid UTF-8 output use
C.
=head3 decode_utf8
$string = decode_utf8($octets [, CHECK]);
Equivalent to C.
The sequence of octets represented by $octets is decoded
from (loose, not strict) utf8 into a sequence of logical characters.
Because not all sequences of octets are valid not strict utf8,
it is quite possible for this function to fail.
For CHECK, see L"Handling Malformed Data">.
B: do not use this function for data exchange as it can produce
$string with not strict utf8 representation! For strictly valid UTF-8
$string representation use C.
B: the input I might be modified in-place depending on
what is set in CHECK. See L if you want your inputs to be
left unchanged.
=head2 Listing available encodings
use Encode;
@list = Encode->encodings();
Returns a list of canonical names of available encodings that have already
been loaded. To get a list of all available encodings including those that
have not yet been loaded, say:
@all_encodings = Encode->encodings(":all");
Or you can give the name of a specific module:
@with_jp = Encode->encodings("Encode::JP");
When "C<::>" is not in the name, "C<:>" is assumed.
@ebcdic = Encode->encodings("EBCDIC");
To find out in detail which encodings are supported by this package,
see L<:supported>.
=head2 Defining Aliases
To add a new alias to a given encoding, use:
use Encode;
use Encode::Alias;
define_alias(NEWNAME => ENCODING);
After that, I can be used as an alias for I.
I may be either the name of an encoding or an
I.
Before you do that, first make sure the alias is nonexistent using
C, which returns the canonical name thereof.
For example:
Encode::resolve_alias("latin1") eq "iso-8859-1" # true
Encode::resolve_alias("iso-8859-12") # false; nonexistent
Encode::resolve_alias($name) eq $name # true if $name is canonical
C does not need C