← Back to branch summary

~ubuntu-branches/ubuntu/raring/libencode-perl/raring-proposed

« back to all changes in this revision

Viewing changes to lib/Encode/KR/2022_KR.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jose Luis Rivas
  • Date: 2007-05-18 23:49:27 UTC
  • Revision ID: james.westby@ubuntu.com-20070518234927-bs37c807cty7i1ny
Tags: upstream-2.21
Import upstream version 2.21

Show diffs side-by-side

added added

removed removed

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