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 | |
7e416500 |
53 | my $utf8b = $utf8; |
54 | utf8::encode ($utf8b); |
530b72ba |
55 | |
7e416500 |
56 | uuencode_it (\$utf8b, "Short 8 bit utf8 data as bytes"); |
530b72ba |
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 |
66 | $utf8b = $utf8; |
67 | utf8::encode ($utf8b); |
530b72ba |
68 | |
7e416500 |
69 | uuencode_it (\$utf8b, "Short 24 bit utf8 data as bytes"); |
530b72ba |
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 |
84 | my $a_circumflex = (ord ('A') == 193 ? "\x47" : "\xe5"); |
85 | %uhash = (map {$_, $_} 'castle', "ch${a_circumflex}teau", $utf8, "\x{57CE}"); |
530b72ba |
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"); |