|
Packit |
14c646 |
#!/usr/local/bin/perl -w
|
|
Packit |
14c646 |
use strict;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
use 5.007003;
|
|
Packit |
14c646 |
use Hash::Util qw(lock_hash unlock_hash lock_keys);
|
|
Packit |
14c646 |
use Storable qw(nfreeze);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# If this looks like a hack, it's probably because it is :-)
|
|
Packit |
14c646 |
sub uuencode_it {
|
|
Packit |
14c646 |
my ($data, $name) = @_;
|
|
Packit |
14c646 |
my $frozen = nfreeze $data;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $uu = pack 'u', $frozen;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
printf "begin %3o $name\n", ord 'A';
|
|
Packit |
14c646 |
print $uu;
|
|
Packit |
14c646 |
print "\nend\n\n";
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my %hash = (perl=>"rules");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
lock_hash %hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\%hash, "Locked hash");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
unlock_hash %hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
lock_keys %hash, 'perl', 'rules';
|
|
Packit |
14c646 |
lock_hash %hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\%hash, "Locked hash placeholder");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
unlock_hash %hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
lock_keys %hash, 'perl';
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\%hash, "Locked keys");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
unlock_hash %hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
lock_keys %hash, 'perl', 'rules';
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\%hash, "Locked keys placeholder");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
unlock_hash %hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $utf8 = "\x{DF}\x{100}";
|
|
Packit |
14c646 |
chop $utf8;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\$utf8, "Short 8 bit utf8 data");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $utf8b = $utf8;
|
|
Packit |
14c646 |
utf8::encode ($utf8b);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\$utf8b, "Short 8 bit utf8 data as bytes");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$utf8 x= 256;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\$utf8, "Long 8 bit utf8 data");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$utf8 = "\x{C0FFEE}";
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\$utf8, "Short 24 bit utf8 data");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$utf8b = $utf8;
|
|
Packit |
14c646 |
utf8::encode ($utf8b);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\$utf8b, "Short 24 bit utf8 data as bytes");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$utf8 x= 256;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\$utf8, "Long 24 bit utf8 data");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Hash which has the utf8 bit set, but no longer has any utf8 keys
|
|
Packit |
14c646 |
my %uhash = ("\x{100}", "gone", "perl", "rules");
|
|
Packit |
14c646 |
delete $uhash{"\x{100}"};
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# use Devel::Peek; Dump \%uhash;
|
|
Packit |
14c646 |
uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$utf8 = "Schlo\xdf" . chr 256;
|
|
Packit |
14c646 |
chop $utf8;
|
|
Packit |
14c646 |
my $a_circumflex = (ord ('A') == 193 ? "\x47" : "\xe5");
|
|
Packit |
14c646 |
%uhash = (map {$_, $_} 'castle', "ch${a_circumflex}teau", $utf8, "\x{57CE}");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\%uhash, "Hash with utf8 keys");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
lock_hash %uhash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
uuencode_it (\%uhash, "Locked hash with utf8 keys");
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my (%pre56, %pre58);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
while (my ($key, $val) = each %uhash) {
|
|
Packit |
14c646 |
# hash keys are always stored downgraded to bytes if possible, with a flag
|
|
Packit |
14c646 |
# to say "promote back to utf8"
|
|
Packit |
14c646 |
# Whereas scalars are stored as is.
|
|
Packit |
14c646 |
utf8::encode ($key) if ord $key > 256;
|
|
Packit |
14c646 |
$pre58{$key} = $val;
|
|
Packit |
14c646 |
utf8::encode ($val) unless $val eq "ch\xe5teau";
|
|
Packit |
14c646 |
$pre56{$key} = $val;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
uuencode_it (\%pre56, "Hash with utf8 keys for pre 5.6");
|
|
Packit |
14c646 |
uuencode_it (\%pre58, "Hash with utf8 keys for 5.6");
|