[PATCH] Encode.pm to use escape-sequence encoding

Date: Sat, 30 Jun 2001 07:33:37 +0900
Message-Id: <20010630073226.7C79.BQW10602@nifty.com>

Subject: Re: [PATCH] Encode.pm to use escape-sequence encoding
From: SADAHIRO Tomoyuki <BQW10602@nifty.com>
Date: Sat, 30 Jun 2001 21:38:14 +0900
Message-Id: <20010630213554.F67A.BQW10602@nifty.com>

p4raw-id: //depot/perl@11036

4 files changed, 151 insertions, 9 deletions

diff --git a/ext/Encode/Encode/7bit-jis.enc b/ext/Encode/Encode/7bit-jis.enc
new file mode 100644
index 0000000000..eae9e31ba9
--- /dev/null
+++ b/ext/Encode/Encode/7bit-jis.enc
@@ -0,0 +1,12 @@
+# Encoding file: 7bit-jis, escape-driven
+E
+name		7bit-jis
+init		{}
+final		{}
+ascii		\x1b(B
+ascii		\x1b(J
+7bit-kana	\x1b(I
+jis0208		\x1b$B
+jis0208		\x1b$@
+jis0208		\x1b&@\x1b$B
+jis0212		\x1b$(D
diff --git a/ext/Encode/Encode/7bit-kana.enc b/ext/Encode/Encode/7bit-kana.enc
new file mode 100644
index 0000000000..871dbf669a
--- /dev/null
+++ b/ext/Encode/Encode/7bit-kana.enc
@@ -0,0 +1,20 @@
+# Encoding file: 7bit-kana, single-byte
+S
+0025 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D00000000
+0010001100120013001400150016001700180019001A0000001C001D001E001F
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/ext/Encode/Encode/7bit-kr.enc b/ext/Encode/Encode/7bit-kr.enc
new file mode 100644
index 0000000000..30c53952ff
--- /dev/null
+++ b/ext/Encode/Encode/7bit-kr.enc
@@ -0,0 +1,7 @@
+# Encoding file: 7bit-kr, escape-driven
+E
+name		7bit-kr
+init		\x1b$)C
+final		{}
+ascii		\x0f
+ksc5601		\x0e
diff --git a/ext/Encode/Encode/Tcl.pm b/ext/Encode/Encode/Tcl.pm
index dc6455d0a8..f862eef38a 100644
--- a/ext/Encode/Encode/Tcl.pm
+++ b/ext/Encode/Encode/Tcl.pm
@@ -174,7 +174,7 @@ sub decode
  my ($obj,$str,$chk) = @_;
  my $rep   = $obj->{'Rep'};
  my $touni = $obj->{'ToUni'};
- my $uni   = '';
+ my $uni;
  while (length($str))
   {
    my $ch = ord(substr($str,0,1,''));
@@ -204,9 +204,9 @@ sub encode
 {
  my ($obj,$uni,$chk) = @_;
  my $fmuni = $obj->{'FmUni'};
- my $str   = '';
  my $def   = $obj->{'Def'};
  my $rep   = $obj->{'Rep'};
+ my $str;
  while (length($uni))
   {
    my $ch = substr($uni,0,1,'');
@@ -229,27 +229,130 @@ use Carp;
 
 sub read
 {
- my ($class,$fh,$name) = @_;
- my %self = (Name => $name, Num => 0);
+ my ($obj,$fh,$name) = @_;
+ my(%tbl, @esc, $enc);
  while (<$fh>)
   {
    my ($key,$val) = /^(\S+)\s+(.*)$/;
    $val =~ s/^\{(.*?)\}/$1/g;
    $val =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
-   $self{$key} = $val;
+   if($enc = Encode->getEncoding($key)){
+     $tbl{$val} = ref($enc) eq 'Encode::Tcl' ? $enc->loadEncoding : $enc;
+     push @esc, $val;
+   }else{
+     $obj->{$key} = $val;
+   }
   }
- return bless \%self,$class;
+ $obj->{'Ctl'} = \@esc;
+ $obj->{'Tbl'} = \%tbl;
+ return $obj;
 }
 
 sub decode
 {
- croak("Not implemented yet");
+ my ($obj,$str,$chk) = @_;
+ my $tbl = $obj->{'Tbl'};
+ my $ctl = $obj->{'Ctl'};
+ my $ini = $obj->{'init'};
+ my $fin = $obj->{'final'};
+ my $std = $ctl->[0];
+ my $cur = $std;
+ my $uni;
+ while (length($str)){
+   my $uch = substr($str,0,1,'');
+   if($uch eq "\e"){
+    $str =~ s/^([\x20-\x2F]*[\x30-\x7E](?:\x1b[\x20-\x2F]*[\x30-\x7E])*)//;
+    my $esc = "\e$1";
+    if($tbl->{$esc}){ $cur = $esc }
+    elsif($esc eq $ini || $esc eq $fin){ $cur = $std }
+    else{carp "unknown escape sequence" }
+    next;
+   }
+   if($uch eq "\x0e" || $uch eq "\x0f"){
+    $cur = $uch and next;
+   }
+   my $x;
+   if(ref($tbl->{$cur}) eq 'Encode::XS'){
+     $uni .= $tbl->{$cur}->decode($uch);
+     next;
+   }
+   my $ch = ord($uch);
+   my $rep   = $tbl->{$cur}->{'Rep'};
+   my $touni = $tbl->{$cur}->{'ToUni'};
+   if (&$rep($ch) eq 'C')
+    {
+     $x = $touni->[0][$ch];
+    }
+   else
+    {
+     $x = $touni->[$ch][ord(substr($str,0,1,''))];
+    }
+   unless (defined $x)
+    {
+     last if $chk;
+     # What do we do here ?
+     $x = '';
+    }
+   $uni .= $x;
+  }
+ $_[1] = $str if $chk;
+ return $uni;
 }
 
 sub encode
 {
- croak("Not implemented yet");
-}
+ my ($obj,$uni,$chk) = @_;
+ my $tbl = $obj->{'Tbl'};
+ my $ctl = $obj->{'Ctl'};
+ my $ini = $obj->{'init'};
+ my $fin = $obj->{'final'};
+ my $std = $ctl->[0];
+ my $str = $ini;
+ my $pre = $std;
+ my $cur = $pre;
 
+ while (length($uni)){
+  my $ch = chr(ord(substr($uni,0,1,'')));
+  my $x  = ref($tbl->{$pre}) eq 'Encode::XS'
+	? $tbl->{$pre}->encode($ch,1)
+	: $tbl->{$pre}->{FmUni}->{$ch};
+
+  unless(defined $x){
+   foreach my $esc (@$ctl){
+    $x = ref($tbl->{$esc}) eq 'Encode::XS'
+	? $tbl->{$esc}->encode($ch,1)
+	: $tbl->{$esc}->{FmUni}->{$ch};
+    $cur = $esc and last if defined $x;
+   }
+  }
+  if($x == 0x0d && !($ini eq '' && $fin eq '') && substr($uni,0,1) eq "\x0a")
+   {
+    $str .= $cur unless $cur eq $pre;
+    $str .= $fin."\x0d\x0a".$ini;
+    substr($uni,0,1,'');
+    $pre = $std;
+    next;
+   }
+  if(ref($tbl->{$cur}) eq 'Encode::XS'){
+   $str .= $cur unless $cur eq $pre;
+   $str .= $x; # "DEF" is lost
+   $pre = $cur;
+   next;
+  }
+  my $def = $tbl->{$cur}->{'Def'};
+  my $rep = $tbl->{$cur}->{'Rep'};
+  unless (defined $x){
+   last if ($chk);
+   $x = $def;
+  }
+  $str .= $cur unless $cur eq $pre;
+  $str .= pack(&$rep($x),$x);
+  $pre = $cur;
+ }
+ $str .= $std unless $cur eq $std;
+ $str .= $fin;
+ $_[1] = $uni if $chk;
+ return $str;
+}
 1;
 __END__