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