root/lang/perl/Encode-JP-Mobile/trunk/lib/Encode/JP/Mobile/Vodafone.pm @ 5259

package Encode::JP::Mobile::Vodafone;
use strict;
use base qw(Encode::Encoding);
__PACKAGE__->Define(qw(x-sjis-vodafone-raw));

use Encode::Alias;
define_alias('x-sjis-softbank-raw' => 'x-sjis-vodafone-raw');

# G! => E001, G" => E002, G# => E003 ...
# E! => E101, F! => E201, O! => E301, P! => E401, Q! => E501
my %HighCharToBit = (G => 0xE000, E => 0xE100, F => 0xE200,
                     O => 0xE300, P => 0xE400, Q => 0xE500);
my %HighBitToChar = reverse %HighCharToBit;

my $range = '\x{E001}-\x{E05A}\x{E101}-\x{E15A}\x{E201}-\x{E25A}\x{E301}-\x{E34D}\x{E401}-\x{E44C}\x{E501}-\x{E539}';
my $InRange  = "[$range]";
my $OutRange = "[^$range]";

sub decode($$;$) {
    my($self, $char, $check) = @_;
    my $str = Encode::decode("cp932", $char, Encode::FB_PERLQQ);
    $str =~ s{\x1b\x24([GEFOPQ])([\x20-\x7F]+)\x0f}{
        join '', map chr($HighCharToBit{$1} | ord($_) - 32), split //, $2;
    }ge;
    $_[1] = $str if $check;
    $str;
}

sub encode($$;$) {
    my($self, $str, $check) = @_;
    my $res = '';
    $str =~ tr/\x{301C}/\x{FF5E}/; # ad-hoc solution for  FULLWIDTH TILDE Problem
    $str =~ s{($InRange+)|($OutRange+)}{
        my $in = defined $1;
        my $m  = $in ? $1 : $2;
        $res .= $in ? _encode_vodafone($m)
            : Encode::encode("cp932", $m, $check);
        ''
    }egs;
    $_[1] = $res if $check;
    $res;
}

sub _encode_vodafone {
    my $str = shift;
    my @str = split //, $str;
    my $res = "\x1b\x24";
    my $buf = '';
    for my $str (@str) {
        my $high = ord($str) & 0xEF00;
        my $low  = ord($str) & 0x00FF;
        if ($buf ne $high) {
            $res .= $HighBitToChar{$high};
        }
        $res .= chr($low+32);
        $buf = $high;
    }
    $res . "\x0f";
}

1;