Commit | Line | Data |
---|---|---|
530b72ba NC |
1 | #!/usr/local/bin/perl -w |
2 | use strict; | |
3 | ||
4 | use 5.007003; | |
5 | use Hash::Util qw(lock_hash unlock_hash lock_keys); | |
6 | use Storable qw(nfreeze); | |
7 | ||
8 | # If this looks like a hack, it's probably because it is :-) | |
9 | sub 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 | ||
21 | my %hash = (perl=>"rules"); | |
22 | ||
23 | lock_hash %hash; | |
24 | ||
25 | uuencode_it (\%hash, "Locked hash"); | |
26 | ||
27 | unlock_hash %hash; | |
28 | ||
29 | lock_keys %hash, 'perl', 'rules'; | |
30 | lock_hash %hash; | |
31 | ||
32 | uuencode_it (\%hash, "Locked hash placeholder"); | |
33 | ||
34 | unlock_hash %hash; | |
35 | ||
36 | lock_keys %hash, 'perl'; | |
37 | ||
38 | uuencode_it (\%hash, "Locked keys"); | |
39 | ||
40 | unlock_hash %hash; | |
41 | ||
42 | lock_keys %hash, 'perl', 'rules'; | |
43 | ||
44 | uuencode_it (\%hash, "Locked keys placeholder"); | |
45 | ||
46 | unlock_hash %hash; | |
47 | ||
48 | my $utf8 = "\x{DF}\x{100}"; | |
49 | chop $utf8; | |
50 | ||
51 | uuencode_it (\$utf8, "Short 8 bit utf8 data"); | |
52 | ||
7e416500 JH |
53 | my $utf8b = $utf8; |
54 | utf8::encode ($utf8b); | |
530b72ba | 55 | |
7e416500 | 56 | uuencode_it (\$utf8b, "Short 8 bit utf8 data as bytes"); |
530b72ba NC |
57 | |
58 | $utf8 x= 256; | |
59 | ||
60 | uuencode_it (\$utf8, "Long 8 bit utf8 data"); | |
61 | ||
62 | $utf8 = "\x{C0FFEE}"; | |
63 | ||
64 | uuencode_it (\$utf8, "Short 24 bit utf8 data"); | |
65 | ||
7e416500 JH |
66 | $utf8b = $utf8; |
67 | utf8::encode ($utf8b); | |
530b72ba | 68 | |
7e416500 | 69 | uuencode_it (\$utf8b, "Short 24 bit utf8 data as bytes"); |
530b72ba NC |
70 | |
71 | $utf8 x= 256; | |
72 | ||
73 | uuencode_it (\$utf8, "Long 24 bit utf8 data"); | |
74 | ||
75 | # Hash which has the utf8 bit set, but no longer has any utf8 keys | |
76 | my %uhash = ("\x{100}", "gone", "perl", "rules"); | |
77 | delete $uhash{"\x{100}"}; | |
78 | ||
79 | # use Devel::Peek; Dump \%uhash; | |
80 | uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys"); | |
81 | ||
82 | $utf8 = "Schlo\xdf" . chr 256; | |
83 | chop $utf8; | |
7e416500 JH |
84 | my $a_circumflex = (ord ('A') == 193 ? "\x47" : "\xe5"); |
85 | %uhash = (map {$_, $_} 'castle', "ch${a_circumflex}teau", $utf8, "\x{57CE}"); | |
530b72ba NC |
86 | |
87 | uuencode_it (\%uhash, "Hash with utf8 keys"); | |
88 | ||
89 | lock_hash %uhash; | |
90 | ||
91 | uuencode_it (\%uhash, "Locked hash with utf8 keys"); | |
92 | ||
93 | my (%pre56, %pre58); | |
94 | ||
95 | while (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 | utf8::encode ($val) unless $val eq "ch\xe5teau"; | |
102 | $pre56{$key} = $val; | |
103 | ||
104 | } | |
105 | uuencode_it (\%pre56, "Hash with utf8 keys for pre 5.6"); | |
106 | uuencode_it (\%pre58, "Hash with utf8 keys for 5.6"); |