1#!/usr/local/bin/perl -w
2use strict;
3
4use 5.007003;
5use Hash::Util qw(lock_hash unlock_hash lock_keys);
6use Storable qw(nfreeze);
7
8# If this looks like a hack, it's probably because it is :-)
9sub uuencode_it {
10  my ($data, $name) = @_;
11  my $frozen = nfreeze $data;
12
13  my $uu = pack 'u', $frozen;
14
15  printf "begin %3o $name\n", ord 'A';
16  print $uu;
17  print "\nend\n\n";
18}
19
20
21my %hash = (perl=>"rules");
22
23lock_hash %hash;
24
25uuencode_it (\%hash, "Locked hash");
26
27unlock_hash %hash;
28
29lock_keys %hash, 'perl', 'rules';
30lock_hash %hash;
31
32uuencode_it (\%hash, "Locked hash placeholder");
33
34unlock_hash %hash;
35
36lock_keys %hash, 'perl';
37
38uuencode_it (\%hash, "Locked keys");
39
40unlock_hash %hash;
41
42lock_keys %hash, 'perl', 'rules';
43
44uuencode_it (\%hash, "Locked keys placeholder");
45
46unlock_hash %hash;
47
48my $utf8 = "\x{DF}\x{100}";
49chop $utf8;
50
51uuencode_it (\$utf8, "Short 8 bit utf8 data");
52
53my $utf8b = $utf8;
54utf8::encode ($utf8b);
55
56uuencode_it (\$utf8b, "Short 8 bit utf8 data as bytes");
57
58$utf8 x= 256;
59
60uuencode_it (\$utf8, "Long 8 bit utf8 data");
61
62$utf8 = "\x{C0FFEE}";
63
64uuencode_it (\$utf8, "Short 24 bit utf8 data");
65
66$utf8b = $utf8;
67utf8::encode ($utf8b);
68
69uuencode_it (\$utf8b, "Short 24 bit utf8 data as bytes");
70
71$utf8 x= 256;
72
73uuencode_it (\$utf8, "Long 24 bit utf8 data");
74
75# Hash which has the utf8 bit set, but no longer has any utf8 keys
76my %uhash = ("\x{100}", "gone", "perl", "rules");
77delete $uhash{"\x{100}"};
78
79# use Devel::Peek; Dump \%uhash;
80uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys");
81
82$utf8 = "Schlo\xdf" . chr 256;
83chop $utf8;
84my $a_circumflex = (ord ('A') == 193 ? "\x47" : "\xe5");
85%uhash = (map {$_, $_} 'castle', "ch${a_circumflex}teau", $utf8, "\x{57CE}");
86
87uuencode_it (\%uhash, "Hash with utf8 keys");
88
89lock_hash %uhash;
90
91uuencode_it (\%uhash, "Locked hash with utf8 keys");
92
93my %pre58;
94
95while (my ($key, $val) = each %uhash) {
96  # hash keys are always stored downgraded to bytes if possible, with a flag
97  # to say "promote back to utf8"
98  # Whereas scalars are stored as is.
99  utf8::encode ($key) if ord $key > 256;
100  $pre58{$key} = $val;
101
102}
103uuencode_it (\%pre58, "Hash with utf8 keys for 5.6");
104