Parent Directory
| 
Revision Log
2002-09-23 Nanashi-san * UTF8.pm, UTF9.pm: New modules. (Committed by Wakaba <w@suika.fam.cx>.)
| 1 | wakaba | 1.1 | =head1 NAME |
| 2 | |||
| 3 | Encode::Unicode::UTF9 --- Encode/decode of UTF-9 | ||
| 4 | |||
| 5 | =head1 ENCODINGS | ||
| 6 | |||
| 7 | =over 4 | ||
| 8 | |||
| 9 | =item utf-9 | ||
| 10 | |||
| 11 | UTF-9, defined in draft-abela-utf9-00. (Alias: utf9) | ||
| 12 | |||
| 13 | =back | ||
| 14 | |||
| 15 | =cut | ||
| 16 | |||
| 17 | require v5.7.3; | ||
| 18 | package Encode::Unicode::UTF9; | ||
| 19 | use strict; | ||
| 20 | use vars qw($VERSION); | ||
| 21 | $VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; | ||
| 22 | use base qw(Encode::Encoding); | ||
| 23 | __PACKAGE__->Define (qw/utf-9 utf9/); | ||
| 24 | |||
| 25 | my %_4to9; | ||
| 26 | sub encode ($$;$) { | ||
| 27 | my ($obj, $str, $chk) = @_; | ||
| 28 | my $r = ''; | ||
| 29 | for (split //, $str) { | ||
| 30 | unless ($_4to9{$_}) { | ||
| 31 | my $U = ord $_; | ||
| 32 | if ($U <= 0x7F) { | ||
| 33 | $_4to9{$_} = $_; | ||
| 34 | } else { | ||
| 35 | $_4to9{$_} = _ucs4_to_utf9 ($U); | ||
| 36 | } | ||
| 37 | } | ||
| 38 | $r .= $_4to9{$_}; | ||
| 39 | } | ||
| 40 | $_[1] = '' if $chk; | ||
| 41 | return $r; | ||
| 42 | } | ||
| 43 | |||
| 44 | my %_9to4; | ||
| 45 | sub decode ($$;$) { | ||
| 46 | my ($obj, $str, $chk) = @_; | ||
| 47 | $str =~ s{ | ||
| 48 | ([\x80-\x8F][\x80-\xFF]) | ||
| 49 | |([\x90-\x93][\x80-\xFF][\x80-\xFF]) | ||
| 50 | |([\x94-\x97][\x80-\xFF][\x80-\xFF][\x80-\xFF]) | ||
| 51 | |([\x98-\x9F][\x80-\xFF][\x80-\xFF][\x80-\xFF][\x80-\xFF]) | ||
| 52 | |([\x80-\xFF]) | ||
| 53 | }{ | ||
| 54 | my ($o2,$o3,$o4,$o5,$o1) = ($1,$2,$3,$4,$5); | ||
| 55 | unless ($_9to4{$o2.$o3.$o4.$o5.$o1}) { | ||
| 56 | if ($o1) { | ||
| 57 | $_9to4{$o1} = $o1; | ||
| 58 | } elsif ($o2) { | ||
| 59 | my @o = split //, $o2; | ||
| 60 |