Changeset 1434

Timestamp:

11/14/07 09:23:51 (6 years ago)

Author:

tokuhirom

Message:

lang/perl/Encode-JP-Mobile: added encode support at KDDIJIS.

Location:

lang/perl/Encode-JP-Mobile/trunk

Files:

• lib/Encode/JP/Mobile/KDDIJIS.pm (modified) (3 diffs)
• t/kddi-jis.t (modified) (1 diff)

lang/perl/Encode-JP-Mobile/trunk/lib/Encode/JP/Mobile/KDDIJIS.pm

@@ -13 +13 @@
 __PACKAGE__->Define(qw(x-iso-2022-jp-kddi));
 
-# JIS<->EUC
 my $re_scan_jis = qr{
    (?:($RE{JIS_0212})|$RE{JIS_0208}|($RE{ISO_ASC})|($RE{JIS_KANA}))([^\e]*)
@@ -32 +31 @@
 
 sub encode($$;$) {
-    my($self, $str, $check) = @_;
-    croak "ENCODE IS NOT SUPPORTED YET";
+    my ( $obj, $utf8, $chk ) = @_;
+    my $octet = Encode::encode( 'x-sjis-kddi', $utf8, $chk );
+    return sjis_jis( $octet );
+}
+
+sub ASC () { 1 }
+sub JIS_0208 () { 2 }
+sub KANA () { 3 }
+sub sjis_jis {
+    my $octet = shift;
+
+    use bytes;
+
+    my @chars = split //, $octet;
+    my $mode = ASC;
+    my $res = '';
+
+    for (my $i=0; $i<@chars; $i++) {
+        my $x = ord $chars[$i];
+        if ($x < 0x80) {
+            if ($mode != ASC) {
+                $res .= $ESC{ASC};
+                $mode = ASC;
+            }
+            $res .= chr $x;
+        } elsif (0xA1 <= $x && $x <= 0xDF) {
+            if ($mode != KANA) {
+                $res .= $ESC{KANA};
+                $mode = KANA;
+            }
+            $mode = KANA;
+            $res .= chr($x - 0x80);
+        } else {
+            if ($mode != JIS_0208) {
+                $res .= $ESC{JIS_0208};
+                $mode = JIS_0208;
+            }
+            $i++;
+            last unless $i<@chars;
+            my ($c1, $c2) = sjis2jis_one($x, ord $chars[$i]);
+            $res .= chr($c1).chr($c2);
+        }
+    }
+
+    if ($mode != ASC) {
+        $res .= $ESC{ASC};
+    }
+
+    $res;
+}
+sub sjis2jis_one {
+    my ($c1, $c2) = @_;
+
+    # 0x0600 : 0xF340 - 0xF48D
+    # 0x0B00 : 0xF640 - 0xF7FC
+
+    my $c = ($c1<<8) + $c2;
+    if (0xF340 <= $c && $c <= 0xF48D) {
+        $c1 -= 0x06;
+    } elsif (0xF640 <= $c && $c <= 0xF7FC) {
+        $c1 -= 0x0B;
+    }
+
+    $c1 -= ($c1 <= 0x9f) ? 0x71 : 0xB1;
+    $c1 = $c1*2 + 1;
+
+    if ($c2 > 0x7F) {
+        $c2 -= 0x01;
+    }
+
+    if ($c2>=0x9E) {
+        $c2  = $c2-0x7D;
+        $c1++;
+    } else {
+        $c2 -= 0x1F;
+    }
+
+    return ($c1, $c2);
 }
 
@@ -128 +203 @@
 この後で、x-sjis-kddi で decode すれば OK.
 
+encode の場合はこの逆をやればよい。unicode 文字列を sjis のバイト列に encode してやり、
+下記のエリアにある文字列をシフトしてやる。
+
+ * 0x0600 : 0xF340 - 0xF48D
+ * 0x0B00 : 0xF640 - 0xF7FC
+
+こうしてシフトしつつ、iso-2022-jp に変換してやればよい。
+
 =head1 TODO
 

lang/perl/Encode-JP-Mobile/trunk/t/kddi-jis.t

@@ -1 +1 @@
 use strict;
 use warnings;
-use Test::More tests => 5;
+use Test::More tests => 17;
 use Encode::JP::Mobile;
 use Encode::JP::Mobile::KDDIJIS;
 use Encode;
-use Data::Dumper;
 
-is decode("x-iso-2022-jp-kddi", "\e\$B\x75\x41\e(B"), "\x{E488}";
-is decode("x-iso-2022-jp-kddi", "\e\$B\x75\x41\x76\x76\e(B"), "\x{e488}\x{e51b}";
-is decode('x-iso-2022-jp-kddi', encode('iso-2022-jp', decode("utf8", "お"))), decode('utf8', "お"), 'o';
-is decode('x-iso-2022-jp-kddi', encode('iso-2022-jp', decode("utf8", "おいおい。山岡くん。kanbenしてくれよ！"))), decode('utf8', "おいおい。山岡くん。kanbenしてくれよ！"), 'kanji, hiragana, alphabet';
-is decode('x-iso-2022-jp-kddi', "\e\(I\x54\x2F\x4E\x5F\e(B"), decode('utf8', "ﾔｯﾎﾟ"), 'half width katakana';
+sub test_it {
+    my ($jis, $uni, $case) = @_;
+    $case ||= unpack "H*", $uni;
+    
+    is decode("x-iso-2022-jp-kddi", $jis), $uni, "decoding $case";
+    is $jis, encode("x-iso-2022-jp-kddi", $uni), "encoding $case";
+}
+
+test_it("\e\$B\x75\x41\e(B", "\x{E488}", "pictogram");
+
+test_it "a", decode('utf8', 'a'), 'alphabet';
+test_it "\e\$B\x24\x57\e\(B", "\x{3077}", 'kanji(tora)';
+
+is encode('x-iso-2022-jp-kddi', "\x{5bc5}"), encode('iso-2022-jp', "\x{5bc5}"), "kanji";
+
+test_it "\e\$B\x75\x41\e(B", "\x{E488}", 'pictogram';
+test_it "\e\$B\x75\x41\x76\x76\e(B", "\x{e488}\x{e51b}", 'pictogram';
+test_it encode('iso-2022-jp', decode("utf8", "お")), decode('utf8', "お"), 'o';
+test_it encode('iso-2022-jp', decode("utf8", "おいおい。山岡くん。kanbenしてくれよ！表示。")), decode('utf8', "おいおい。山岡くん。kanbenしてくれよ！表示。"), 'kanji, hiragana, alphabet';
+test_it "\e\(I\x54\x2F\x4E\x5F\e(B", decode('utf8', "ﾔｯﾎﾟ"), 'half width katakana';
+
 # is decode('x-iso-2022-jp-kddi', "\e\$(D\x2B\x21\x30\x57\e(B"), "\x{00E1}\x{4F0C}", 'JIS X 0212';
-