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