File Coverage

lib/mb/Encode.pm

Criterion	Covered	Total	%
statement	79	83	95.1
branch	4	8	50.0
condition			n/a
subroutine	35	35	100.0
pod	0	30	0.0
total	118	156	75.6

package mb::Encode;
######################################################################
#
# mb::Encode - provides MBCS encoder and decoder
#
# https://metacpan.org/dist/mb-Encode
#
# Copyright (c) 2021, 2022 INABA Hitoshi  in a CPAN
######################################################################

use 5.00503;    # Universal Consensus 1998 for primetools
# use 5.008001; # Lancaster Consensus 2013 for toolchains

$VERSION = '0.04';
$VERSION = $VERSION;

require Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw(
    to_big5       big5       by_big5
    to_big5hkscs  big5hkscs  by_big5hkscs
    to_cp932      cp932      by_cp932
    to_cp936      cp936      by_cp936
    to_cp949      cp949      by_cp949
    to_cp950      cp950      by_cp950
    to_eucjp      eucjp      by_eucjp
    to_gbk        gbk        by_gbk
    to_sjis       sjis       by_sjis
    to_uhc        uhc        by_uhc
);

use strict;
BEGIN {
    if ($] >= 5.008_001) {
        eval q{
use warnings;    # pmake.bat catches /^use .../
use Encode qw(); # pmake.bat catches /^use .../
        };
    }
    else {
        eval q{
use Jacode;
        };
    }
}

#-------------------------------------------------------------------------------------
# return octets to any encoding
sub to_big5      ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5',      ); $oct }
sub to_big5hkscs ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5-hkscs',); $oct }
sub to_cp936     ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp936',     ); $oct }
sub to_cp949     ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp949',     ); $oct }
sub to_cp950     ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp950',     ); $oct }
sub to_eucjp     ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'euc-jp',    ); $oct }
sub to_gbk       ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'gbk',       ); $oct }
sub to_sjis      ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'sjis',      ); $oct }
sub to_uhc       ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'uhc',       ); $oct }
sub to_cp932     ($) {
    my $oct = $_[0];
    if ($] >= 5.008_001) {
        Encode::from_to($oct, 'utf8', 'cp932');
    }
    else {
        Jacode::convert(\$oct, 'sjis', 'utf8');
    }
    return $oct;
}

#-------------------------------------------------------------------------------------
# shorthand of mb::Encode::to_XXXX
sub big5         ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5',      ); $oct }
sub big5hkscs    ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5-hkscs',); $oct }
sub cp936        ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp936',     ); $oct }
sub cp949        ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp949',     ); $oct }
sub cp950        ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp950',     ); $oct }
sub eucjp        ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'euc-jp',    ); $oct }
sub gbk          ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'gbk',       ); $oct }
sub sjis         ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'sjis',      ); $oct }
sub uhc          ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'uhc',       ); $oct }
sub cp932        ($) {
    my $oct = $_[0];
    if ($] >= 5.008_001) {
        Encode::from_to($oct, 'utf8', 'cp932');
    }
    else {
        Jacode::convert(\$oct, 'sjis', 'utf8');
    }
    return $oct;
}

#-------------------------------------------------------------------------------------
# return octets from any encoding
sub by_big5      ($) { Encode::from_to(my $oct=$_[0], 'big5',       'utf8',); $oct }
sub by_big5hkscs ($) { Encode::from_to(my $oct=$_[0], 'big5-hkscs', 'utf8',); $oct }
sub by_cp936     ($) { Encode::from_to(my $oct=$_[0], 'cp936',      'utf8',); $oct }
sub by_cp949     ($) { Encode::from_to(my $oct=$_[0], 'cp949',      'utf8',); $oct }
sub by_cp950     ($) { Encode::from_to(my $oct=$_[0], 'cp950',      'utf8',); $oct }
sub by_eucjp     ($) { Encode::from_to(my $oct=$_[0], 'euc-jp',     'utf8',); $oct }
sub by_gbk       ($) { Encode::from_to(my $oct=$_[0], 'gbk',        'utf8',); $oct }
sub by_sjis      ($) { Encode::from_to(my $oct=$_[0], 'sjis',       'utf8',); $oct }
sub by_uhc       ($) { Encode::from_to(my $oct=$_[0], 'uhc',        'utf8',); $oct }
sub by_cp932     ($) {
    my $oct = $_[0];
    if ($] >= 5.008_001) {
        Encode::from_to($oct, 'cp932', 'utf8');
    }
    else {
        Jacode::convert(\$oct, 'utf8', 'sjis');
    }
    return $oct;
}

1;

__END__