lib/Hash/Util.pm

   1 package Hash::Util;
   2
   3 require 5.007003;
   4 use strict;
   5 use Carp;
   6
   7 require Exporter;
   8 our @ISA        = qw(Exporter);
   9 our @EXPORT_OK  = qw(lock_keys unlock_keys lock_value unlock_value
  10                      lock_hash unlock_hash hash_seed
  11                     );
  12 our $VERSION    = 0.05;
  13
  14 =head1 NAME
  15
  16 Hash::Util - A selection of general-utility hash subroutines
  17
  18 =head1 SYNOPSIS
  19
  20   use Hash::Util qw(lock_keys   unlock_keys
  21                     lock_value  unlock_value
  22                     lock_hash   unlock_hash
  23                     hash_seed);
  24
  25   %hash = (foo => 42, bar => 23);
  26   lock_keys(%hash);
  27   lock_keys(%hash, @keyset);
  28   unlock_keys(%hash);
  29
  30   lock_value  (%hash, 'foo');
  31   unlock_value(%hash, 'foo');
  32
  33   lock_hash  (%hash);
  34   unlock_hash(%hash);
  35
  36   my $hashes_are_randomised = hash_seed() != 0;
  37
  38 =head1 DESCRIPTION
  39
  40 C<Hash::Util> contains special functions for manipulating hashes that
  41 don't really warrant a keyword.
  42
  43 By default C<Hash::Util> does not export anything.
  44
  45 =head2 Restricted hashes
  46
  47 5.8.0 introduces the ability to restrict a hash to a certain set of
  48 keys.  No keys outside of this set can be added.  It also introduces
  49 the ability to lock an individual key so it cannot be deleted and the
  50 value cannot be changed.
  51
  52 This is intended to largely replace the deprecated pseudo-hashes.
  53
  54 =over 4
  55
  56 =item lock_keys
  57
  58 =item unlock_keys
  59
  60   lock_keys(%hash);
  61   lock_keys(%hash, @keys);
  62
  63 Restricts the given %hash's set of keys to @keys.  If @keys is not
  64 given it restricts it to its current keyset.  No more keys can be
  65 added. delete() and exists() will still work, but will not alter
  66 the set of allowed keys. B<Note>: the current implementation prevents
  67 the hash from being bless()ed while it is in a locked state. Any attempt
  68 to do so will raise an exception. Of course you can still bless()
  69 the hash before you call lock_keys() so this shouldn't be a problem.
  70
  71   unlock_keys(%hash);
  72
  73 Removes the restriction on the %hash's keyset.
  74
  75 =cut
  76
  77 sub lock_keys (\%;@) {
  78     my($hash, @keys) = @_;
  79
  80     Internals::hv_clear_placeholders %$hash;
  81     if( @keys ) {
  82         my %keys = map { ($_ => 1) } @keys;
  83         my %original_keys = map { ($_ => 1) } keys %$hash;
  84         foreach my $k (keys %original_keys) {
  85             die sprintf "Hash has key '$k' which is not in the new key ".
  86                         "set at %s line %d\n", (caller)[1,2]
  87               unless $keys{$k};
  88         }
  89
  90         foreach my $k (@keys) {
  91             $hash->{$k} = undef unless exists $hash->{$k};
  92         }
  93         Internals::SvREADONLY %$hash, 1;
  94
  95         foreach my $k (@keys) {
  96             delete $hash->{$k} unless $original_keys{$k};
  97         }
  98     }
  99     else {
 100         Internals::SvREADONLY %$hash, 1;
 101     }
 102
 103     return;
 104 }
 105
 106 sub unlock_keys (\%) {
 107     my($hash) = shift;
 108
 109     Internals::SvREADONLY %$hash, 0;
 110     return;
 111 }
 112
 113 =item lock_value
 114
 115 =item unlock_value
 116
 117   lock_value  (%hash, $key);
 118   unlock_value(%hash, $key);
 119
 120 Locks and unlocks an individual key of a hash.  The value of a locked
 121 key cannot be changed.
 122
 123 %hash must have already been locked for this to have useful effect.
 124
 125 =cut
 126
 127 sub lock_value (\%$) {
 128     my($hash, $key) = @_;
 129     carp "Cannot usefully lock values in an unlocked hash"
 130       unless Internals::SvREADONLY %$hash;
 131     Internals::SvREADONLY $hash->{$key}, 1;
 132 }
 133
 134 sub unlock_value (\%$) {
 135     my($hash, $key) = @_;
 136     Internals::SvREADONLY $hash->{$key}, 0;
 137 }
 138
 139
 140 =item B<lock_hash>
 141
 142 =item B<unlock_hash>
 143
 144     lock_hash(%hash);
 145
 146 lock_hash() locks an entire hash, making all keys and values readonly.
 147 No value can be changed, no keys can be added or deleted.
 148
 149     unlock_hash(%hash);
 150
 151 unlock_hash() does the opposite of lock_hash().  All keys and values
 152 are made read/write.  All values can be changed and keys can be added
 153 and deleted.
 154
 155 =cut
 156
 157 sub lock_hash (\%) {
 158     my($hash) = shift;
 159
 160     lock_keys(%$hash);
 161
 162     foreach my $key (keys %$hash) {
 163         lock_value(%$hash, $key);
 164     }
 165
 166     return 1;
 167 }
 168
 169 sub unlock_hash (\%) {
 170     my($hash) = shift;
 171
 172     foreach my $key (keys %$hash) {
 173         unlock_value(%$hash, $key);
 174     }
 175
 176     unlock_keys(%$hash);
 177
 178     return 1;
 179 }
 180
 181
 182 =item B<hash_seed>
 183
 184     my $hash_seed = hash_seed();
 185
 186 hash_seed() returns the seed number used to randomise hash ordering.
 187 Zero means the "traditional" random hash ordering, non-zero means the
 188 new even more random hash ordering introduced in Perl 5.8.1.
 189
 190 B<Note that the hash seed is sensitive information>: by knowing it one
 191 can craft a denial-of-service attack against Perl code, even remotely,
 192 see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
 193 B<Do not disclose the hash seed> to people who don't need to know it.
 194 See also L<perlrun/PERL_HASH_SEED_DEBUG>.
 195
 196 =cut
 197
 198 sub hash_seed () {
 199     Internals::rehash_seed();
 200 }
 201
 202 =back
 203
 204 =head1 CAVEATS
 205
 206 Note that the trapping of the restricted operations is not atomic:
 207 for example
 208
 209     eval { %hash = (illegal_key => 1) }
 210
 211 leaves the C<%hash> empty rather than with its original contents.
 212
 213 =head1 AUTHOR
 214
 215 Michael G Schwern <schwern@pobox.com> on top of code by Nick
 216 Ing-Simmons and Jeffrey Friedl.
 217
 218 =head1 SEE ALSO
 219
 220 L<Scalar::Util>, L<List::Util>, L<Hash::Util>,
 221 and L<perlsec/"Algorithmic Complexity Attacks">.
 222
 223 =cut
 224
 225 1;