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   51 use strict;
  8         17  
  8         200  
3 8     8   37 use warnings;
  8         18  
  8         550  
4             our $VERSION = do { my @r = ( q$Revision: 2.4 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
5              
6 8     8   48 use Encode qw(:fallbacks);
  8         18  
  8         1030  
7              
8 8     8   51 use parent qw(Encode::Encoding);
  8         16  
  8         57  
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 19 my ( $obj, $str, $chk ) = @_;
19 4 100       24 return undef unless defined $str;
20 3         11 my $res = $str;
21 3         18 my $residue = iso_euc( \$res );
22              
23             # This is for PerlIO
24 3 50       27 $_[1] = $residue if $chk;
25 3         14 return Encode::decode( 'euc-kr', $res, FB_PERLQQ );
26             }
27              
28             sub encode {
29 4     4 1 27 my ( $obj, $utf8, $chk ) = @_;
30 4 100       21 return undef unless defined $utf8;
31              
32             # empty the input string in the stack so perlio is ok
33 3 50       12 $_[1] = '' if $chk;
34 3         12 my $octet = Encode::encode( 'euc-kr', $utf8, FB_PERLQQ );
35 3         44 euc_iso( \$octet );
36 3         16 return $octet;
37             }
38              
39 8     8   1910 use Encode::CJKConstants qw(:all);
  8         18  
  8         1852  
40              
41             # ISO<->EUC
42              
43             sub iso_euc {
44 3     3 0 10 my $r_str = shift;
45 3         51 $$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         537 my $out= $1;
53 272         498 $out =~ tr/\x21-\x7e/\xa1-\xfe/;
54 272         961 $out;
55             }geox;
56 3         23 my ($residue) = ( $$r_str =~ s/(\e.*)$//so );
57 3         12 return $residue;
58             }
59              
60             sub euc_iso {
61 8     8   64 no warnings qw(uninitialized);
  8         20  
  8         1010  
62 3     3 0 9 my $r_str = shift;
63             substr( $$r_str, 0, 0 ) =
64 3         33 $ESC{'2022_KR'}; # put the designator at the beg.
65 3         73 $$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         446 my $str = $1;
70 272         367 $str =~ tr/\xA1-\xFE/\x21-\x7E/;
71 272         646 "\x0e" . $str . "\x0f";
72             }geox;
73 3         11 $$r_str;
74             }
75              
76             1;
77             __END__