$VERSION = do { my @r = (q$Revision: 2.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use Encode qw(:fallbacks);
use base
qw(Encode::Encoding);
__PACKAGE__
->Define('hz');
# HZ is a combination of ASCII and escaped GB, so we implement it
# with the GB2312(raw) encoding here. Cf. RFCs 1842 & 1843.
# not ported for EBCDIC. Which should be used, "~" or "\x7E"?
my ($obj,$str,$chk) = @_;
my $GB = Encode
::find_encoding
('gb2312-raw');
my $in_ascii = 1; # default mode is ASCII.
if ($in_ascii) { # ASCII mode
if ($str =~ s/^([\x00-\x7D\x7F]+)//) { # no '~' => ASCII
# EBCDIC should need ascii2native, but not ported.
elsif ($str =~ s/^\x7E\x7E//) { # escaped tilde
elsif ($str =~ s/^\x7E\cJ//) { # '\cJ' == LF in ASCII
elsif ($str =~ s/^\x7E\x7B//) { # '~{'
else { # encounters an invalid escape, \x80 or greater
else { # GB mode; the byte ranges are as in RFC 1843.
if ($str =~ s/^((?:[\x21-\x77][\x21-\x7E])+)//) {
$ret .= $GB->decode($1, $chk);
elsif ($str =~ s/^\x7E\x7D//) { # '~}'
$_[1] = '' if $chk; # needs_lines guarantees no partial character
my ($obj, undef, $src, $pos, $trm, $chk) = @_;
my ($rdst, $rsrc, $rpos) = \
@_[1..3];
my $GB = Encode
::find_encoding
('gb2312-raw');
my $in_ascii = 1; # default mode is ASCII.
my $ini_pos = pos($$rsrc);
substr($src, 0, $pos) = '';
my $ini_len = bytes
::length($src);
# $trm is the first of the pair '~~', then 2nd tilde is to be removed.
# XXX: Is better C<$src =~ s/^\x7E// or die if ...>?
$src =~ s/^\x7E// if $trm eq "\x7E";
if ($in_ascii) { # ASCII mode
if ($src =~ s/^([\x00-\x7D\x7F])//) { # no '~' => ASCII
elsif ($src =~ s/^\x7E\x7E//) { # escaped tilde
elsif ($src =~ s/^\x7E\cJ//) { # '\cJ' == LF in ASCII
elsif ($src =~ s/^\x7E\x7B//) { # '~{'
else { # encounters an invalid escape, \x80 or greater
else { # GB mode; the byte ranges are as in RFC 1843.
if ($src =~ s/^((?:[\x21-\x77][\x21-\x7F])+)//) {
$now = $GB->decode($1, $chk);
elsif ($src =~ s/^\x7E\x7D//) { # '~}'
$$rpos = $ini_pos + $pos + $ini_len - bytes
::length($src);
$$rpos = $ini_pos + $pos + $ini_len - bytes
::length($src);
return ''; # terminator not found
my ($obj,$str,$chk) = @_;
my $GB = Encode
::find_encoding
('gb2312-raw');
my $in_ascii = 1; # default mode is ASCII.
no warnings
'utf8'; # $str may be malformed UTF8 at the end of a chunk.
if ($str =~ s/^([[:ascii:]]+)//) {
$tmp =~ s/~/~~/g; # escapes tildes
$ret .= "\x7E\x7D"; # '~}'
$ret .= pack 'a*', $tmp; # remove UTF8 flag.
elsif ($str =~ s/(.)//) {
my $tmp = $GB->encode($s, $chk);
if (length $tmp == 2) { # maybe a valid GB char (XXX)
$ret .= "\x7E\x7B"; # '~{'
elsif (length $tmp) { # maybe FALLBACK in ASCII (XXX)
$ret .= "\x7E\x7D"; # '~}'
else { # if $str is malformed UTF8 *and* if length $str != 0.
# The state at the end of the chunk is discarded, even if in GB mode.
# That results in the combination of GB-OUT and GB-IN, i.e. "~}~{".
# Parhaps it is harmless, but further investigations may be required...
$ret .= "\x7E\x7D"; # '~}'
Encode::CN::HZ -- internally used by Encode::CN