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	require 5.7.3;
2	package Encode::EUCFixed;
3	use strict;
4	use vars qw(%DEFAULT $VERSION);
5	$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
6
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	__PACKAGE__->Define (qw/cns-11643-1986-appendix DEC.CNS11643.1986-2/);
49
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	=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	=head1 LICENSE
112
113	Copyright 2002 Wakaba <w@suika.fam.cx>
114
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	Last update $Date: 2002/09/20 14:01:45 $
121
122	=cut