lib/Encode/EUCFixed.pm

require 5.7.3;
package Encode::EUCFixed;
use strict;
use vars qw(%DEFAULT $VERSION);
$VERSION=do{my @r=(q$Revision: 1.2 $=~/\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 <w@suika.fam.cx>

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/20 14:01:45 $

=cut
1	wakaba	1.1	require 5.7.3;
2			package Encode::EUCFixed;
3			use strict;
4			use vars qw(%DEFAULT $VERSION);
5	wakaba	1.3	$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
6	wakaba	1.1
7			package Encode::EUCFixed::JP;
8			use base qw(Encode::Encoding);
9			__PACKAGE__->Define (qw/Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese/);
10
11			sub encode ($$;$) {
12			my ($obj, $str, $chk) = @_;
13			$_[1] = '' if $chk;
14			$str = Encode::encode ('euc-jp', $str);
15			$str =~ s{
16			([\x00-\x8D\x90-\xA0\xFF]) ## CS0: ASCII
17			#([\xA0-\xFE][\xA0-\xFE]) ## CS1: JIS X 0208-1990
18			\|\x8E([\xA0-\xFE]) ## CS2: JIS X 0201 Katakana
19			\|\x8F([\xA0-\xFE])([\xA0-\xFE]) ## CS3: JIS X 0212-1990
20			}{
21			my ($c0, $c2, $c31, $c32) = ($1, $2, $3, $4);
22			if ($c0) { "\x00".$c0 }
23			elsif ($c2) { "\x00".$c2 }
24			else { $c31 =~ tr/\xA1-\xFE/\x21-\x7E/; $c31.$c32 }
25			}gex;
26			return $str;
27			}
28
29			sub decode ($$;$) {
30			my ($obj, $str, $chk) = @_;
31			$_[1] = '' if $chk;
32			$str =~ s{
33			\x00([\x00-\xA0\xFF]) ## CS0: ASCII
34			#([\xA1-\xFE][\xA1-\xFE]) ## CS1: JIS X 0208-1990
35			\|\x00([\xA1-\xFE]) ## CS2: JIS X 0201 Katakana
36			\|([\x21-\x7E][\xA1-\xFE]) ## CS3: JIS X 0201-1990
37			}{
38			my ($c0, $c1, $c3) = ($1, $2, $3);
39			if ($c0) { $c0 }
40			elsif ($c1) { $c1 =~ tr/\x80-\xFF/\x00-\x7F/; $c1 }
41			else { $c3 =~ tr/\x80-\xFF/\x00-\x7F/; $c3 }
42			}gex;
43			return Encode::decode ('euc-jp', $str);
44			}
45
46			package Encode::EUCFixed::TW;
47			use base qw(Encode::Encoding);
48	wakaba	1.3	__PACKAGE__->Define (qw/cns-11643-1986-appendix DEC.CNS11643.1986-2/);
49	wakaba	1.1
50			sub encode ($$;$) {
51			require Encode::HanExtra;
52			my ($obj, $str, $chk) = @_;
53			$_[1] = '' if $chk;
54			$str = Encode::encode ('euc-tw', $str);
55			$str =~ s{
56			([\x00-\x8D\x90-\xA0\xFF]) ## CS0: ASCII
57			#([\xA0-\xFE][\xA0-\xFE]) ## CS1: CNS 11643 plane 1
58			\|\x8E\xA1([\xA0-\xFE][\xA0-\xFE]) ## CNS 11643 plane 1
59			\|\x8E\xA2([\xA0-\xFE])([\xA0-\xFE]) ## CNS 11643 plane 2
60			\|\x8E([\xA3-\xFE][\xA0-\xFE][\xA0-\xFE])
61			}{
62			my ($c0, $p1, $p21, $p22, $p3) = ($1, $2, $3, $4, $5);
63			if ($c0) { "\x00".$c0 }
64			elsif ($p1) { $p1 }
65			elsif ($p21) { $p22 =~ tr/\xA1-\xFE/\x21-\x7E/; $p21.$p22 }
66			else { "\x00\x3F" } ## BUG: don't use fallback
67			}gex;
68			return $str;
69			}
70
71			sub decode ($$;$) {
72			require Encode::HanExtra;
73			my ($obj, $str, $chk) = @_;
74			$_[1] = '' if $chk;
75			$str =~ s{
76			\x00([\x00-\xFF]) ## CS0: ASCII
77			#([\xA1-\xFE][\xA1-\xFE]) ## CS1: CNS 11643 plane 1
78			\|([\xA1-\xFE][\x21-\x7E]) ## CNS 11643 plane 2
79			}{
80			my ($c0, $p2) = ($1, $2);
81			if ($c0) { $c0 }
82			else { $p2 =~ tr/\x21-\x7E/\xA1-\xFE/; $p2 }
83			}gex;
84			return Encode::decode ('euc-tw', $str);
85			}
86
87			1;
88			__END__
89
90			=head1 NAME
91
92			Encode::EUCFixed --- Fixed width (or wide) coding system of EUC
93
94	wakaba	1.3	=head1 ENCODINGS
95
96			=over 4
97
98			=item Extended_UNIX_Code_Fixed_Width_for_Japanese
99
100			EUC-japan (packed) based fixed width coding system
101			for wide char. (Alias: csEUCFixWidJapanese (IANA))
102
103			=item cns-11643-1986-appendix
104
105			Fixed width coding system for ASCII and CNS 11643 plane 1 and 2,
106			defined by CNS 11643-1986 appendix.
107			(Alias: DEC.CNS11643.1986-2 (X))
108
109			=back
110
111	wakaba	1.1	=head1 LICENSE
112
113	wakaba	1.2	Copyright 2002 Wakaba <w@suika.fam.cx>
114	wakaba	1.1
115			This library is free software; you can redistribute it
116			and/or modify it under the same terms as Perl itself.
117
118			=head1 CHANGE
119
120	wakaba	1.3	Last update $Date: 2002/09/20 14:01:45 $
121	wakaba	1.1
122			=cut