Commit | Line | Data |
64ffdd5e |
1 | package Encode::10646_1; |
df1df145 |
2 | use strict; |
a999c27c |
3 | our $VERSION = do { my @r = (q$Revision: 1.20 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
ee981de6 |
4 | |
df1df145 |
5 | use base 'Encode::Encoding'; |
6 | # Encoding is 16-bit network order Unicode (no surogates) |
7 | # Used for X font encodings |
8 | |
a999c27c |
9 | __PACKAGE__->Define(qw(UCS-2)); |
df1df145 |
10 | |
11 | sub decode |
12 | { |
13 | my ($obj,$str,$chk) = @_; |
14 | my $uni = ''; |
15 | while (length($str)) |
16 | { |
17 | my $code = unpack('n',substr($str,0,2,'')) & 0xffff; |
18 | $uni .= chr($code); |
19 | } |
20 | $_[1] = $str if $chk; |
21 | utf8::upgrade($uni); |
22 | return $uni; |
23 | } |
24 | |
25 | sub encode |
26 | { |
27 | my ($obj,$uni,$chk) = @_; |
28 | my $str = ''; |
29 | while (length($uni)) |
30 | { |
31 | my $ch = substr($uni,0,1,''); |
32 | my $x = ord($ch); |
33 | unless ($x < 32768) |
34 | { |
35 | last if ($chk); |
36 | $x = 0; |
37 | } |
38 | $str .= pack('n',$x); |
39 | } |
40 | $_[1] = $uni if $chk; |
41 | return $str; |
42 | } |
43 | 1; |
44 | __END__ |
67d7b5ef |
45 | |
46 | =head1 NAME |
47 | |
48 | Encode::10656_1 -- for internal use only |
49 | |
50 | =cut |