File Coverage

blib/lib/Encode/IBM/835SOSI/TSGH.pm

Criterion	Covered	Total	%
statement	12	34	35.2
branch	0	6	0.0
condition	0	12	0.0
subroutine	4	6	66.6
pod	2	2	100.0
total	18	60	30.0

package Encode::IBM::835SOSI::TSGH;

use strict;
use vars qw($VERSION);
$VERSION = '1.01';

use Encode ();

use base qw(Encode::Encoding);
__PACKAGE__->Define('ibm-835-sosi-tsgh');

my $base37;
my $base835;

sub decode
{
    my ($obj,$str,$chk) = @_;

    $base37 ||= Encode::find_encoding('cp37');
    $base835 ||= Encode::find_encoding('ibm-835');
    #$str =~ s/\x00/K/g;
    $str =~ s/\x00/\x40/g;
    $str =~ s/\x30\xe1/Fg/g;    # MAKE SMALL
    $str =~ s/\x30\xe0//g;      # MAKE LARGE
    #$str =~ s/\x30\xe0/Mh/g;

    my $out;
    foreach my $chunk (split(/\x28([^\x29]*\x29)/, $str)) {
        if ($chunk =~ /\x29\z/) {
            chop $chunk;
            $chunk =~ s/\@\@/iJ/g;
            $out .= $base835->decode($chunk);
        }
        else {
            $out .= $base37->decode($chunk);
        }
    }
    return $out;
}

sub encode
{
    my ($obj,$str,$chk) = @_;

    $base37 ||= Encode::find_encoding('cp37');
    $base835 ||= Encode::find_encoding('ibm-835');

    if ($str =~ s/^([\x00-\xff]+)//) {
        # english
        my $sub = $1;
        return $base37->encode($sub) . $obj->encode($str, $chk);
    }
    elsif ($str =~ s/^([^\x00-\xff]+)//) {
        # chinese - shift in + shift out
        my $sub = $1;
        return "\x28".$base835->encode($sub)."\x29".$obj->encode($str, $chk);
    }
}

1;
__END__