7 |
use Encode (); |
use Encode (); |
8 |
require Encode::CN; |
require Encode::CN; |
9 |
use base qw(Encode::Encoding); |
use base qw(Encode::Encoding); |
10 |
__PACKAGE__->Define(qw/hz hz-gb-2312/); |
__PACKAGE__->Define(qw/hz chinese-hz hz-gb-2312 cp52936/); |
11 |
|
|
12 |
sub needs_lines { 1 } |
sub needs_lines { 1 } |
13 |
|
|
18 |
sub decode |
sub decode |
19 |
{ |
{ |
20 |
my ($obj,$str,$chk) = @_; |
my ($obj,$str,$chk) = @_; |
21 |
my $gb = Encode::find_encoding('gb2312-raw'); |
my $gb = Encode::find_encoding($obj->__hz_encoding_name); |
22 |
|
|
23 |
$str =~ s{~ # starting tilde |
$str =~ s{~ # starting tilde |
24 |
(?: |
(?: |
42 |
if (defined $t) { # two tildes make one tilde |
if (defined $t) { # two tildes make one tilde |
43 |
'~'; |
'~'; |
44 |
} elsif (defined $c) { # decode the characters |
} elsif (defined $c) { # decode the characters |
45 |
$c =~ tr/\xA1-\xFE/\x21-\x7E/; |
$c =~ tr/\x21-\x7E/\xA1-\xFE/; |
46 |
$gb->decode($c, $chk); |
$gb->decode($c, $chk); |
47 |
} else { # ~\n and invalid escape = '' |
} else { # ~\n and invalid escape = '' |
48 |
''; |
''; |
55 |
sub encode ($$;$) { |
sub encode ($$;$) { |
56 |
my ($obj,$str,$chk) = @_; |
my ($obj,$str,$chk) = @_; |
57 |
$_[1] = ''; |
$_[1] = ''; |
58 |
my $gb = Encode::find_encoding('euc-cn'); |
my $gb = Encode::find_encoding($obj->__hz_encoding_name); |
59 |
|
|
60 |
$str =~ s/~/~~/g; |
$str =~ s/~/~~/g; |
61 |
$str = $gb->encode ($str, 1); |
$str = $gb->encode ($str, 1); |
68 |
$str; |
$str; |
69 |
} |
} |
70 |
|
|
71 |
package Encode::HZ::HZ8; |
sub __hz_encoding_name { 'euc-cn' } |
72 |
|
|
73 |
|
package Encode::HZ::HZ8; |
74 |
use base qw(Encode::HZ); |
use base qw(Encode::HZ); |
75 |
__PACKAGE__->Define(qw/hz8 x-hz8/); |
__PACKAGE__->Define(qw/hz8 x-hz8/); |
76 |
|
|
77 |
sub encode ($$;$) { |
sub encode ($$;$) { |
78 |
my ($obj,$str,$chk) = @_; |
my ($obj,$str,$chk) = @_; |
79 |
$_[1] = ''; |
$_[1] = ''; |
80 |
my $gb = Encode::find_encoding('euc-cn'); |
my $gb = Encode::find_encoding($obj->__hz_encoding_name); |
81 |
|
|
82 |
$str =~ s/~/~~/g; |
$str =~ s/~/~~/g; |
83 |
$str = $gb->encode ($str, 1); |
$str = $gb->encode ($str, 1); |
88 |
$str; |
$str; |
89 |
} |
} |
90 |
|
|
91 |
|
package Encode::HZ::HZ165; |
92 |
|
use base qw(Encode::HZ); |
93 |
|
__PACKAGE__->Define(qw/hz-isoir165 x-iso-ir-165-hz/); |
94 |
|
|
95 |
|
sub __hz_encoding_name { 'cn-gb-isoir165' } |
96 |
|
|
97 |
1; |
1; |
98 |
__END__ |
__END__ |
99 |
|
|
|
|
|
100 |
=head1 NAME |
=head1 NAME |
101 |
|
|
102 |
Encode::HZ --- Encode module for HZ (HZ-GB-2312), HZ8 |
Encode::HZ --- Encode module for HZ (HZ-GB-2312 and HZ for |
103 |
|
ISO-IR 165) and HZ8 |
104 |
|
|
105 |
=head1 DESCRIPTION |
=head1 DESCRIPTION |
106 |
|
|
111 |
HZ (HZ-GB-2312 in IANA name), but other variants such as |
HZ (HZ-GB-2312 in IANA name), but other variants such as |
112 |
HZ8 can't be encoded/decode. |
HZ8 can't be encoded/decode. |
113 |
|
|
114 |
|
=head1 ENCODINGS |
115 |
|
|
116 |
|
=over 4 |
117 |
|
|
118 |
|
=item hz-gb-2312 |
119 |
|
|
120 |
|
HZ 7-bit encoding for Chinese with GB 2312-80, |
121 |
|
defined by RFC 1842 and RFC 1843. |
122 |
|
(Alias: hz, chinese-hz (emacsen), CP52936 (M$)) |
123 |
|
|
124 |
|
=item hz8 |
125 |
|
|
126 |
|
HZ 8-bit encoding for Chinese with GB 2312-80. |
127 |
|
(Alias: x-hz8) |
128 |
|
|
129 |
|
=item hz-isoir165 |
130 |
|
|
131 |
|
HZ 7-bit encoding for Chinese with ISO-IR 165 |
132 |
|
(syntax is same as hz-gb-2312, but coded character |
133 |
|
set is differ) (Alias: x-iso-ir-165-hz) |
134 |
|
|
135 |
|
Note that you need load Encode module that support |
136 |
|
'cn-gb-isoir165' encoding (defined by RFC 1922), |
137 |
|
such as Encode::ISO2022::EightBit. |
138 |
|
|
139 |
|
=back |
140 |
|
|
141 |
=head1 TODO |
=head1 TODO |
142 |
|
|
143 |
Support of extended HZ such as EHZ. |
Support of extended HZ such as EHZ. |
154 |
and/or modify it under the same terms as Perl itself. |
and/or modify it under the same terms as Perl itself. |
155 |
|
|
156 |
=cut |
=cut |
157 |
|
|
158 |
|
# $Date$ |
159 |
|
### HZ.pm ends here |