Encode
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
# byte repetoire to EBCDIC sets and back.
my $enc_as = 'iso8859-1';
foreach my $enc_eb (@ebcdic_sets)
{
foreach my $ord (0..255)
{
$str = chr($ord);
my $rc = from_to($str,$enc_as,$enc_eb);
$rc += from_to($str,$enc_eb,$enc_as);
is $rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained";
is $ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back";
}
}
my $mime = find_encoding('iso-8859-2');
is defined($mime),1,"Cannot find MIME-ish'iso-8859-2'";
my $x11 = find_encoding('iso8859-2');
is defined($x11),1,"Cannot find X11-ish 'iso8859-2'";
is $mime,$x11,"iso8598-2 and iso-8859-2 not same";
my $spc = find_encoding('iso 8859-2');
is defined($spc),1,"Cannot find 'iso 8859-2'";
is $spc,$mime,"iso 8859-2 and iso-8859-2 not same";
for my $i (256,128,129,256)
{
my $c = chr($i);
my $s = "$c\n".sprintf("%02X",$i);
is utf8::valid($s),1,"concat of $i botched";
utf8::upgrade($s);
is utf8::valid($s),1,"concat of $i botched";
}
# Spot check a few points in/out of utf8
for my $i (ord('A'),128,256,0x20AC)
{
my $c = chr($i);
my $o = encode_utf8($c);
is decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i";
is encode('utf8',$c),$o,"utf8 encode by name broken for $i";
is decode('utf8',$o),$c,"utf8 decode by name broken for $i";
}
# is_utf8
ok( is_utf8("\x{100}"));
ok(! is_utf8("a"));
ok(! is_utf8(""));
"\x{100}" =~ /(.)/;
ok( is_utf8($1)); # ID 20011127.151
$a = $1;
ok( is_utf8($a));
$a = "\x{100}";
chop $a;
ok( is_utf8($a)); # weird but true: an empty UTF-8 string
# non-string arguments
package Encode::Dummy;
use overload q("") => sub { $_[0]->[0] };
sub new { my $class = shift; bless [ @_ ] => $class }
package main;
ok(decode(latin1 => Encode::Dummy->new("foobar")), "foobar");
ok(encode(utf8 => Encode::Dummy->new("foobar")), "foobar");
# RT#91569
# decode_utf8 with non-string arguments
ok(decode_utf8(*1), "*main::1");
# hash keys
foreach my $name ("UTF-16LE", "UTF-8", "Latin1") {
my $key = (keys %{{ "whatever\x{CA}" => '' }})[0];
my $kopy = $key;
encode($name, $kopy, Encode::FB_CROAK);
is $key, "whatever\x{CA}", "encode $name with shared hash key scalars";
undef $key;
$key = (keys %{{ "whatever\x{CA}" => '' }})[0];
$kopy = $key;
encode($name, $kopy, Encode::FB_CROAK | Encode::LEAVE_SRC);
is $key, "whatever\x{CA}", "encode $name with LEAVE_SRC and shared hash key scalars";
undef $key;
$key = (keys %{{ "whatever" => '' }})[0];
$kopy = $key;
decode($name, $kopy, Encode::FB_CROAK);
is $key, "whatever", "decode $name with shared hash key scalars";
undef $key;
$key = (keys %{{ "whatever" => '' }})[0];
$kopy = $key;
decode($name, $kopy, Encode::FB_CROAK | Encode::LEAVE_SRC);
is $key, "whatever", "decode $name with LEAVE_SRC and shared hash key scalars";
my $enc = find_encoding($name);
undef $key;
$key = (keys %{{ "whatever\x{CA}" => '' }})[0];
$kopy = $key;
$enc->encode($kopy, Encode::FB_CROAK);
is $key, "whatever\x{CA}", "encode obj $name with shared hash key scalars";
undef $key;
$key = (keys %{{ "whatever\x{CA}" => '' }})[0];
$kopy = $key;
$enc->encode($kopy, Encode::FB_CROAK | Encode::LEAVE_SRC);
is $key, "whatever\x{CA}", "encode obj $name with LEAVE_SRC and shared hash key scalars";
undef $key;
$key = (keys %{{ "whatever" => '' }})[0];
$kopy = $key;
$enc->decode($kopy, Encode::FB_CROAK);
is $key, "whatever", "decode obj $name with shared hash key scalars";
undef $key;
$key = (keys %{{ "whatever" => '' }})[0];
$kopy = $key;
$enc->decode($kopy, Encode::FB_CROAK | Encode::LEAVE_SRC);
is $key, "whatever", "decode obj $name with LEAVE_SRC and shared hash key scalars";
}
my $latin1 = find_encoding('latin1');
my $orig = "\316";
$orig =~ /(.)/;
is $latin1->encode($1), $orig, '[cpan #115168] passing magic regex globals to encode';
SKIP: {
skip "Perl Version ($]) is older than v5.16", 1 if $] < 5.016;
*a = $orig;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.634 second using v1.00-cache-2.02-grep-82fe00e-cpan-72ae3ad1e6da )