require 5.7.3; package Encode::EUCFixed; use strict; use vars qw(%DEFAULT $VERSION); $VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; package Encode::EUCFixed::JP; use base qw(Encode::Encoding); __PACKAGE__->Define (qw/Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese/); sub encode ($$;$) { my ($obj, $str, $chk) = @_; $_[1] = '' if $chk; $str = Encode::encode ('euc-jp', $str); $str =~ s{ ([\x00-\x8D\x90-\xA0\xFF]) ## CS0: ASCII #([\xA0-\xFE][\xA0-\xFE]) ## CS1: JIS X 0208-1990 |\x8E([\xA0-\xFE]) ## CS2: JIS X 0201 Katakana |\x8F([\xA0-\xFE])([\xA0-\xFE]) ## CS3: JIS X 0212-1990 }{ my ($c0, $c2, $c31, $c32) = ($1, $2, $3, $4); if ($c0) { "\x00".$c0 } elsif ($c2) { "\x00".$c2 } else { $c31 =~ tr/\xA1-\xFE/\x21-\x7E/; $c31.$c32 } }gex; return $str; } sub decode ($$;$) { my ($obj, $str, $chk) = @_; $_[1] = '' if $chk; $str =~ s{ \x00([\x00-\xA0\xFF]) ## CS0: ASCII #([\xA1-\xFE][\xA1-\xFE]) ## CS1: JIS X 0208-1990 |\x00([\xA1-\xFE]) ## CS2: JIS X 0201 Katakana |([\x21-\x7E][\xA1-\xFE]) ## CS3: JIS X 0201-1990 }{ my ($c0, $c1, $c3) = ($1, $2, $3); if ($c0) { $c0 } elsif ($c1) { $c1 =~ tr/\x80-\xFF/\x00-\x7F/; $c1 } else { $c3 =~ tr/\x80-\xFF/\x00-\x7F/; $c3 } }gex; return Encode::decode ('euc-jp', $str); } package Encode::EUCFixed::TW; use base qw(Encode::Encoding); __PACKAGE__->Define (qw/cns-11643-1986-appendix DEC.CNS11643.1986-2/); sub encode ($$;$) { require Encode::HanExtra; my ($obj, $str, $chk) = @_; $_[1] = '' if $chk; $str = Encode::encode ('euc-tw', $str); $str =~ s{ ([\x00-\x8D\x90-\xA0\xFF]) ## CS0: ASCII #([\xA0-\xFE][\xA0-\xFE]) ## CS1: CNS 11643 plane 1 |\x8E\xA1([\xA0-\xFE][\xA0-\xFE]) ## CNS 11643 plane 1 |\x8E\xA2([\xA0-\xFE])([\xA0-\xFE]) ## CNS 11643 plane 2 |\x8E([\xA3-\xFE][\xA0-\xFE][\xA0-\xFE]) }{ my ($c0, $p1, $p21, $p22, $p3) = ($1, $2, $3, $4, $5); if ($c0) { "\x00".$c0 } elsif ($p1) { $p1 } elsif ($p21) { $p22 =~ tr/\xA1-\xFE/\x21-\x7E/; $p21.$p22 } else { "\x00\x3F" } ## BUG: don't use fallback }gex; return $str; } sub decode ($$;$) { require Encode::HanExtra; my ($obj, $str, $chk) = @_; $_[1] = '' if $chk; $str =~ s{ \x00([\x00-\xFF]) ## CS0: ASCII #([\xA1-\xFE][\xA1-\xFE]) ## CS1: CNS 11643 plane 1 |([\xA1-\xFE][\x21-\x7E]) ## CNS 11643 plane 2 }{ my ($c0, $p2) = ($1, $2); if ($c0) { $c0 } else { $p2 =~ tr/\x21-\x7E/\xA1-\xFE/; $p2 } }gex; return Encode::decode ('euc-tw', $str); } 1; __END__ =head1 NAME Encode::EUCFixed --- Fixed width (or wide) coding system of EUC =head1 ENCODINGS =over 4 =item Extended_UNIX_Code_Fixed_Width_for_Japanese EUC-japan (packed) based fixed width coding system for wide char. (Alias: csEUCFixWidJapanese (IANA)) =item cns-11643-1986-appendix Fixed width coding system for ASCII and CNS 11643 plane 1 and 2, defined by CNS 11643-1986 appendix. (Alias: DEC.CNS11643.1986-2 (X)) =back =head1 LICENSE Copyright 2002 Wakaba This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 CHANGE Last update $Date: 2002/09/22 11:09:38 $ =cut