dist/Storable/t/make_downgrade.pl

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