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