summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Encode/CN/HZ.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Encode/CN/HZ.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/CN/HZ.pm196
1 files changed, 0 insertions, 196 deletions
diff --git a/Master/tlpkg/tlperl/lib/Encode/CN/HZ.pm b/Master/tlpkg/tlperl/lib/Encode/CN/HZ.pm
deleted file mode 100644
index fbc6ba60ced..00000000000
--- a/Master/tlpkg/tlperl/lib/Encode/CN/HZ.pm
+++ /dev/null
@@ -1,196 +0,0 @@
-package Encode::CN::HZ;
-
-use strict;
-
-use vars qw($VERSION);
-$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"?
-
-sub needs_lines { 1 }
-
-sub decode ($$;$)
-{
- my ($obj,$str,$chk) = @_;
-
- my $GB = Encode::find_encoding('gb2312-raw');
- my $ret = '';
- my $in_ascii = 1; # default mode is ASCII.
-
- while (length $str) {
- if ($in_ascii) { # ASCII mode
- if ($str =~ s/^([\x00-\x7D\x7F]+)//) { # no '~' => ASCII
- $ret .= $1;
- # EBCDIC should need ascii2native, but not ported.
- }
- elsif ($str =~ s/^\x7E\x7E//) { # escaped tilde
- $ret .= '~';
- }
- elsif ($str =~ s/^\x7E\cJ//) { # '\cJ' == LF in ASCII
- 1; # no-op
- }
- elsif ($str =~ s/^\x7E\x7B//) { # '~{'
- $in_ascii = 0; # to GB
- }
- else { # encounters an invalid escape, \x80 or greater
- last;
- }
- }
- 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//) { # '~}'
- $in_ascii = 1;
- }
- else { # invalid
- last;
- }
- }
- }
- $_[1] = '' if $chk; # needs_lines guarantees no partial character
- return $ret;
-}
-
-sub cat_decode {
- my ($obj, undef, $src, $pos, $trm, $chk) = @_;
- my ($rdst, $rsrc, $rpos) = \@_[1..3];
-
- my $GB = Encode::find_encoding('gb2312-raw');
- my $ret = '';
- 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";
-
- while (length $src) {
- my $now;
- if ($in_ascii) { # ASCII mode
- if ($src =~ s/^([\x00-\x7D\x7F])//) { # no '~' => ASCII
- $now = $1;
- }
- elsif ($src =~ s/^\x7E\x7E//) { # escaped tilde
- $now = '~';
- }
- elsif ($src =~ s/^\x7E\cJ//) { # '\cJ' == LF in ASCII
- next;
- }
- elsif ($src =~ s/^\x7E\x7B//) { # '~{'
- $in_ascii = 0; # to GB
- next;
- }
- else { # encounters an invalid escape, \x80 or greater
- last;
- }
- }
- 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//) { # '~}'
- $in_ascii = 1;
- next;
- }
- else { # invalid
- last;
- }
- }
-
- next if ! defined $now;
-
- $ret .= $now;
-
- if ($now eq $trm) {
- $$rdst .= $ret;
- $$rpos = $ini_pos + $pos + $ini_len - bytes::length($src);
- pos($$rsrc) = $ini_pos;
- return 1;
- }
- }
-
- $$rdst .= $ret;
- $$rpos = $ini_pos + $pos + $ini_len - bytes::length($src);
- pos($$rsrc) = $ini_pos;
- return ''; # terminator not found
-}
-
-
-sub encode($$;$)
-{
- my ($obj,$str,$chk) = @_;
-
- my $GB = Encode::find_encoding('gb2312-raw');
- my $ret = '';
- my $in_ascii = 1; # default mode is ASCII.
-
- no warnings 'utf8'; # $str may be malformed UTF8 at the end of a chunk.
-
- while (length $str) {
- if ($str =~ s/^([[:ascii:]]+)//) {
- my $tmp = $1;
- $tmp =~ s/~/~~/g; # escapes tildes
- if (! $in_ascii) {
- $ret .= "\x7E\x7D"; # '~}'
- $in_ascii = 1;
- }
- $ret .= pack 'a*', $tmp; # remove UTF8 flag.
- }
- elsif ($str =~ s/(.)//) {
- my $s = $1;
- my $tmp = $GB->encode($s, $chk);
- last if !defined $tmp;
- if (length $tmp == 2) { # maybe a valid GB char (XXX)
- if ($in_ascii) {
- $ret .= "\x7E\x7B"; # '~{'
- $in_ascii = 0;
- }
- $ret .= $tmp;
- }
- elsif (length $tmp) { # maybe FALLBACK in ASCII (XXX)
- if (!$in_ascii) {
- $ret .= "\x7E\x7D"; # '~}'
- $in_ascii = 1;
- }
- $ret .= $tmp;
- }
- }
- else { # if $str is malformed UTF8 *and* if length $str != 0.
- last;
- }
- }
- $_[1] = $str if $chk;
-
- # 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...
-
- if (! $in_ascii) {
- $ret .= "\x7E\x7D"; # '~}'
- $in_ascii = 1;
- }
- return $ret;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Encode::CN::HZ -- internally used by Encode::CN
-
-=cut