Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
HAS_ATTACH.pm	121 B	-r--r--r--	2014-12-27 11:48
HAS_HOOK.pm	82 B	-r--r--r--	2014-12-27 11:48
HAS_OVERLOAD.pm	185 B	-r--r--r--	2014-12-27 11:48
attach.t	1007 B	-r--r--r--	2014-12-27 11:48
attach_errors.t	6.65 KB	-r--r--r--	2014-12-27 11:48
attach_singleton.t	2.32 KB	-r--r--r--	2014-12-27 11:48
blessed.t	6.77 KB	-r--r--r--	2014-12-27 11:48
canonical.t	3.46 KB	-r--r--r--	2014-12-27 11:49
circular_hook.t	1.98 KB	-r--r--r--	2014-12-27 11:48
code.t	7.23 KB	-r--r--r--	2014-12-27 11:48
compat01.t	1.15 KB	-r--r--r--	2014-12-27 11:48
compat06.t	3.25 KB	-r--r--r--	2014-12-27 11:48
croak.t	949 B	-r--r--r--	2014-12-27 11:48
dclone.t	2.19 KB	-r--r--r--	2014-12-27 11:48
destroy.t	362 B	-r--r--r--	2014-12-27 11:48
downgrade.t	17.41 KB	-r--r--r--	2014-12-27 11:48
file_magic.t	13.23 KB	-r--r--r--	2014-12-27 11:48
forgive.t	1.51 KB	-r--r--r--	2014-12-27 11:48
freeze.t	2.56 KB	-r--r--r--	2014-12-27 11:48
integer.t	6.08 KB	-r--r--r--	2014-12-27 11:48
interwork56.t	5.95 KB	-r--r--r--	2014-12-27 11:48
just_plain_nasty.t	4.24 KB	-r--r--r--	2014-12-27 11:48
leaks.t	626 B	-r--r--r--	2014-12-27 11:48
lock.t	1014 B	-r--r--r--	2014-12-27 11:48
make_56_interwork.pl	1.45 KB	-r--r--r--	2014-12-27 11:48
make_downgrade.pl	2.23 KB	-r--r--r--	2014-12-27 11:48
make_overload.pl	177 B	-r--r--r--	2014-12-27 11:48
malice.t	10.3 KB	-r--r--r--	2014-12-27 11:48
overload.t	2.04 KB	-r--r--r--	2014-12-27 11:48
recurse.t	5.74 KB	-r--r--r--	2014-12-27 11:48
restrict.t	3.42 KB	-r--r--r--	2014-12-27 11:48
retrieve.t	1.34 KB	-r--r--r--	2014-12-27 11:48
robust.t	309 B	-r--r--r--	2014-12-27 11:48
sig_die.t	734 B	-r--r--r--	2014-12-27 11:48
st-dump.pl	3.35 KB	-r--r--r--	2014-12-27 11:48
store.t	1.76 KB	-r--r--r--	2014-12-27 11:48
testlib.pl	865 B	-r--r--r--	2014-12-27 11:48
threads.t	1.8 KB	-r--r--r--	2014-12-27 11:48
tied.t	4.12 KB	-r--r--r--	2014-12-27 11:48
tied_hook.t	4.59 KB	-r--r--r--	2014-12-27 11:48
tied_items.t	1.07 KB	-r--r--r--	2014-12-27 11:48
tied_store.t	924 B	-r--r--r--	2014-12-27 11:48
utf8.t	1.14 KB	-r--r--r--	2014-12-27 11:48
utf8hash.t	5.26 KB	-r--r--r--	2014-12-27 11:48
weak.t	3.46 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/local/bin/perl -w
use strict;

use 5.007003;
use Hash::Util qw(lock_hash unlock_hash lock_keys);
use Storable qw(nfreeze);

# If this looks like a hack, it's probably because it is :-)
sub uuencode_it {
  my ($data, $name) = @_;
  my $frozen = nfreeze $data;

my $uu = pack 'u', $frozen;

printf "begin %3o $name\n", ord 'A';
  print $uu;
  print "\nend\n\n";
}

my %hash = (perl=>"rules");

lock_hash %hash;

uuencode_it (\%hash, "Locked hash");

unlock_hash %hash;

lock_keys %hash, 'perl', 'rules';
lock_hash %hash;

uuencode_it (\%hash, "Locked hash placeholder");

unlock_hash %hash;

lock_keys %hash, 'perl';

uuencode_it (\%hash, "Locked keys");

unlock_hash %hash;

lock_keys %hash, 'perl', 'rules';

uuencode_it (\%hash, "Locked keys placeholder");

unlock_hash %hash;

my $utf8 = "\x{DF}\x{100}";
chop $utf8;

uuencode_it (\$utf8, "Short 8 bit utf8 data");

my $utf8b = $utf8;
utf8::encode ($utf8b);

uuencode_it (\$utf8b, "Short 8 bit utf8 data as bytes");

$utf8 x= 256;

uuencode_it (\$utf8, "Long 8 bit utf8 data");

$utf8 = "\x{C0FFEE}";

uuencode_it (\$utf8, "Short 24 bit utf8 data");

$utf8b = $utf8;
utf8::encode ($utf8b);

uuencode_it (\$utf8b, "Short 24 bit utf8 data as bytes");

$utf8 x= 256;

uuencode_it (\$utf8, "Long 24 bit utf8 data");

# Hash which has the utf8 bit set, but no longer has any utf8 keys
my %uhash = ("\x{100}", "gone", "perl", "rules");
delete $uhash{"\x{100}"};

# use Devel::Peek; Dump \%uhash;
uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys");

$utf8 = "Schlo\xdf" . chr 256;
chop $utf8;
my $a_circumflex = (ord ('A') == 193 ? "\x47" : "\xe5");
%uhash = (map {$_, $_} 'castle', "ch${a_circumflex}teau", $utf8, "\x{57CE}");

uuencode_it (\%uhash, "Hash with utf8 keys");

lock_hash %uhash;

uuencode_it (\%uhash, "Locked hash with utf8 keys");

my (%pre56, %pre58);

while (my ($key, $val) = each %uhash) {
  # hash keys are always stored downgraded to bytes if possible, with a flag
  # to say "promote back to utf8"
  # Whereas scalars are stored as is.
  utf8::encode ($key) if ord $key > 256;
  $pre58{$key} = $val;
  utf8::encode ($val) unless $val eq "ch\xe5teau";
  $pre56{$key} = $val;

}
uuencode_it (\%pre56, "Hash with utf8 keys for pre 5.6");
uuencode_it (\%pre58, "Hash with utf8 keys for 5.6");