1 package Encode::CN::HZ;
6 $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
10 use base 'Encode::Encoding';
12 # HZ is only escaped GB, so we implement it with the
13 # GB2312(raw) encoding here. Cf. RFCs 1842 & 1843.
16 my $obj = bless {name => $canon}, __PACKAGE__;
22 # exists $INC{"PerlIO/encoding.pm"} or return 0;
23 # PerlIO::encoding->VERSION >= 0.03 and return 1;
24 return 0; # for the time being
29 my ($obj,$str,$chk) = @_;
30 my $gb = Encode::find_encoding('gb2312-raw');
32 $str =~ s{~ # starting tilde
34 (~) # another tilde - escaped (set $1)
36 \n # \n - output nothing
38 \{ # opening brace of GB data
39 ( # set $2 to any number of...
41 [^~] # non-tilde GB character
43 ~(?!\}) # tilde not followed by a closing brace
46 ~\} # closing brace of GB data
47 | # XXX: invalid escape - maybe die on $chk?
50 (defined $1) ? '~' # two tildes make one tilde
52 (defined $2) ? $gb->decode($2, $chk) # decode the characters
54 '' # ~\n and invalid escape = ''
62 my ($obj,$str,$chk) = @_;
64 my $gb = Encode::find_encoding('gb2312-raw');
68 # XXX: Since CHECK and partial decoding has not been implemented yet,
69 # we'll use a very crude way to test for GB2312ness.
71 for my $index (0 .. length($str) - 1) {
74 my $char = substr($str, $index, 1);
75 # try to encode this character
76 # with CHECK on so it stops at proper place.
77 # also note that the assignement was braced in eval
80 eval{ $try = $gb->encode($char, 1) };
82 if (defined($try)) { # is a GB character:
84 $out .= $try; # in GB mode - just append it
87 $in_gb = 1; # enter GB mode, then append it
90 } # not a GB character:
92 $in_gb = 0; # leave GB mode, then append it
96 $out .= $char; # not in GB mode - just append it
100 $out .= '~}' if $in_gb; # add closing brace if needed
111 Encode::CN::HZ -- internally used by Encode::CN