[p5sagit/p5-mst-13.2.git] / ext / Encode / lib / Encode / ucs2_le.pm

package Encode::ucs_2le;
use strict;
our $VERSION = do { my @r = (q$Revision: 0.92 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

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;
}
1;
__END__
Commit	Line	Data
18586f54	1	package Encode::ucs_2le;
18586f54	2	use strict;
d6b7ef86	3	our $VERSION = do { my @r = (q$Revision: 0.92 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
d6b7ef86	4
18586f54	5	use base 'Encode::Encoding';
	6
	7	__PACKAGE__->Define(qw(UCS-2le UCS-2LE ucs-2le));
	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__