This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline - to see what Jarkko has in ...
[perl5.git] / ext / Encode / Encode.pm
1 package Encode;
2
3 $VERSION = 0.01;
4
5 require DynaLoader;
6 require Exporter;
7
8 @ISA = qw(Exporter DynaLoader);
9
10 # Public, encouraged API is exported by default
11 @EXPORT = qw (
12   encode
13   decode
14   encode_utf8
15   decode_utf8
16   find_encoding
17 );
18
19 @EXPORT_OK =
20     qw(
21        encodings
22        from_to
23        is_utf8
24        is_8bit
25        is_16bit
26        utf8_upgrade
27        utf8_downgrade
28        _utf8_on
29        _utf8_off
30       );
31
32 bootstrap Encode ();
33
34 # Documentation moved after __END__ for speed - NI-S
35
36 use Carp;
37
38 # The global hash is declared in XS code
39 $encoding{Unicode}      = bless({},'Encode::Unicode');
40 $encoding{utf8}         = bless({},'Encode::utf8');
41 $encoding{'iso10646-1'} = bless({},'Encode::iso10646_1');
42
43 sub encodings
44 {
45  my ($class) = @_;
46  foreach my $dir (@INC)
47   {
48    if (opendir(my $dh,"$dir/Encode"))
49     {
50      while (defined(my $name = readdir($dh)))
51       {
52        if ($name =~ /^(.*)\.enc$/)
53         {
54          next if exists $encoding{$1};
55          $encoding{$1} = "$dir/$name";
56         }
57       }
58      closedir($dh);
59     }
60   }
61  return keys %encoding;
62 }
63
64 sub loadEncoding
65 {
66  my ($class,$name,$file) = @_;
67  if (open(my $fh,$file))
68   {
69    my $type;
70    while (1)
71     {
72      my $line = <$fh>;
73      $type = substr($line,0,1);
74      last unless $type eq '#';
75     }
76    $class .= ('::'.(($type eq 'E') ? 'Escape' : 'Table'));
77    #warn "Loading $file";
78    return $class->read($fh,$name,$type);
79   }
80  else
81   {
82    return undef;
83   }
84 }
85
86 sub getEncoding
87 {
88  my ($class,$name) = @_;
89  my $enc;
90  unless (ref($enc = $encoding{$name}))
91   {
92    $enc = $class->loadEncoding($name,$enc) if defined $enc;
93    unless (ref($enc))
94     {
95      foreach my $dir (@INC)
96       {
97        last if ($enc = $class->loadEncoding($name,"$dir/Encode/$name.enc"));
98       }
99     }
100    $encoding{$name} = $enc;
101   }
102  return $enc;
103 }
104
105 sub find_encoding
106 {
107  my ($name) = @_;
108  return __PACKAGE__->getEncoding($name);
109 }
110
111 sub encode
112 {
113  my ($name,$string,$check) = @_;
114  my $enc = find_encoding($name);
115  croak("Unknown encoding '$name'") unless defined $enc;
116  my $octets = $enc->fromUnicode($string,$check);
117  return undef if ($check && length($string));
118  return $octets;
119 }
120
121 sub decode
122 {
123  my ($name,$octets,$check) = @_;
124  my $enc = find_encoding($name);
125  croak("Unknown encoding '$name'") unless defined $enc;
126  my $string = $enc->toUnicode($octets,$check);
127  return undef if ($check && length($octets));
128  return $string;
129 }
130
131 sub from_to
132 {
133  my ($string,$from,$to,$check) = @_;
134  my $f = find_encoding($from);
135  croak("Unknown encoding '$from'") unless defined $f;
136  my $t = find_encoding($to);
137  croak("Unknown encoding '$to'") unless defined $t;
138  my $uni = $f->toUnicode($string,$check);
139  return undef if ($check && length($string));
140  $string = $t->fromUnicode($uni,$check);
141  return undef if ($check && length($uni));
142  return length($_[0] = $string);
143 }
144
145 sub encode_utf8
146 {
147  my ($str) = @_;
148  utf8_encode($str);
149  return $str;
150 }
151
152 sub decode_utf8
153 {
154  my ($str) = @_;
155  return undef unless utf8_decode($str);
156  return $str;
157 }
158
159 package Encode::Unicode;
160
161 # Dummy package that provides the encode interface but leaves data
162 # as UTF-8 encoded. It is here so that from_to() works.
163
164 sub name { 'Unicode' }
165
166 sub toUnicode
167 {
168  my ($obj,$str,$chk) = @_;
169  Encode::utf8_upgrade($str);
170  $_[1] = '' if $chk;
171  return $str;
172 }
173
174 *fromUnicode = \&toUnicode;
175
176 package Encode::utf8;
177
178 # package to allow long-hand
179 #   $octets = encode( utf8 => $string );
180 #
181
182 sub name { 'utf8' }
183
184 sub toUnicode
185 {
186  my ($obj,$octets,$chk) = @_;
187  my $str = decode_utf8($octets);
188  if (defined $str)
189   {
190    $_[1] = '' if $chk;
191    return $str;
192   }
193  return undef;
194 }
195
196 sub fromUnicode
197 {
198  my ($obj,$string,$chk) = @_;
199  my $octets = encode_utf8($string);
200  $_[1] = '' if $chk;
201  return $octets;
202
203 }
204
205 *fromUnicode = \&toUnicode;
206
207 package Encode::Table;
208
209 sub read
210 {
211  my ($class,$fh,$name,$type) = @_;
212  my $rep = $class->can("rep_$type");
213  my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
214  my @touni;
215  my %fmuni;
216  my $count = 0;
217  $def = hex($def);
218  while ($pages--)
219   {
220    my $line = <$fh>;
221    chomp($line);
222    my $page = hex($line);
223    my @page;
224    my $ch = $page * 256;
225    for (my $i = 0; $i < 16; $i++)
226     {
227      my $line = <$fh>;
228      for (my $j = 0; $j < 16; $j++)
229       {
230        my $val = hex(substr($line,0,4,''));
231        if ($val || !$ch)
232         {
233          my $uch = chr($val);
234          push(@page,$uch);
235          $fmuni{$uch} = $ch;
236          $count++;
237         }
238        else
239         {
240          push(@page,undef);
241         }
242        $ch++;
243       }
244     }
245    $touni[$page] = \@page;
246   }
247
248  return bless {Name  => $name,
249                Rep   => $rep,
250                ToUni => \@touni,
251                FmUni => \%fmuni,
252                Def   => $def,
253                Num   => $count,
254               },$class;
255 }
256
257 sub name { shift->{'Name'} }
258
259 sub rep_S { 'C' }
260
261 sub rep_D { 'n' }
262
263 sub rep_M { ($_[0] > 255) ? 'n' : 'C' }
264
265 sub representation
266 {
267  my ($obj,$ch) = @_;
268  $ch = 0 unless @_ > 1;
269  $obj-{'Rep'}->($ch);
270 }
271
272 sub toUnicode
273 {
274  my ($obj,$str,$chk) = @_;
275  my $rep   = $obj->{'Rep'};
276  my $touni = $obj->{'ToUni'};
277  my $uni   = '';
278  while (length($str))
279   {
280    my $ch = ord(substr($str,0,1,''));
281    my $x;
282    if (&$rep($ch) eq 'C')
283     {
284      $x = $touni->[0][$ch];
285     }
286    else
287     {
288      $x = $touni->[$ch][ord(substr($str,0,1,''))];
289     }
290    unless (defined $x)
291     {
292      last if $chk;
293      # What do we do here ?
294      $x = '';
295     }
296    $uni .= $x;
297   }
298  $_[1] = $str if $chk;
299  return $uni;
300 }
301
302 sub fromUnicode
303 {
304  my ($obj,$uni,$chk) = @_;
305  my $fmuni = $obj->{'FmUni'};
306  my $str   = '';
307  my $def   = $obj->{'Def'};
308  my $rep   = $obj->{'Rep'};
309  while (length($uni))
310   {
311    my $ch = substr($uni,0,1,'');
312    my $x  = $fmuni->{chr(ord($ch))};
313    unless (defined $x)
314     {
315      last if ($chk);
316      $x = $def;
317     }
318    $str .= pack(&$rep($x),$x);
319   }
320  $_[1] = $uni if $chk;
321  return $str;
322 }
323
324 package Encode::iso10646_1;
325 # Encoding is 16-bit network order Unicode
326 # Used for X font encodings
327
328 sub name { 'iso10646-1' }
329
330 sub toUnicode
331 {
332  my ($obj,$str,$chk) = @_;
333  my $uni   = '';
334  while (length($str))
335   {
336    my $code = unpack('n',substr($str,0,2,'')) & 0xffff;
337    $uni .= chr($code);
338   }
339  $_[1] = $str if $chk;
340  Encode::utf8_upgrade($uni);
341  return $uni;
342 }
343
344 sub fromUnicode
345 {
346  my ($obj,$uni,$chk) = @_;
347  my $str   = '';
348  while (length($uni))
349   {
350    my $ch = substr($uni,0,1,'');
351    my $x  = ord($ch);
352    unless ($x < 32768)
353     {
354      last if ($chk);
355      $x = 0;
356     }
357    $str .= pack('n',$x);
358   }
359  $_[1] = $uni if $chk;
360  return $str;
361 }
362
363
364 package Encode::Escape;
365 use Carp;
366
367 sub read
368 {
369  my ($class,$fh,$name) = @_;
370  my %self = (Name => $name, Num => 0);
371  while (<$fh>)
372   {
373    my ($key,$val) = /^(\S+)\s+(.*)$/;
374    $val =~ s/^\{(.*?)\}/$1/g;
375    $val =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
376    $self{$key} = $val;
377   }
378  return bless \%self,$class;
379 }
380
381 sub name { shift->{'Name'} }
382
383 sub toUnicode
384 {
385  croak("Not implemented yet");
386 }
387
388 sub fromUnicode
389 {
390  croak("Not implemented yet");
391 }
392
393 # switch back to Encode package in case we ever add AutoLoader
394 package Encode;
395
396 1;
397
398 =head1 NAME
399
400 Encode - character encodings
401
402 =head1 SYNOPSIS
403
404     use Encode;
405
406 =head1 DESCRIPTION
407
408 The C<Encode> module provides the interfaces between perl's strings
409 and the rest of the system. Perl strings are sequences of B<characters>.
410
411 The repertoire of characters that Perl can represent is at least that
412 defined by the Unicode Consortium. On most platforms the ordinal values
413 of the  characters (as returned by C<ord(ch)>) is the "Unicode codepoint" for
414 the character (the exceptions are those platforms where the legacy
415 encoding is some variant of EBCDIC rather than a super-set of ASCII
416 - see L<perlebcdic>).
417
418 Traditionaly computer data has been moved around in 8-bit chunks
419 often called "bytes". These chunks are also known as "octets" in
420 networking standards. Perl is widely used to manipulate data of
421 many types - not only strings of characters representing human or
422 computer languages but also "binary" data being the machines representation
423 of numbers, pixels in an image - or just about anything.
424
425 When perl is processing "binary data" the programmer wants perl to process
426 "sequences of bytes". This is not a problem for perl - as a byte has 256
427 possible values it easily fits in perl's much larger "logical character".
428
429 =head2 TERMINOLOGY
430
431 =over
432
433 =item *
434
435 I<character>: a character in the range 0..(2**32-1) (or more).
436 (What perl's strings are made of.)
437
438 =item *
439
440 I<byte>: a character in the range 0..255
441 (A special case of a perl character.)
442
443 =item *
444
445 I<octet>: 8 bits of data, with ordinal values 0..255
446 (Term for bytes passed to or from a non-perl context, e.g. disk file.)
447
448 =back
449
450 The marker [INTERNAL] marks Internal Implementation Details, in
451 general meant only for those who think they know what they are doing,
452 and such details may change in future releases.
453
454 =head1 ENCODINGS
455
456 =head2 Characteristics of an Encoding
457
458 An encoding has a "repertoire" of characters that it can represent,
459 and for each representable character there is at least one sequence of
460 octets that represents it.
461
462 =head2 Types of Encodings
463
464 Encodings can be divided into the following types:
465
466 =over 4
467
468 =item * Fixed length 8-bit (or less) encodings.
469
470 Each character is a single octet so may have a repertoire of up to
471 256 characters. ASCII and iso-8859-* are typical examples.
472
473 =item * Fixed length 16-bit encodings
474
475 Each character is two octets so may have a repertoire of up to
476 65,536 characters. Unicode's UCS-2 is an example. Also used for
477 encodings for East Asian languages.
478
479 =item * Fixed length 32-bit encodings.
480
481 Not really very "encoded" encodings. The Unicode code points
482 are just represented as 4-octet integers. None the less because
483 different architectures use different representations of integers
484 (so called "endian") there at least two disctinct encodings.
485
486 =item * Multi-byte encodings
487
488 The number of octets needed to represent a character varies.
489 UTF-8 is a particularly complex but regular case of a multi-byte
490 encoding. Several East Asian countries use a multi-byte encoding
491 where 1-octet is used to cover western roman characters and Asian
492 characters get 2-octets.
493 (UTF-16 is strictly a multi-byte encoding taking either 2 or 4 octets
494 to represent a Unicode code point.)
495
496 =item * "Escape" encodings.
497
498 These encodings embed "escape sequences" into the octet sequence
499 which describe how the following octets are to be interpreted.
500 The iso-2022-* family is typical. Following the escape sequence
501 octets are encoded by an "embedded" encoding (which will be one
502 of the above types) until another escape sequence switches to
503 a different "embedded" encoding.
504
505 These schemes are very flexible and can handle mixed languages but are
506 very complex to process (and have state).
507 No escape encodings are implemented for perl yet.
508
509 =back
510
511 =head2 Specifying Encodings
512
513 Encodings can be specified to the API described below in two ways:
514
515 =over 4
516
517 =item 1. By name
518
519 Encoding names are strings with characters taken from a restricted repertoire.
520 See L</"Encoding Names">.
521
522 =item 2. As an object
523
524 Encoding objects are returned by C<find_encoding($name)>.
525
526 =back
527
528 =head2 Encoding Names
529
530 Encoding names are case insensitive. White space in names is ignored.
531 In addition an encoding may have aliases. Each encoding has one "canonical" name.
532 The "canonical" name is chosen from the names of the encoding by picking
533 the first in the following sequence:
534
535 =over 4
536
537 =item * The MIME name as defined in IETF RFC-XXXX.
538
539 =item * The name in the IANA registry.
540
541 =item * The name used by the the organization that defined it.
542
543 =back
544
545 Because of all the alias issues, and because in the general case
546 encodings have state C<Encode> uses the encoding object internally
547 once an operation is in progress.
548
549 I<Aliasing is not yet implemented.>
550
551 =head1 PERL ENCODING API
552
553 =head2 Generic Encoding Interface
554
555 =over 4
556
557 =item *
558
559         $bytes  = encode(ENCODING, $string[, CHECK])
560
561 Encodes string from perl's internal form into I<ENCODING> and returns a
562 sequence of octets.
563 See L</"Handling Malformed Data">.
564
565 =item *
566
567         $string = decode(ENCODING, $bytes[, CHECK])
568
569 Decode sequence of octets assumed to be in I<ENCODING> into perls internal
570 form and returns the resuting string.
571 See L</"Handling Malformed Data">.
572
573 =back
574
575 =head2 Handling Malformed Data
576
577 If CHECK is not set, C<undef> is returned.  If the data is supposed to
578 be UTF-8, an optional lexical warning (category utf8) is given.
579 If CHECK is true but not a code reference, dies.
580
581 It would desirable to have a way to indicate that transform should use the
582 encodings "replacement character" - no such mechanism is defined yet.
583
584 It is also planned to allow I<CHECK> to be a code reference.
585
586 This is not yet implemented as there are design issues with what its arguments
587 should be and how it returns its results.
588
589 =over 4
590
591 =item Scheme 1
592
593 Passed remaining fragment of string being processed.
594 Modifies it in place to remove bytes/characters it can understand
595 and returns a string used to represent them.
596 e.g.
597
598  sub fixup {
599    my $ch = substr($_[0],0,1,'');
600    return sprintf("\x{%02X}",ord($ch);
601  }
602
603 This scheme is close to how underlying C code for Encode works, but gives
604 the fixup routine very little context.
605
606 =item Scheme 2
607
608 Passed original string, and an index into it of the problem area,
609 and output string so far.
610 Appends what it will to output string and returns new index into
611 original string.
612 e.g.
613
614  sub fixup {
615    # my ($s,$i,$d) = @_;
616    my $ch = substr($_[0],$_[1],1);
617    $_[2] .= sprintf("\x{%02X}",ord($ch);
618    return $_[1]+1;
619  }
620
621 This scheme gives maximal control to the fixup routine but is more complicated
622 to code, and may need internals of Encode to be tweaked to keep original
623 string intact.
624
625 =item Other Schemes
626
627 Hybrids of above.
628
629 Multiple return values rather than in-place modifications.
630
631 Index into the string could be pos($str) allowing s/\G...//.
632
633 =back
634
635 =head2 UTF-8 / utf8
636
637 The Unicode consortium defines the UTF-8 standard as a way of encoding
638 the entire Unicode repertiore as sequences of octets. This encoding
639 is expected to become very widespread. Perl can use this form internaly
640 to represent strings, so conversions to and from this form are particularly
641 efficient (as octets in memory do not have to change, just the meta-data
642 that tells perl how to treat them).
643
644 =over 4
645
646 =item *
647
648         $bytes = encode_utf8($string);
649
650 The characters that comprise string are encoded in perl's superset of UTF-8
651 and the resulting octets returned as a sequence of bytes. All possible
652 characters have a UTF-8 representation so this function cannot fail.
653
654 =item *
655
656         $string = decode_utf8($bytes [,CHECK]);
657
658 The sequence of octets represented by $bytes is decoded from UTF-8 into
659 a sequence of logical characters. Not all sequences of octets form valid
660 UTF-8 encodings, so it is possible for this call to fail.
661 See L</"Handling Malformed Data">.
662
663 =back
664
665 =head2 Other Encodings of Unicode
666
667 UTF-16 is similar to UCS-2, 16 bit or 2-byte chunks.
668 UCS-2 can only represent 0..0xFFFF, while UTF-16 has a "surogate pair"
669 scheme which allows it to cover the whole Unicode range.
670
671 Encode implements big-endian UCS-2 as the encoding "iso10646-1" as that
672 happens to be the name used by that representation when used with X11 fonts.
673
674 UTF-32 or UCS-4 is 32-bit or 4-byte chunks.  Perl's logical characters
675 can be considered as being in this form without encoding. An encoding
676 to transfer strings in this form (e.g. to write them to a file) would need to
677
678      pack('L',map(chr($_),split(//,$string)));   # native
679   or
680      pack('V',map(chr($_),split(//,$string)));   # little-endian
681   or
682      pack('N',map(chr($_),split(//,$string)));   # big-endian
683
684 depending on the endian required.
685
686 No UTF-32 encodings are not yet implemented.
687
688 Both UCS-2 and UCS-4 style encodings can have "byte order marks" by representing
689 the code point 0xFFFE as the very first thing in a file.
690
691 =head1 Encoding and IO
692
693 It is very common to want to do encoding transformations when
694 reading or writing files, network connections, pipes etc.
695 If perl is configured to use the new 'perlio' IO system then
696 C<Encode> provides a "layer" (See L<perliol>) which can transform
697 data as it is read or written.
698
699      open(my $ilyad,'>:encoding(iso8859-7)','ilyad.greek');
700      print $ilyad @epic;
701
702 In addition the new IO system can also be configured to read/write
703 UTF-8 encoded characters (as noted above this is efficient):
704
705      open(my $fh,'>:utf8','anything');
706      print $fh "Any \x{0021} string \N{SMILEY FACE}\n";
707
708 Either of the above forms of "layer" specifications can be made the default
709 for a lexical scope with the C<use open ...> pragma. See L<open>.
710
711 Once a handle is open is layers can be altered using C<binmode>.
712
713 Without any such configuration, or if perl itself is built using
714 system's own IO, then write operations assume that file handle accepts
715 only I<bytes> and will C<die> if a character larger than 255 is
716 written to the handle. When reading, each octet from the handle
717 becomes a byte-in-a-character. Note that this default is the same
718 behaviour as bytes-only languages (including perl before v5.6) would have,
719 and is sufficient to handle native 8-bit encodings e.g. iso-8859-1,
720 EBCDIC etc. and any legacy mechanisms for handling other encodings
721 and binary data.
722
723 In other cases it is the programs responsibility
724 to transform characters into bytes using the API above before
725 doing writes, and to transform the bytes read from a handle into characters
726 before doing "character operations" (e.g. C<lc>, C</\W+/>, ...).
727
728 =head1 Encoding How to ...
729
730 To do:
731
732 =over 4
733
734 =item * IO with mixed content (faking iso-2020-*)
735
736 =item * MIME's Content-Length:
737
738 =item * UTF-8 strings in binary data.
739
740 =item * perl/Encode wrappers on non-Unicode XS modules.
741
742 =back
743
744 =head1 Messing with Perl's Internals
745
746 The following API uses parts of perl's internals in the current implementation.
747 As such they are efficient, but may change.
748
749 =over 4
750
751 =item *
752
753         $num_octets = utf8_upgrade($string);
754
755 Converts internal representation of string to the UTF-8 form.
756 Returns the number of octets necessary to represent the string as UTF-8.
757
758 =item * utf8_downgrade($string[, CHECK])
759
760 Converts internal representation of string to be un-encoded bytes.
761
762 =item * is_utf8(STRING [, CHECK])
763
764 [INTERNAL] Test whether the UTF-8 flag is turned on in the STRING.
765 If CHECK is true, also checks the data in STRING for being
766 well-formed UTF-8.  Returns true if successful, false otherwise.
767
768 =item * valid_utf8(STRING)
769
770 [INTERNAL] Test whether STRING is in a consistent state.
771 Will return true if string is held as bytes, or is well-formed UTF-8
772 and has the UTF-8 flag on.
773 Main reason for this routine is to allow perl's testsuite to check
774 that operations have left strings in a consistent state.
775
776 =item *
777
778         _utf8_on(STRING)
779
780 [INTERNAL] Turn on the UTF-8 flag in STRING.  The data in STRING is
781 B<not> checked for being well-formed UTF-8.  Do not use unless you
782 B<know> that the STRING is well-formed UTF-8.  Returns the previous
783 state of the UTF-8 flag (so please don't test the return value as
784 I<not> success or failure), or C<undef> if STRING is not a string.
785
786 =item *
787
788         _utf8_off(STRING)
789
790 [INTERNAL] Turn off the UTF-8 flag in STRING.  Do not use frivolously.
791 Returns the previous state of the UTF-8 flag (so please don't test the
792 return value as I<not> success or failure), or C<undef> if STRING is
793 not a string.
794
795 =back
796
797 =head1 SEE ALSO
798
799 L<perlunicode>, L<perlebcdic>, L<perlfunc/open>
800
801 =cut
802
803
804 __END__