Parent Directory
| 
Revision Log
2002-09-16 Wakaba <w@suika.fam.cx> * ISO2022.pm: - (iso2022_to_internal): Invoke G1,G2,G3 by locking shifts of ESC Fs style. - (make_initial_charset): Create charset definition of 94^2 DRCSes. - (undef_char): New option. - (pod:TODO): New section. * HZ.pm: - (__hz_encoding_name): New function. - (Encode::HZ): Added new alias names. - (Encode::HZ::HZ165): New package. - (pod:ENCODINGS): New section.
| 1 | wakaba | 1.1 | package Encode::HZ; |
| 2 | use strict; | ||
| 3 | |||
| 4 | use vars qw($VERSION); | ||
| 5 | wakaba | 1.3 | $VERSION = do {my @r =(q$Revision: 1.2 $ =~ /\d+/g);sprintf "%d."."%02d" x $#r, @r}; |
| 6 | wakaba | 1.1 | |
| 7 | use Encode (); | ||
| 8 | require Encode::CN; | ||
| 9 | use base qw(Encode::Encoding); | ||
| 10 | wakaba | 1.3 | __PACKAGE__->Define(qw/hz chinese-hz hz-gb-2312 cp52936/); |
| 11 | wakaba | 1.1 | |
| 12 | sub needs_lines { 1 } | ||
| 13 | |||
| 14 | sub perlio_ok { | ||
| 15 | return 0; # for the time being | ||
| 16 | } | ||
| 17 | |||
| 18 | sub decode | ||
| 19 | { | ||
| 20 | my ($obj,$str,$chk) = @_; | ||
| 21 | wakaba | 1.3 | my $gb = Encode::find_encoding($obj->__hz_encoding_name); |
| 22 | wakaba | 1.1 | |
| 23 | $str =~ s{~ # starting tilde | ||
| 24 | (?: | ||
| 25 | (~) # another tilde - escaped (set $1) | ||
| 26 | | # or | ||
| 27 | \x0D?\x0A # \n - output nothing | ||
| 28 | | # or | ||
| 29 | \{ # opening brace of GB data | ||
| 30 | ( # set $2 to any number of... | ||
| 31 | (?: | ||
| 32 | [^~] # non-tilde GB character | ||
| 33 | | # or | ||
| 34 | ~(?!\}) # tilde not followed by a closing brace | ||
| 35 | )* | ||
| 36 | ) | ||
| 37 | ~\} # closing brace of GB data | ||
| 38 | | # XXX: invalid escape - maybe die on $chk? | ||
| 39 | ) | ||
| 40 | }{ | ||
| 41 | my ($t, $c) = ($1, $2); | ||
| 42 | if (defined $t) { # two tildes make one tilde | ||
| 43 | '~'; | ||
| 44 | } elsif (defined $c) { # decode the characters | ||
| 45 | wakaba | 1.3 | $c =~ tr/\x21-\x7E/\xA1-\xFE/; |
| 46 | wakaba | 1.1 | $gb->decode($c, $chk); |
| 47 | } else { # ~\n and invalid escape = '' | ||
| 48 | ''; | ||
| 49 | } | ||
| 50 | }egx; | ||
| 51 | |||
| 52 | return $str; | ||
| 53 | } | ||
| 54 | |||
| 55 | sub encode ($$;$) { | ||
| 56 | my ($obj,$str,$chk) = @_; | ||
| 57 | $_[1] = ''; | ||
| 58 | wakaba | 1.3 | my $gb = Encode::find_encoding($obj->__hz_encoding_name); |
| 59 | wakaba | 1.1 | |
| 60 | $str =~ s/~/~~/g; | ||
| 61 | $str = $gb->encode ($str, 1); | ||
| 62 | |||
| 63 | $str =~ s{ ((?:[\xA1-\xFE][\xA1-\xFE])+) }{ | ||
| 64 | my $c = $1; | ||
| 65 | $c =~ tr/\xA1-\xFE/\x21-\x7E/; | ||
| 66 | sprintf q(~{%s~}), $c; | ||
| 67 | }goex; | ||
| 68 | $str; | ||
| 69 | } | ||
| 70 | |||
| 71 | wakaba | 1.3 | sub __hz_encoding_name { 'euc-cn' } |
| 72 | |||
| 73 | wakaba | 1.1 | package Encode::HZ::HZ8; |
| 74 | use base qw(Encode::HZ); | ||
| 75 | wakaba | 1.2 | __PACKAGE__->Define(qw/hz8 x-hz8/); |
| 76 | wakaba | 1.1 | |
| 77 | sub encode ($$;$) { | ||
| 78 | my ($obj,$str,$chk) = @_; | ||
| 79 | $_[1] = ''; | ||
| 80 | wakaba | 1.3 | my $gb = Encode::find_encoding($obj->__hz_encoding_name); |
| 81 | wakaba | 1.1 | |
| 82 | $str =~ s/~/~~/g; | ||
| 83 | $str = $gb->encode ($str, 1); | ||
| 84 | |||
| 85 | $str =~ s{ ((?:[\xA1-\xFE][\xA1-\xFE])+) }{ | ||
| 86 | sprintf q(~{%s~}), $1; | ||
| 87 | }goex; | ||
| 88 |