Commit | Line | Data |
530b72ba |
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 | |
53 | utf8::encode ($utf8); |
54 | |
55 | uuencode_it (\$utf8, "Short 8 bit utf8 data as bytes"); |
56 | |
57 | $utf8 x= 256; |
58 | |
59 | uuencode_it (\$utf8, "Long 8 bit utf8 data"); |
60 | |
61 | $utf8 = "\x{C0FFEE}"; |
62 | |
63 | uuencode_it (\$utf8, "Short 24 bit utf8 data"); |
64 | |
65 | utf8::encode ($utf8); |
66 | |
67 | uuencode_it (\$utf8, "Short 24 bit utf8 data as bytes"); |
68 | |
69 | $utf8 x= 256; |
70 | |
71 | uuencode_it (\$utf8, "Long 24 bit utf8 data"); |
72 | |
73 | # Hash which has the utf8 bit set, but no longer has any utf8 keys |
74 | my %uhash = ("\x{100}", "gone", "perl", "rules"); |
75 | delete $uhash{"\x{100}"}; |
76 | |
77 | # use Devel::Peek; Dump \%uhash; |
78 | uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys"); |
79 | |
80 | $utf8 = "Schlo\xdf" . chr 256; |
81 | chop $utf8; |
82 | %uhash = (map {$_, $_} 'castle', "ch\xe5teau", $utf8, "\x{57CE}"); |
83 | |
84 | uuencode_it (\%uhash, "Hash with utf8 keys"); |
85 | |
86 | lock_hash %uhash; |
87 | |
88 | uuencode_it (\%uhash, "Locked hash with utf8 keys"); |
89 | |
90 | my (%pre56, %pre58); |
91 | |
92 | while (my ($key, $val) = each %uhash) { |
93 | # hash keys are always stored downgraded to bytes if possible, with a flag |
94 | # to say "promote back to utf8" |
95 | # Whereas scalars are stored as is. |
96 | utf8::encode ($key) if ord $key > 256; |
97 | $pre58{$key} = $val; |
98 | utf8::encode ($val) unless $val eq "ch\xe5teau"; |
99 | $pre56{$key} = $val; |
100 | |
101 | } |
102 | uuencode_it (\%pre56, "Hash with utf8 keys for pre 5.6"); |
103 | uuencode_it (\%pre58, "Hash with utf8 keys for 5.6"); |