lib/Encode/HZ.pm

package Encode::HZ;
use strict;

use vars qw($VERSION);
$VERSION = do {my @r =(q$Revision: 1.2 $ =~ /\d+/g);sprintf "%d."."%02d" x $#r, @r};

use Encode ();
require Encode::CN;
use base qw(Encode::Encoding);
__PACKAGE__->Define(qw/hz chinese-hz hz-gb-2312 cp52936/);

sub needs_lines  { 1 }

sub perlio_ok { 
    return 0; # for the time being
}

sub decode
{
    my ($obj,$str,$chk) = @_;
    my $gb = Encode::find_encoding($obj->__hz_encoding_name);

    $str =~ s{~                 # starting tilde
        (?:
            (~)                 # another tilde - escaped (set $1)
                |               #     or
            \x0D?\x0A                   # \n - output nothing
                |               #     or
            \{                  # opening brace of GB data
                (               #  set $2 to any number of...
                    (?: 
                        [^~]    #  non-tilde GB character
                            |   #     or
                        ~(?!\}) #  tilde not followed by a closing brace
                    )*
                )
            ~\}                 # closing brace of GB data
                |               # XXX: invalid escape - maybe die on $chk?
        )
    }{
      my ($t, $c) = ($1, $2);
      if (defined $t) { # two tildes make one tilde
        '~';
      } elsif (defined $c) {    # decode the characters
        $c =~ tr/\x21-\x7E/\xA1-\xFE/;
        $gb->decode($c, $chk);
      } else {  # ~\n and invalid escape = ''
        '';
      }
    }egx;
    
    return $str;
}

sub encode ($$;$) {
  my ($obj,$str,$chk) = @_;
  $_[1] = '';
  my $gb = Encode::find_encoding($obj->__hz_encoding_name);
  
  $str =~ s/~/~~/g;
  $str = $gb->encode ($str, 1);
  
  $str =~ s{ ((?:[\xA1-\xFE][\xA1-\xFE])+) }{
    my $c = $1;
    $c =~ tr/\xA1-\xFE/\x21-\x7E/;
    sprintf q(~{%s~}), $c;
  }goex;
  $str;
}

sub __hz_encoding_name { 'euc-cn' }

package Encode::HZ::HZ8;
use base qw(Encode::HZ);
__PACKAGE__->Define(qw/hz8 x-hz8/);

sub encode ($$;$) {
  my ($obj,$str,$chk) = @_;
  $_[1] = '';
  my $gb = Encode::find_encoding($obj->__hz_encoding_name);
  
  $str =~ s/~/~~/g;
  $str = $gb->encode ($str, 1);
  
  $str =~ s{ ((?:[\xA1-\xFE][\xA1-\xFE])+) }{
    sprintf q(~{%s~}), $1;
  }goex;
  $str;
}

package Encode::HZ::HZ165;
use base qw(Encode::HZ);
__PACKAGE__->Define(qw/hz-isoir165 x-iso-ir-165-hz/);

sub __hz_encoding_name { 'cn-gb-isoir165' }

1;
__END__

=head1 NAME

Encode::HZ --- Encode module for HZ (HZ-GB-2312 and HZ for
ISO-IR 165) and HZ8

=head1 DESCRIPTION

This module make the module Encode of Perl (5.7.3 or later)
to be able to encode/decode HZ and its variant coding systems.

Note that Encode::CN::HZ, standard module of Perl, can encode/decode
HZ (HZ-GB-2312 in IANA name), but other variants such as
HZ8 can't be encoded/decode.

=head1 ENCODINGS

=over 4

=item hz-gb-2312

HZ 7-bit encoding for Chinese with GB 2312-80,
defined by RFC 1842 and RFC 1843.
(Alias: hz, chinese-hz (emacsen), CP52936 (M$))

=item hz8

HZ 8-bit encoding for Chinese with GB 2312-80.
(Alias: x-hz8)

=item hz-isoir165

HZ 7-bit encoding for Chinese with ISO-IR 165
(syntax is same as hz-gb-2312, but coded character
set is differ) (Alias: x-iso-ir-165-hz)

Note that you need load Encode module that support
'cn-gb-isoir165' encoding (defined by RFC 1922),
such as Encode::ISO2022::EightBit.

=back

=head1 TODO

Support of extended HZ such as EHZ.

=head1 ACKNOWLEDGEMENTS

Most part of this module is taken from Encode::CN::HZ.

=head1 COPYRIGHT

Copyright 2002 Wakaba <w@suika.fam.cx>

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut

# $Date: $
### HZ.pm ends here
1	package Encode::HZ;
2	use strict;
3
4	use vars qw($VERSION);
5	$VERSION = do {my @r =(q$Revision: 1.2 $ =~ /\d+/g);sprintf "%d."."%02d" x $#r, @r};
6
7	use Encode ();
8	require Encode::CN;
9	use base qw(Encode::Encoding);
10	__PACKAGE__->Define(qw/hz chinese-hz hz-gb-2312 cp52936/);
11
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	my $gb = Encode::find_encoding($obj->__hz_encoding_name);
22
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	$c =~ tr/\x21-\x7E/\xA1-\xFE/;
46	$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	my $gb = Encode::find_encoding($obj->__hz_encoding_name);
59
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	sub __hz_encoding_name { 'euc-cn' }
72
73	package Encode::HZ::HZ8;
74	use base qw(Encode::HZ);
75	__PACKAGE__->Define(qw/hz8 x-hz8/);
76
77	sub encode ($$;$) {
78	my ($obj,$str,$chk) = @_;
79	$_[1] = '';
80	my $gb = Encode::find_encoding($obj->__hz_encoding_name);
81
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	$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;
98	__END__
99
100	=head1 NAME
101
102	Encode::HZ --- Encode module for HZ (HZ-GB-2312 and HZ for
103	ISO-IR 165) and HZ8
104
105	=head1 DESCRIPTION
106
107	This module make the module Encode of Perl (5.7.3 or later)
108	to be able to encode/decode HZ and its variant coding systems.
109
110	Note that Encode::CN::HZ, standard module of Perl, can encode/decode
111	HZ (HZ-GB-2312 in IANA name), but other variants such as
112	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
142
143	Support of extended HZ such as EHZ.
144
145	=head1 ACKNOWLEDGEMENTS
146
147	Most part of this module is taken from Encode::CN::HZ.
148
149	=head1 COPYRIGHT
150
151	Copyright 2002 Wakaba <w@suika.fam.cx>
152
153	This library is free software; you can redistribute it
154	and/or modify it under the same terms as Perl itself.
155
156	=cut
157
158	# $Date: $
159	### HZ.pm ends here