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


line stmt bran cond sub pod time code
1             package mb::Encode;
2             ######################################################################
3             #
4             # mb::Encode - provides MBCS encoder and decoder
5             #
6             # https://metacpan.org/dist/mb-Encode
7             #
8             # Copyright (c) 2021 INABA Hitoshi in a CPAN
9             ######################################################################
10              
11 4     4   14851 use 5.00503; # Universal Consensus 1998 for primetools
  4         32  
12             # use 5.008001; # Lancaster Consensus 2013 for toolchains
13              
14             $VERSION = '0.02';
15             $VERSION = $VERSION;
16              
17             require Exporter;
18             @ISA = qw(Exporter);
19             @EXPORT = qw();
20             @EXPORT_OK = qw(
21             to_big5 big5 by_big5
22             to_big5hkscs big5hkscs by_big5hkscs
23             to_cp932 cp932 by_cp932
24             to_cp936 cp936 by_cp936
25             to_cp949 cp949 by_cp949
26             to_cp950 cp950 by_cp950
27             to_eucjp eucjp by_eucjp
28             to_gbk gbk by_gbk
29             to_sjis sjis by_sjis
30             to_uhc uhc by_uhc
31             );
32              
33 4     4   36 use strict;
  4         10  
  4         197  
34             BEGIN {
35 4 50   4   22 if ($] >= 5.008_001) {
36 4     4   305 eval q{
  4     4   25  
  4         9  
  4         130  
  4         2398  
  4         42404  
  4         231  
37             use warnings;
38             use Encode; qw();
39             };
40             }
41             else {
42 0         0 eval q{
43             use Jacode;
44             };
45             }
46             }
47              
48             #-------------------------------------------------------------------------------------
49             # return octets to any encoding
50 2     2 0 287 sub to_big5 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5', ); $oct }
  2         19259  
51 2     2 0 182 sub to_big5hkscs ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5-hkscs',); $oct }
  2         135  
52 2     2 0 156 sub to_cp936 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp936', ); $oct }
  2         25810  
53 2     2 0 206 sub to_cp949 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp949', ); $oct }
  2         24109  
54 2     2 0 166 sub to_cp950 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp950', ); $oct }
  2         152  
55 2     2 0 74 sub to_eucjp ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'euc-jp', ); $oct }
  2         126  
56 2     2 0 71 sub to_gbk ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'gbk', ); $oct }
  2         812  
57 2     2 0 160 sub to_sjis ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'sjis', ); $oct }
  2         678  
58 2     2 0 138 sub to_uhc ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'uhc', ); $oct }
  2         591  
59             sub to_cp932 ($) {
60 4     4 0 283 my $oct = $_[0];
61 4 50       24 if ($] >= 5.008_001) {
62 4         18 Encode::from_to($oct, 'utf8', 'cp932');
63             }
64             else {
65 0         0 Jacode::convert(\$oct, 'sjis', 'utf8');
66             }
67 4         35229 return $oct;
68             }
69              
70             #-------------------------------------------------------------------------------------
71             # shorthand of mb::Encode::to_XXXX
72 2     2 0 137 sub big5 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5', ); $oct }
  2         144  
73 2     2 0 94 sub big5hkscs ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'big5-hkscs',); $oct }
  2         110  
74 2     2 0 72 sub cp936 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp936', ); $oct }
  2         104  
75 2     2 0 62 sub cp949 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp949', ); $oct }
  2         103  
76 2     2 0 64 sub cp950 ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'cp950', ); $oct }
  2         102  
77 2     2 0 61 sub eucjp ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'euc-jp', ); $oct }
  2         148  
78 2     2 0 66 sub gbk ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'gbk', ); $oct }
  2         138  
79 2     2 0 63 sub sjis ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'sjis', ); $oct }
  2         132  
80 2     2 0 78 sub uhc ($) { Encode::from_to(my $oct=$_[0], 'utf8', 'uhc', ); $oct }
  2         134  
81             sub cp932 ($) {
82 4     4 0 202 my $oct = $_[0];
83 4 50       25 if ($] >= 5.008_001) {
84 4         15 Encode::from_to($oct, 'utf8', 'cp932');
85             }
86             else {
87 0         0 Jacode::convert(\$oct, 'sjis', 'utf8');
88             }
89 4         222 return $oct;
90             }
91              
92             #-------------------------------------------------------------------------------------
93             # return octets from any encoding
94 2     2 0 64 sub by_big5 ($) { Encode::from_to(my $oct=$_[0], 'big5', 'utf8',); $oct }
  2         146  
95 2     2 0 67 sub by_big5hkscs ($) { Encode::from_to(my $oct=$_[0], 'big5-hkscs', 'utf8',); $oct }
  2         95  
96 2     2 0 63 sub by_cp936 ($) { Encode::from_to(my $oct=$_[0], 'cp936', 'utf8',); $oct }
  2         95  
97 2     2 0 62 sub by_cp949 ($) { Encode::from_to(my $oct=$_[0], 'cp949', 'utf8',); $oct }
  2         94  
98 2     2 0 60 sub by_cp950 ($) { Encode::from_to(my $oct=$_[0], 'cp950', 'utf8',); $oct }
  2         96  
99 2     2 0 61 sub by_eucjp ($) { Encode::from_to(my $oct=$_[0], 'euc-jp', 'utf8',); $oct }
  2         98  
100 2     2 0 60 sub by_gbk ($) { Encode::from_to(my $oct=$_[0], 'gbk', 'utf8',); $oct }
  2         124  
101 2     2 0 62 sub by_sjis ($) { Encode::from_to(my $oct=$_[0], 'sjis', 'utf8',); $oct }
  2         124  
102 2     2 0 66 sub by_uhc ($) { Encode::from_to(my $oct=$_[0], 'uhc', 'utf8',); $oct }
  2         122  
103             sub by_cp932 ($) { Encode::from_to(my $oct=$_[0], 'cp932', 'utf8',); $oct }
104             sub by_cp932 ($) {
105 4     4 0 119 my $oct = $_[0];
106 4 50       20 if ($] >= 5.008_001) {
107 4         16 Encode::from_to($oct, 'cp932', 'utf8');
108             }
109             else {
110 0         0 Jacode::convert(\$oct, 'utf8', 'sjis');
111             }
112 4         187 return $oct;
113             }
114              
115             1;
116              
117             __END__