File Coverage

blib/lib/Encode/KR/2022_KR.pm
Criterion Covered Total %
statement 45 47 95.7
branch 6 8 75.0
condition n/a
subroutine 10 12 83.3
pod 4 6 66.6
total 65 73 89.0


line stmt bran cond sub pod time code
1             package Encode::KR::2022_KR;
2 8     8   55 use strict;
  8         21  
  8         214  
3 8     8   44 use warnings;
  8         23  
  8         585  
4             our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
5              
6 8     8   53 use Encode qw(:fallbacks);
  8         17  
  8         1273  
7              
8 8     8   64 use parent qw(Encode::Encoding);
  8         27  
  8         66  
9             __PACKAGE__->Define('iso-2022-kr');
10              
11 0     0 1 0 sub needs_lines { 1 }
12              
13             sub perlio_ok {
14 0     0 1 0 return 0; # for the time being
15             }
16              
17             sub decode {
18 4     4 1 20 my ( $obj, $str, $chk ) = @_;
19 4 100       25 return undef unless defined $str;
20 3         11 my $res = $str;
21 3         15 my $residue = iso_euc( \$res );
22              
23             # This is for PerlIO
24 3 50       18 $_[1] = $residue if $chk;
25 3         20 return Encode::decode( 'euc-kr', $res, FB_PERLQQ );
26             }
27              
28             sub encode {
29 4     4 1 28 my ( $obj, $utf8, $chk ) = @_;
30 4 100       38 return undef unless defined $utf8;
31              
32             # empty the input string in the stack so perlio is ok
33 3 50       18 $_[1] = '' if $chk;
34 3         17 my $octet = Encode::encode( 'euc-kr', $utf8, FB_PERLQQ );
35 3         19 euc_iso( \$octet );
36 3         20 return $octet;
37             }
38              
39 8     8   2558 use Encode::CJKConstants qw(:all);
  8         21  
  8         2316  
40              
41             # ISO<->EUC
42              
43             sub iso_euc {
44 3     3 0 8 my $r_str = shift;
45 3         58 $$r_str =~ s/$RE{'2022_KR'}//gox; # remove the designator
46 3         17 $$r_str =~ s{ # replace characters in GL
47             \x0e # between SO(\x0e) and SI(\x0f)
48             ([^\x0f]*) # with characters in GR
49             \x0f
50             }
51             {
52 272         487 my $out= $1;
53 272         458 $out =~ tr/\x21-\x7e/\xa1-\xfe/;
54 272         884 $out;
55             }geox;
56 3         26 my ($residue) = ( $$r_str =~ s/(\e.*)$//so );
57 3         11 return $residue;
58             }
59              
60             sub euc_iso {
61 8     8   71 no warnings qw(uninitialized);
  8         19  
  8         1125  
62 3     3 0 8 my $r_str = shift;
63             substr( $$r_str, 0, 0 ) =
64 3         37 $ESC{'2022_KR'}; # put the designator at the beg.
65 3         67 $$r_str =~
66             s{ # move KS X 1001 characters in GR to GL
67             ($RE{EUC_C}+) # and enclose them with SO and SI
68             }{
69 272         481 my $str = $1;
70 272         409 $str =~ tr/\xA1-\xFE/\x21-\x7E/;
71 272         735 "\x0e" . $str . "\x0f";
72             }geox;
73 3         14 $$r_str;
74             }
75              
76             1;
77             __END__