ext/Encode/lib/Encode/10646_1.pm

   1 package Encode::10646_1;
   2 use strict;
   3 our $VERSION = do { my @r = (q$Revision: 0.99 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
   4
   5 use base 'Encode::Encoding';
   6 # Encoding is 16-bit network order Unicode (no surogates)
   7 # Used for X font encodings
   8
   9 __PACKAGE__->Define(qw(UCS-2 iso-10646-1));
  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__