ext/Encode/Encode.pm

   1 package Encode;
   2 use strict;
   3 our $VERSION = do { my @r = (q$Revision: 1.31 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
   4 our $DEBUG = 0;
   5
   6 require DynaLoader;
   7 require Exporter;
   8
   9 our @ISA = qw(Exporter DynaLoader);
  10
  11 # Public, encouraged API is exported by default
  12 our @EXPORT = qw (
  13   encode
  14   decode
  15   encode_utf8
  16   decode_utf8
  17   find_encoding
  18   encodings
  19 );
  20
  21 our @EXPORT_OK =
  22     qw(
  23        define_encoding
  24        from_to
  25        is_utf8
  26        is_8bit
  27        is_16bit
  28        utf8_upgrade
  29        utf8_downgrade
  30        _utf8_on
  31        _utf8_off
  32       );
  33
  34 bootstrap Encode ();
  35
  36 # Documentation moved after __END__ for speed - NI-S
  37
  38 use Carp;
  39
  40 our $ON_EBCDIC = (ord("A") == 193);
  41
  42 use Encode::Alias;
  43
  44 # Make a %Encoding package variable to allow a certain amount of cheating
  45 our %Encoding;
  46 use Encode::Config;
  47
  48 sub encodings
  49 {
  50     my $class = shift;
  51     my @modules = (@_ and $_[0] eq ":all") ? values %ExtModule : @_;
  52     for my $mod (@modules){
  53         $mod =~ s,::,/,g or $mod = "Encode/$mod";
  54         $mod .= '.pm';
  55         $DEBUG and warn "about to require $mod;";
  56         eval { require $mod; };
  57     }
  58     my %modules = map {$_ => 1} @modules;
  59     return
  60         sort { lc $a cmp lc $b }
  61              grep {!/^(?:Internal|Unicode)$/o} keys %Encoding;
  62 }
  63
  64 sub define_encoding
  65 {
  66     my $obj  = shift;
  67     my $name = shift;
  68     $Encoding{$name} = $obj;
  69     my $lc = lc($name);
  70     define_alias($lc => $obj) unless $lc eq $name;
  71     while (@_)
  72     {
  73         my $alias = shift;
  74         define_alias($alias,$obj);
  75     }
  76     return $obj;
  77 }
  78
  79 sub getEncoding
  80 {
  81     my ($class,$name,$skip_external) = @_;
  82     my $enc;
  83     if (ref($name) && $name->can('new_sequence'))
  84     {
  85         return $name;
  86     }
  87     my $lc = lc $name;
  88     if (exists $Encoding{$name})
  89     {
  90         return $Encoding{$name};
  91     }
  92     if (exists $Encoding{$lc})
  93     {
  94         return $Encoding{$lc};
  95     }
  96
  97     my $oc = $class->find_alias($name);
  98     return $oc if defined $oc;
  99
 100     $oc = $class->find_alias($lc) if $lc ne $name;
 101     return $oc if defined $oc;
 102
 103     unless ($skip_external)
 104     {
 105         if (my $mod = $ExtModule{$name} || $ExtModule{$lc}){
 106             $mod =~ s,::,/,g ; $mod .= '.pm';
 107             eval{ require $mod; };
 108             return $Encoding{$name} if exists $Encoding{$name};
 109         }
 110     }
 111     return;
 112 }
 113
 114 sub find_encoding
 115 {
 116     my ($name,$skip_external) = @_;
 117     return __PACKAGE__->getEncoding($name,$skip_external);
 118 }
 119
 120 sub encode
 121 {
 122     my ($name,$string,$check) = @_;
 123     my $enc = find_encoding($name);
 124     croak("Unknown encoding '$name'") unless defined $enc;
 125     my $octets = $enc->encode($string,$check);
 126     return undef if ($check && length($string));
 127     return $octets;
 128 }
 129
 130 sub decode
 131 {
 132     my ($name,$octets,$check) = @_;
 133     my $enc = find_encoding($name);
 134     croak("Unknown encoding '$name'") unless defined $enc;
 135     my $string = $enc->decode($octets,$check);
 136     $_[1] = $octets if $check;
 137     return $string;
 138 }
 139
 140 sub from_to
 141 {
 142     my ($string,$from,$to,$check) = @_;
 143     my $f = find_encoding($from);
 144     croak("Unknown encoding '$from'") unless defined $f;
 145     my $t = find_encoding($to);
 146     croak("Unknown encoding '$to'") unless defined $t;
 147     my $uni = $f->decode($string,$check);
 148     return undef if ($check && length($string));
 149     $string =  $t->encode($uni,$check);
 150     return undef if ($check && length($uni));
 151     return defined($_[0] = $string) ? length($string) : undef ;
 152 }
 153
 154 sub encode_utf8
 155 {
 156     my ($str) = @_;
 157     utf8::encode($str);
 158     return $str;
 159 }
 160
 161 sub decode_utf8
 162 {
 163     my ($str) = @_;
 164     return undef unless utf8::decode($str);
 165     return $str;
 166 }
 167
 168 predefine_encodings();
 169
 170 #
 171 # This is to restore %Encoding if really needed;
 172 #
 173 sub predefine_encodings{
 174     if ($ON_EBCDIC) {
 175         # was in Encode::UTF_EBCDIC
 176         package Encode::UTF_EBCDIC;
 177         *name         = sub{ shift->{'Name'} };
 178         *new_sequence = sub{ return $_[0] };
 179         *decode = sub{
 180             my ($obj,$str,$chk) = @_;
 181             my $res = '';
 182             for (my $i = 0; $i < length($str); $i++) {
 183                 $res .=
 184                     chr(utf8::unicode_to_native(ord(substr($str,$i,1))));
 185             }
 186             $_[1] = '' if $chk;
 187             return $res;
 188         };
 189         *encode = sub{
 190             my ($obj,$str,$chk) = @_;
 191             my $res = '';
 192             for (my $i = 0; $i < length($str); $i++) {
 193                 $res .=
 194                     chr(utf8::native_to_unicode(ord(substr($str,$i,1))));
 195             }
 196             $_[1] = '' if $chk;
 197             return $res;
 198         };
 199         $Encode::Encoding{Internal} =
 200             bless {Name => "UTF_EBCDIC"} => "Encode::UTF_EBCDIC";
 201     } else {
 202         # was in Encode::UTF_EBCDIC
 203         package Encode::Internal;
 204         *name         = sub{ shift->{'Name'} };
 205         *new_sequence = sub{ return $_[0] };
 206         *decode = sub{
 207             my ($obj,$str,$chk) = @_;
 208             utf8::upgrade($str);
 209             $_[1] = '' if $chk;
 210             return $str;
 211         };
 212         *encode = \&decode;
 213         $Encode::Encoding{Unicode} =
 214             bless {Name => "Internal"} => "Encode::Internal";
 215     }
 216
 217     {
 218         # was in Encode::utf8
 219         package Encode::utf8;
 220         *name         = sub{ shift->{'Name'} };
 221         *new_sequence = sub{ return $_[0] };
 222         *decode = sub{
 223             my ($obj,$octets,$chk) = @_;
 224             my $str = Encode::decode_utf8($octets);
 225             if (defined $str) {
 226                 $_[1] = '' if $chk;
 227                 return $str;
 228             }
 229             return undef;
 230         };
 231         *encode = sub {
 232             my ($obj,$string,$chk) = @_;
 233             my $octets = Encode::encode_utf8($string);
 234             $_[1] = '' if $chk;
 235             return $octets;
 236         };
 237         $Encode::Encoding{utf8} =
 238             bless {Name => "utf8"} => "Encode::utf8";
 239     }
 240     # do externals if necessary
 241     require File::Basename;
 242     require File::Spec;
 243     for my $ext (qw()){
 244         my $pm =
 245             File::Spec->catfile(File::Basename::dirname($INC{'Encode.pm'}),
 246                                 "Encode", "$ext.pm");
 247         do $pm;
 248     }
 249 }
 250
 251 require Encode::Encoding;
 252 require Encode::XS;
 253
 254 1;
 255
 256 __END__
 257
 258 =head1 NAME
 259
 260 Encode - character encodings
 261
 262 =head1 SYNOPSIS
 263
 264     use Encode;
 265
 266
 267 =head2 Table of Contents
 268
 269 Encode consists of a collection of modules which details are too big
 270 to fit in one document.  This POD itself explains the top-level APIs
 271 and general topics at a glance.  For other topics and more details,
 272 see the PODs below;
 273
 274   Name                          Description
 275   --------------------------------------------------------
 276   Encode::Alias         Alias defintions to encodings
 277   Encode::Encoding      Encode Implementation Base Class
 278   Encode::Supported     List of Supported Encodings
 279   Encode::CN            Simplified Chinese Encodings
 280   Encode::JP            Japanese Encodings
 281   Encode::KR            Korean Encodings
 282   Encode::TW            Traditional Chinese Encodings
 283   --------------------------------------------------------
 284
 285 =head1 DESCRIPTION
 286
 287 The C<Encode> module provides the interfaces between Perl's strings
 288 and the rest of the system.  Perl strings are sequences of
 289 B<characters>.
 290
 291 The repertoire of characters that Perl can represent is at least that
 292 defined by the Unicode Consortium. On most platforms the ordinal
 293 values of the characters (as returned by C<ord(ch)>) is the "Unicode
 294 codepoint" for the character (the exceptions are those platforms where
 295 the legacy encoding is some variant of EBCDIC rather than a super-set
 296 of ASCII - see L<perlebcdic>).
 297
 298 Traditionally computer data has been moved around in 8-bit chunks
 299 often called "bytes". These chunks are also known as "octets" in
 300 networking standards. Perl is widely used to manipulate data of many
 301 types - not only strings of characters representing human or computer
 302 languages but also "binary" data being the machines representation of
 303 numbers, pixels in an image - or just about anything.
 304
 305 When Perl is processing "binary data" the programmer wants Perl to
 306 process "sequences of bytes". This is not a problem for Perl - as a
 307 byte has 256 possible values it easily fits in Perl's much larger
 308 "logical character".
 309
 310 =head2 TERMINOLOGY
 311
 312 =over 4
 313
 314 =item *
 315
 316 I<character>: a character in the range 0..(2**32-1) (or more).
 317 (What Perl's strings are made of.)
 318
 319 =item *
 320
 321 I<byte>: a character in the range 0..255
 322 (A special case of a Perl character.)
 323
 324 =item *
 325
 326 I<octet>: 8 bits of data, with ordinal values 0..255
 327 (Term for bytes passed to or from a non-Perl context, e.g. disk file.)
 328
 329 =back
 330
 331 The marker [INTERNAL] marks Internal Implementation Details, in
 332 general meant only for those who think they know what they are doing,
 333 and such details may change in future releases.
 334
 335 =head1 PERL ENCODING API
 336
 337 =over 4
 338
 339 =item $octets  = encode(ENCODING, $string[, CHECK])
 340
 341 Encodes string from Perl's internal form into I<ENCODING> and returns
 342 a sequence of octets.  ENCODING can be either a canonical name or
 343 alias.  For encoding names and aliases, see L</"Defining Aliases">.
 344 For CHECK see L</"Handling Malformed Data">.
 345
 346 For example to convert (internally UTF-8 encoded) Unicode string to
 347 iso-8859-1 (also known as Latin1),
 348
 349   $octets = encode("iso-8859-1", $unicode);
 350
 351 =item $string = decode(ENCODING, $octets[, CHECK])
 352
 353 Decode sequence of octets assumed to be in I<ENCODING> into Perl's
 354 internal form and returns the resulting string.  as in encode(),
 355 ENCODING can be either a canonical name or alias. For encoding names
 356 and aliases, see L</"Defining Aliases">.  For CHECK see
 357 L</"Handling Malformed Data">.
 358
 359 For example to convert ISO-8859-1 data to UTF-8:
 360
 361   $utf8 = decode("iso-8859-1", $latin1);
 362
 363 =item [$length =] from_to($string, FROM_ENCODING, TO_ENCODING [,CHECK])
 364
 365 Convert B<in-place> the data between two encodings.  How did the data
 366 in $string originally get to be in FROM_ENCODING?  Either using
 367 encode() or through PerlIO: See L</"Encoding and IO">.
 368 For encoding names and aliases, see L</"Defining Aliases">.
 369 For CHECK see L</"Handling Malformed Data">.
 370
 371 For example to convert ISO-8859-1 data to UTF-8:
 372
 373         from_to($data, "iso-8859-1", "utf-8");
 374
 375 and to convert it back:
 376
 377         from_to($data, "utf-8", "iso-8859-1");
 378
 379 Note that because the conversion happens in place, the data to be
 380 converted cannot be a string constant, it must be a scalar variable.
 381
 382 from_to() return the length of the converted string on success, undef
 383 otherwise.
 384
 385 =back
 386
 387 =head2 UTF-8 / utf8
 388
 389 The Unicode consortium defines the UTF-8 standard as a way of encoding
 390 the entire Unicode repertoire as sequences of octets.  This encoding is
 391 expected to become very widespread. Perl can use this form internally
 392 to represent strings, so conversions to and from this form are
 393 particularly efficient (as octets in memory do not have to change,
 394 just the meta-data that tells Perl how to treat them).
 395
 396 =over 4
 397
 398 =item $octets = encode_utf8($string);
 399
 400 The characters that comprise string are encoded in Perl's superset of UTF-8
 401 and the resulting octets returned as a sequence of bytes. All possible
 402 characters have a UTF-8 representation so this function cannot fail.
 403
 404 =item $string = decode_utf8($octets [, CHECK]);
 405
 406 The sequence of octets represented by $octets is decoded from UTF-8
 407 into a sequence of logical characters. Not all sequences of octets
 408 form valid UTF-8 encodings, so it is possible for this call to fail.
 409 For CHECK see L</"Handling Malformed Data">.
 410
 411 =back
 412
 413 =head2 Listing available encodings
 414
 415   use Encode;
 416   @list = Encode->encodings();
 417
 418 Returns a list of the canonical names of the available encodings that
 419 are loaded.  To get a list of all available encodings including the
 420 ones that are not loaded yet, say
 421
 422   @all_encodings = Encode->encodings(":all");
 423
 424 Or you can give the name of specific module.
 425
 426   @with_jp = Encode->encodings("Encode::JP");
 427
 428 When "::" is not in the name, "Encode::" is assumed.
 429
 430   @ebcdic = Encode->encodings("EBCDIC");
 431
 432 To find which encodings are supported by this package in details,
 433 see L<Encode::Supported>.
 434
 435 =head2 Defining Aliases
 436
 437 To add new alias to a given encoding,  Use;
 438
 439   use Encode;
 440   use Encode::Alias;
 441   define_alias(newName => ENCODING);
 442
 443 After that, newName can be used as an alias for ENCODING.
 444 ENCODING may be either the name of an encoding or an
 445 I<encoding object>
 446
 447 See L<Encode::Alias> on details.
 448
 449 =head1 Encoding and IO
 450
 451 It is very common to want to do encoding transformations when
 452 reading or writing files, network connections, pipes etc.
 453 If Perl is configured to use the new 'perlio' IO system then
 454 C<Encode> provides a "layer" (See L<perliol>) which can transform
 455 data as it is read or written.
 456
 457 Here is how the blind poet would modernise the encoding:
 458
 459     use Encode;
 460     open(my $iliad,'<:encoding(iso-8859-7)','iliad.greek');
 461     open(my $utf8,'>:utf8','iliad.utf8');
 462     my @epic = <$iliad>;
 463     print $utf8 @epic;
 464     close($utf8);
 465     close($illiad);
 466
 467 In addition the new IO system can also be configured to read/write
 468 UTF-8 encoded characters (as noted above this is efficient):
 469
 470     open(my $fh,'>:utf8','anything');
 471     print $fh "Any \x{0021} string \N{SMILEY FACE}\n";
 472
 473 Either of the above forms of "layer" specifications can be made the default
 474 for a lexical scope with the C<use open ...> pragma. See L<open>.
 475
 476 Once a handle is open is layers can be altered using C<binmode>.
 477
 478 Without any such configuration, or if Perl itself is built using
 479 system's own IO, then write operations assume that file handle accepts
 480 only I<bytes> and will C<die> if a character larger than 255 is
 481 written to the handle. When reading, each octet from the handle
 482 becomes a byte-in-a-character. Note that this default is the same
 483 behaviour as bytes-only languages (including Perl before v5.6) would
 484 have, and is sufficient to handle native 8-bit encodings
 485 e.g. iso-8859-1, EBCDIC etc. and any legacy mechanisms for handling
 486 other encodings and binary data.
 487
 488 In other cases it is the programs responsibility to transform
 489 characters into bytes using the API above before doing writes, and to
 490 transform the bytes read from a handle into characters before doing
 491 "character operations" (e.g. C<lc>, C</\W+/>, ...).
 492
 493 You can also use PerlIO to convert larger amounts of data you don't
 494 want to bring into memory.  For example to convert between ISO-8859-1
 495 (Latin 1) and UTF-8 (or UTF-EBCDIC in EBCDIC machines):
 496
 497     open(F, "<:encoding(iso-8859-1)", "data.txt") or die $!;
 498     open(G, ">:utf8",                 "data.utf") or die $!;
 499     while (<F>) { print G }
 500
 501     # Could also do "print G <F>" but that would pull
 502     # the whole file into memory just to write it out again.
 503
 504 More examples:
 505
 506     open(my $f, "<:encoding(cp1252)")
 507     open(my $g, ">:encoding(iso-8859-2)")
 508     open(my $h, ">:encoding(latin9)")       # iso-8859-15
 509
 510 See L<PerlIO> for more information.
 511
 512 See also L<encoding> for how to change the default encoding of the
 513 data in your script.
 514
 515 =head1 Handling Malformed Data
 516
 517 If I<CHECK> is not set, (en|de)code will put I<substitution character> in
 518 place of the malformed character.  for UCM-based encodings,
 519 E<lt>subcharE<gt> will be used.  For Unicode, \xFFFD is used.  If the
 520 data is supposed to be UTF-8, an optional lexical warning (category
 521 utf8) is given.
 522
 523 If I<CHECK> is true but not a code reference, dies with an error message.
 524
 525 In future you will be able to use a code reference to a callback
 526 function for the value of I<CHECK> but its API is still undecided.
 527
 528 =head1 Defining Encodings
 529
 530 To define a new encoding, use:
 531
 532     use Encode qw(define_alias);
 533     define_encoding($object, 'canonicalName' [, alias...]);
 534
 535 I<canonicalName> will be associated with I<$object>.  The object
 536 should provide the interface described in L<Encode::Encoding>
 537 If more than two arguments are provided then additional
 538 arguments are taken as aliases for I<$object> as for C<define_alias>.
 539
 540 See L<Encode::Encoding> for more details.
 541
 542 =head1 Messing with Perl's Internals
 543
 544 The following API uses parts of Perl's internals in the current
 545 implementation.  As such they are efficient, but may change.
 546
 547 =over 4
 548
 549 =item is_utf8(STRING [, CHECK])
 550
 551 [INTERNAL] Test whether the UTF-8 flag is turned on in the STRING.
 552 If CHECK is true, also checks the data in STRING for being well-formed
 553 UTF-8.  Returns true if successful, false otherwise.
 554
 555 =item _utf8_on(STRING)
 556
 557 [INTERNAL] Turn on the UTF-8 flag in STRING.  The data in STRING is
 558 B<not> checked for being well-formed UTF-8.  Do not use unless you
 559 B<know> that the STRING is well-formed UTF-8.  Returns the previous
 560 state of the UTF-8 flag (so please don't test the return value as
 561 I<not> success or failure), or C<undef> if STRING is not a string.
 562
 563 =item _utf8_off(STRING)
 564
 565 [INTERNAL] Turn off the UTF-8 flag in STRING.  Do not use frivolously.
 566 Returns the previous state of the UTF-8 flag (so please don't test the
 567 return value as I<not> success or failure), or C<undef> if STRING is
 568 not a string.
 569
 570 =back
 571
 572 =head1 SEE ALSO
 573
 574 L<Encode::Encoding>,
 575 L<Encode::Supported>,
 576 L<PerlIO>,
 577 L<encoding>,
 578 L<perlebcdic>,
 579 L<perlfunc/open>,
 580 L<perlunicode>,
 581 L<utf8>,
 582 the Perl Unicode Mailing List E<lt>perl-unicode@perl.orgE<gt>
 583
 584 =cut