From: Matt Sergeant <matt@sergeant.org>
Date: Tue, 11 Sep 2001 09:22:32 +0000 (+0100)
Subject: Encode.pm add UCS-2 little endian support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=79019f4f1b03e1464f89ec059ca38876bafca7b4;p=p5sagit%2Fp5-mst-13.2.git

Encode.pm add UCS-2 little endian support
Message-ID: <315E8A8BF9D1D411AD3D00508BB1B0C004B9003C@UKS040>

p4raw-id: //depot/perl@11998
---

diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm
index 2aee7c1..45e5abd 100644
--- a/ext/Encode/Encode.pm
+++ b/ext/Encode/Encode.pm
@@ -363,6 +363,44 @@ sub encode
  return $str;
 }
 
+package Encode::ucs_2le;
+use base 'Encode::Encoding';
+
+__PACKAGE__->Define(qw(UCS-2le UCS-2LE ucs-2le));
+
+sub decode
+{
+ my ($obj,$str,$chk) = @_;
+ my $uni   = '';
+ while (length($str))
+ {
+  my $code = unpack('v',substr($str,0,2,'')) & 0xffff;
+  $uni .= chr($code);
+ }
+ $_[1] = $str if $chk;
+ utf8::upgrade($uni);
+ return $uni;
+}
+
+sub encode
+{
+ my ($obj,$uni,$chk) = @_;
+ my $str   = '';
+ while (length($uni))
+ {
+  my $ch = substr($uni,0,1,'');
+  my $x  = ord($ch);
+  unless ($x < 32768)
+  {
+   last if ($chk);
+   $x = 0;
+  }
+  $str .= pack('v',$x);
+ }
+ $_[1] = $uni if $chk;
+ return $str;
+}
+
 # switch back to Encode package in case we ever add AutoLoader
 package Encode;