1 package Encode::CN::HZ;
6 $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
8 use Encode qw(:fallbacks);
10 use base qw(Encode::Encoding);
11 __PACKAGE__->Define('hz');
13 # HZ is a combination of ASCII and escaped GB, so we implement it
14 # with the GB2312(raw) encoding here. Cf. RFCs 1842 & 1843.
16 # not ported for EBCDIC. Which should be used, "~" or "\x7E"?
25 my ($obj,$str,$chk) = @_;
27 my $GB = Encode::find_encoding('gb2312-raw');
29 my $in_ascii = 1; # default mode is ASCII.
32 if ($in_ascii) { # ASCII mode
33 if ($str =~ s/^([\x00-\x7D\x7F]+)//) { # no '~' => ASCII
35 # EBCDIC should need ascii2native, but not ported.
37 elsif ($str =~ s/^\x7E\x7E//) { # escaped tilde
40 elsif ($str =~ s/^\x7E\cJ//) { # '\cJ' == LF in ASCII
43 elsif ($str =~ s/^\x7E\x7B//) { # '~{'
44 $in_ascii = 0; # to GB
46 else { # encounters an invalid escape, \x80 or greater
50 else { # GB mode; the byte ranges are as in RFC 1843.
51 if ($str =~ s/^((?:[\x21-\x77][\x21-\x7E])+)//) {
52 $ret .= $GB->decode($1, $chk);
54 elsif ($str =~ s/^\x7E\x7D//) { # '~}'
69 my ($obj, undef, $src, $pos, $trm, $chk) = @_;
70 my ($rdst, $rsrc, $rpos) = \@_[1..3];
72 my $GB = Encode::find_encoding('gb2312-raw');
74 my $in_ascii = 1; # default mode is ASCII.
76 my $ini_pos = pos($$rsrc);
78 substr($src, 0, $pos) = '';
80 my $ini_len = bytes::length($src);
82 # $trm is the first of the pair '~~', then 2nd tilde is to be removed.
83 # XXX: Is better C<$src =~ s/^\x7E// or die if ...>?
84 $src =~ s/^\x7E// if $trm eq "\x7E";
88 if ($in_ascii) { # ASCII mode
89 if ($src =~ s/^([\x00-\x7D\x7F])//) { # no '~' => ASCII
92 elsif ($src =~ s/^\x7E\x7E//) { # escaped tilde
95 elsif ($src =~ s/^\x7E\cJ//) { # '\cJ' == LF in ASCII
98 elsif ($src =~ s/^\x7E\x7B//) { # '~{'
99 $in_ascii = 0; # to GB
102 else { # encounters an invalid escape, \x80 or greater
106 else { # GB mode; the byte ranges are as in RFC 1843.
107 if ($src =~ s/^((?:[\x21-\x77][\x21-\x7F])+)//) {
108 $now = $GB->decode($1, $chk);
110 elsif ($src =~ s/^\x7E\x7D//) { # '~}'
119 next if ! defined $now;
125 $$rpos = $ini_pos + $pos + $ini_len - bytes::length($src);
126 pos($$rsrc) = $ini_pos;
132 $$rpos = $ini_pos + $pos + $ini_len - bytes::length($src);
133 pos($$rsrc) = $ini_pos;
134 return ''; # terminator not found
140 my ($obj,$str,$chk) = @_;
142 my $GB = Encode::find_encoding('gb2312-raw');
144 my $in_ascii = 1; # default mode is ASCII.
146 no warnings 'utf8'; # $str may be malformed UTF8 at the end of a chunk.
148 while (length $str) {
149 if ($str =~ s/^([[:ascii:]]+)//) {
151 $tmp =~ s/~/~~/g; # escapes tildes
153 $ret .= "\x7E\x7D"; # '~}'
156 $ret .= pack 'a*', $tmp; # remove UTF8 flag.
158 elsif ($str =~ s/(.)//) {
159 my $tmp = $GB->encode($1, $chk);
160 last if !defined $tmp;
161 if (length $tmp == 2) { # maybe a valid GB char (XXX)
163 $ret .= "\x7E\x7B"; # '~{'
168 elsif (length $tmp) { # maybe FALLBACK in ASCII (XXX)
170 $ret .= "\x7E\x7D"; # '~}'
176 else { # if $str is malformed UTF8 *and* if length $str != 0.
180 $_[1] = $str if $chk;
182 # The state at the end of the chunk is discarded, even if in GB mode.
183 # That results in the combination of GB-OUT and GB-IN, i.e. "~}~{".
184 # Parhaps it is harmless, but further investigations may be required...
187 $ret .= "\x7E\x7D"; # '~}'
198 Encode::CN::HZ -- internally used by Encode::CN