This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add checking cases to Encode's toUnicode and fromUnicode.
[perl5.git] / ext / Encode / Encode.pm
CommitLineData
2c674647
JH
1package Encode;
2
3$VERSION = 0.01;
4
5require DynaLoader;
6require Exporter;
7
8@ISA = qw(Exporter DynaLoader);
9
10@EXPORT_OK =
11 qw(
12 bytes_to_utf8
13 utf8_to_bytes
14 chars_to_utf8
15 utf8_to_chars
16 utf8_to_chars_check
17 bytes_to_chars
18 chars_to_bytes
19 from_to
20 is_utf8
21 on_utf8
22 off_utf8
23 utf_to_utf
656753f8 24 encodings
2c674647
JH
25 );
26
27bootstrap Encode ();
28
29=pod
30
31=head1 NAME
32
33Encode - character encodings
34
35=head2 TERMINOLOGY
36
37=over
38
39=item *
40
41I<char>: a character in the range 0..maxint (at least 2**32-1)
42
43=item *
44
45I<byte>: a character in the range 0..255
46
47=back
48
49The marker [INTERNAL] marks Internal Implementation Details, in
50general meant only for those who think they know what they are doing,
51and such details may change in future releases.
52
53=head2 bytes
54
55=over 4
56
57=item *
58
59 bytes_to_utf8(STRING [, FROM])
60
61The bytes in STRING are recoded in-place into UTF-8. If no FROM is
62specified the bytes are expected to be encoded in US-ASCII or ISO
638859-1 (Latin 1). Returns the new size of STRING, or C<undef> if
64there's a failure.
65
656753f8 66[INTERNAL] Also the UTF-8 flag of STRING is turned on.
2c674647
JH
67
68=item *
69
70 utf8_to_bytes(STRING [, TO [, CHECK]])
71
72The UTF-8 in STRING is decoded in-place into bytes. If no TO encoding
73is specified the bytes are expected to be encoded in US-ASCII or ISO
748859-1 (Latin 1). Returns the new size of STRING, or C<undef> if
75there's a failure.
76
77What if there are characters > 255? What if the UTF-8 in STRING is
78malformed? See L</"Handling Malformed Data">.
79
80[INTERNAL] The UTF-8 flag of STRING is not checked.
81
82=back
83
84=head2 chars
85
86=over 4
87
88=item *
89
90 chars_to_utf8(STRING)
91
92The chars in STRING are encoded in-place into UTF-8. Returns the new
93size of STRING, or C<undef> if there's a failure.
94
95No assumptions are made on the encoding of the chars. If you want to
96assume that the chars are Unicode and to trap illegal Unicode
97characters, you must use C<from_to('Unicode', ...)>.
98
99[INTERNAL] Also the UTF-8 flag of STRING is turned on.
100
101=over 4
102
103=item *
104
105 utf8_to_chars(STRING)
106
107The UTF-8 in STRING is decoded in-place into chars. Returns the new
656753f8 108size of STRING, or C<undef> if there's a failure.
2c674647
JH
109
110If the UTF-8 in STRING is malformed C<undef> is returned, and also an
111optional lexical warning (category utf8) is given.
112
113[INTERNAL] The UTF-8 flag of STRING is not checked.
114
115=item *
116
117 utf8_to_chars_check(STRING [, CHECK])
118
119(Note that special naming of this interface since a two-argument
120utf8_to_chars() has different semantics.)
121
122The UTF-8 in STRING is decoded in-place into chars. Returns the new
123size of STRING, or C<undef> if there is a failure.
124
125If the UTF-8 in STRING is malformed? See L</"Handling Malformed Data">.
126
127[INTERNAL] The UTF-8 flag of STRING is not checked.
128
129=back
130
131=head2 chars With Encoding
132
133=over 4
134
135=item *
136
137 chars_to_utf8(STRING, FROM [, CHECK])
138
139The chars in STRING encoded in FROM are recoded in-place into UTF-8.
140Returns the new size of STRING, or C<undef> if there's a failure.
141
142No assumptions are made on the encoding of the chars. If you want to
143assume that the chars are Unicode and to trap illegal Unicode
144characters, you must use C<from_to('Unicode', ...)>.
145
146[INTERNAL] Also the UTF-8 flag of STRING is turned on.
147
148=item *
149
150 utf8_to_chars(STRING, TO [, CHECK])
151
152The UTF-8 in STRING is decoded in-place into chars encoded in TO.
153Returns the new size of STRING, or C<undef> if there's a failure.
154
155If the UTF-8 in STRING is malformed? See L</"Handling Malformed Data">.
156
157[INTERNAL] The UTF-8 flag of STRING is not checked.
158
159=item *
160
161 bytes_to_chars(STRING, FROM [, CHECK])
162
163The bytes in STRING encoded in FROM are recoded in-place into chars.
164Returns the new size of STRING in bytes, or C<undef> if there's a
165failure.
166
167If the mapping is impossible? See L</"Handling Malformed Data">.
168
169=item *
170
171 chars_to_bytes(STRING, TO [, CHECK])
172
173The chars in STRING are recoded in-place to bytes encoded in TO.
174Returns the new size of STRING in bytes, or C<undef> if there's a
175failure.
176
177If the mapping is impossible? See L</"Handling Malformed Data">.
178
179=item *
180
181 from_to(STRING, FROM, TO [, CHECK])
182
183The chars in STRING encoded in FROM are recoded in-place into TO.
184Returns the new size of STRING, or C<undef> if there's a failure.
185
186If mapping between the encodings is impossible?
187See L</"Handling Malformed Data">.
188
189[INTERNAL] If TO is UTF-8, also the UTF-8 flag of STRING is turned on.
190
191=back
192
193=head2 Testing For UTF-8
194
195=over 4
196
197=item *
198
199 is_utf8(STRING [, CHECK])
200
201[INTERNAL] Test whether the UTF-8 flag is turned on in the STRING.
202If CHECK is true, also checks the data in STRING for being
203well-formed UTF-8. Returns true if successful, false otherwise.
204
205=back
206
207=head2 Toggling UTF-8-ness
208
209=over 4
210
211=item *
212
213 on_utf8(STRING)
214
215[INTERNAL] Turn on the UTF-8 flag in STRING. The data in STRING is
216B<not> checked for being well-formed UTF-8. Do not use unless you
217B<know> that the STRING is well-formed UTF-8. Returns the previous
218state of the UTF-8 flag (so please don't test the return value as
219I<not> success or failure), or C<undef> if STRING is not a string.
220
221=item *
222
223 off_utf8(STRING)
224
225[INTERNAL] Turn off the UTF-8 flag in STRING. Do not use frivolously.
226Returns the previous state of the UTF-8 flag (so please don't test the
227return value as I<not> success or failure), or C<undef> if STRING is
228not a string.
229
230=back
231
232=head2 UTF-16 and UTF-32 Encodings
233
234=over 4
235
236=item *
237
238 utf_to_utf(STRING, FROM, TO [, CHECK])
239
240The data in STRING is converted from Unicode Transfer Encoding FROM to
241Unicode Transfer Encoding TO. Both FROM and TO may be any of the
242following tags (case-insensitive, with or without 'utf' or 'utf-' prefix):
243
244 tag meaning
245
246 '7' UTF-7
247 '8' UTF-8
248 '16be' UTF-16 big-endian
249 '16le' UTF-16 little-endian
250 '16' UTF-16 native-endian
251 '32be' UTF-32 big-endian
252 '32le' UTF-32 little-endian
253 '32' UTF-32 native-endian
254
255UTF-16 is also known as UCS-2, 16 bit or 2-byte chunks, and UTF-32 as
256UCS-4, 32-bit or 4-byte chunks. Returns the new size of STRING, or
257C<undef> is there's a failure.
258
259If FROM is UTF-8 and the UTF-8 in STRING is malformed? See
260L</"Handling Malformed Data">.
261
262[INTERNAL] Even if CHECK is true and FROM is UTF-8, the UTF-8 flag of
263STRING is not checked. If TO is UTF-8, also the UTF-8 flag of STRING is
264turned on. Identical FROM and TO are fine.
265
266=back
267
268=head2 Handling Malformed Data
269
270If CHECK is not set, C<undef> is returned. If the data is supposed to
271be UTF-8, an optional lexical warning (category utf8) is given. If
272CHECK is true but not a code reference, dies. If CHECK is a code
273reference, it is called with the arguments
274
275 (MALFORMED_STRING, STRING_FROM_SO_FAR, STRING_TO_SO_FAR)
276
277Two return values are expected from the call: the string to be used in
278the result string in place of the malformed section, and the length of
279the malformed section in bytes.
280
281=cut
282
283sub bytes_to_utf8 {
284 &_bytes_to_utf8;
285}
286
287sub utf8_to_bytes {
288 &_utf8_to_bytes;
289}
290
291sub chars_to_utf8 {
292 &C_to_utf8;
293}
294
295sub utf8_to_chars {
296 &_utf8_to_chars;
297}
298
299sub utf8_to_chars_check {
300 &_utf8_to_chars_check;
301}
302
303sub bytes_to_chars {
304 &_bytes_to_chars;
305}
306
307sub chars_to_bytes {
308 &_chars_to_bytes;
309}
310
2c674647
JH
311sub is_utf8 {
312 &_is_utf8;
313}
314
315sub on_utf8 {
316 &_on_utf8;
317}
318
319sub off_utf8 {
320 &_off_utf8;
321}
322
323sub utf_to_utf {
324 &_utf_to_utf;
325}
326
bf230f3d
NIS
327use Carp;
328
656753f8
NIS
329sub from_to
330{
331 my ($string,$from,$to,$check) = @_;
332 my $f = __PACKAGE__->getEncoding($from);
bf230f3d 333 croak("Unknown encoding '$from'") unless $f;
656753f8 334 my $t = __PACKAGE__->getEncoding($to);
bf230f3d 335 croak("Unknown encoding '$to'") unless $t;
656753f8 336 my $uni = $f->toUnicode($string,$check);
bf230f3d 337 return undef if ($check && length($string));
656753f8 338 $string = $t->fromUnicode($uni,$check);
bf230f3d 339 return undef if ($check && length($uni));
656753f8
NIS
340 return length($_[0] = $string);
341}
342
343sub encodings
344{
345 my ($class) = @_;
346 my ($dir) = __FILE__ =~ /^(.*)\.pm$/;
347 my @names = ('Unicode');
348 if (opendir(my $dh,$dir))
349 {
350 while (defined(my $name = readdir($dh)))
351 {
352 push(@names,$1) if ($name =~ /^(.*)\.enc$/);
353 }
354 closedir($dh);
355 }
356 else
357 {
358 die "Cannot open $dir:$!";
359 }
360 return @names;
361}
362
363my %encoding = ( Unicode => 'Encode::Unicode' );
364
365sub getEncoding
366{
367 my ($class,$name) = @_;
368 unless (exists $encoding{$name})
369 {
bf230f3d
NIS
370 my $file;
371 foreach my $dir (@INC)
372 {
373 last if -f ($file = "$dir/Encode/$name.enc");
374 }
656753f8
NIS
375 if (open(my $fh,$file))
376 {
377 my $type;
378 while (1)
379 {
380 my $line = <$fh>;
381 $type = substr($line,0,1);
382 last unless $type eq '#';
383 }
384 $class .= ('::'.(($type eq 'E') ? 'Escape' : 'Table'));
385 $encoding{$name} = $class->read($fh,$name,$type);
386 }
387 }
bf230f3d 388 return $encoding{$name};
656753f8
NIS
389}
390
391package Encode::Unicode;
392
393# Dummy package that provides the encode interface
394
395sub name { 'Unicode' }
396
397sub toUnicode { $_[1] }
398
399sub fromUnicode { $_[1] }
400
401package Encode::Table;
402
403sub read
404{
405 my ($class,$fh,$name,$type) = @_;
406 my $rep = $class->can("rep_$type");
407 my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
408 my @touni;
409 my %fmuni;
410 my $count = 0;
411 $def = hex($def);
412 $def = pack(&$rep($def),$def);
413 while ($pages--)
414 {
415 my $page = hex(<$fh>);
416 my @page;
417 my $ch = $page * 256;
418 for (my $i = 0; $i < 16; $i++)
419 {
420 my $line = <$fh>;
421 for (my $j = 0; $j < 16; $j++)
422 {
423 my $val = hex(substr($line,0,4,''));
424 if ($val || !$ch)
425 {
426 my $uch = chr($val);
427 push(@page,$uch);
428 $fmuni{$uch} = pack(&$rep($ch),$ch);
429 $count++;
430 }
431 else
432 {
433 push(@page,undef);
434 }
435 $ch++;
436 }
437 }
438 $touni[$page] = \@page;
439 }
440
441 return bless {Name => $name,
442 Rep => $rep,
443 ToUni => \@touni,
444 FmUni => \%fmuni,
445 Def => $def,
446 Num => $count,
447 },$class;
448}
449
450sub name { shift->{'Name'} }
451
452sub rep_S { 'C' }
453
454sub rep_D { 'S' }
455
456sub rep_M { ($_[0] > 255) ? 'S' : 'C' }
457
458sub representation
459{
460 my ($obj,$ch) = @_;
461 $ch = 0 unless @_ > 1;
462 $obj-{'Rep'}->($ch);
463}
464
465sub toUnicode
466{
bf230f3d 467 my ($obj,$str,$chk) = @_;
656753f8
NIS
468 my $rep = $obj->{'Rep'};
469 my $touni = $obj->{'ToUni'};
470 my $uni = '';
471 while (length($str))
472 {
473 my $ch = ord(substr($str,0,1,''));
bf230f3d 474 my $x;
656753f8
NIS
475 if (&$rep($ch) eq 'C')
476 {
bf230f3d 477 $x = $touni->[0][$ch];
656753f8
NIS
478 }
479 else
480 {
bf230f3d 481 $x = $touni->[$ch][ord(substr($str,0,1,''))];
656753f8 482 }
bf230f3d
NIS
483 unless (defined $x)
484 {
485 last if $chk;
486 # What do we do here ?
487 $x = '';
488 }
489 $uni .= $x;
656753f8 490 }
bf230f3d 491 $_[1] = $str if $chk;
656753f8
NIS
492 return $uni;
493}
494
495sub fromUnicode
496{
bf230f3d 497 my ($obj,$uni,$chk) = @_;
656753f8
NIS
498 my $fmuni = $obj->{'FmUni'};
499 my $str = '';
500 my $def = $obj->{'Def'};
501 while (length($uni))
502 {
503 my $ch = substr($uni,0,1,'');
504 my $x = $fmuni->{$ch};
bf230f3d
NIS
505 unless (defined $x)
506 {
507 last if ($chk);
508 $x = $def;
509 }
510 $str .= $x;
656753f8 511 }
bf230f3d 512 $_[1] = $uni if $chk;
656753f8
NIS
513 return $str;
514}
515
516package Encode::Escape;
517use Carp;
518
519sub read
520{
521 my ($class,$fh,$name) = @_;
522 my %self = (Name => $name, Num => 0);
523 while (<$fh>)
524 {
525 my ($key,$val) = /^(\S+)\s+(.*)$/;
526 $val =~ s/^\{(.*?)\}/$1/g;
527 $val =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
528 $self{$key} = $val;
529 }
530 return bless \%self,$class;
531}
532
533sub name { shift->{'Name'} }
534
535sub toUnicode
536{
537 croak("Not implemented yet");
538}
539
540sub fromUnicode
541{
542 croak("Not implemented yet");
543}
544
5451;
546
547__END__