1package Hash::Util; 2 3require 5.007003; 4use strict; 5use Carp; 6 7require Exporter; 8our @ISA = qw(Exporter); 9our @EXPORT_OK = qw(lock_keys unlock_keys lock_value unlock_value 10 lock_hash unlock_hash hash_seed 11 ); 12our $VERSION = 0.05; 13 14=head1 NAME 15 16Hash::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 40C<Hash::Util> contains special functions for manipulating hashes that 41don't really warrant a keyword. 42 43By default C<Hash::Util> does not export anything. 44 45=head2 Restricted hashes 46 475.8.0 introduces the ability to restrict a hash to a certain set of 48keys. No keys outside of this set can be added. It also introduces 49the ability to lock an individual key so it cannot be deleted and the 50value cannot be changed. 51 52This 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 63Restricts the given %hash's set of keys to @keys. If @keys is not 64given it restricts it to its current keyset. No more keys can be 65added. delete() and exists() will still work, but will not alter 66the set of allowed keys. B<Note>: the current implementation prevents 67the hash from being bless()ed while it is in a locked state. Any attempt 68to do so will raise an exception. Of course you can still bless() 69the hash before you call lock_keys() so this shouldn't be a problem. 70 71 unlock_keys(%hash); 72 73Removes the restriction on the %hash's keyset. 74 75=cut 76 77sub 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 106sub 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 120Locks and unlocks an individual key of a hash. The value of a locked 121key cannot be changed. 122 123%hash must have already been locked for this to have useful effect. 124 125=cut 126 127sub 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 134sub 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 146lock_hash() locks an entire hash, making all keys and values readonly. 147No value can be changed, no keys can be added or deleted. 148 149 unlock_hash(%hash); 150 151unlock_hash() does the opposite of lock_hash(). All keys and values 152are made read/write. All values can be changed and keys can be added 153and deleted. 154 155=cut 156 157sub 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 169sub 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 186hash_seed() returns the seed number used to randomise hash ordering. 187Zero means the "traditional" random hash ordering, non-zero means the 188new even more random hash ordering introduced in Perl 5.8.1. 189 190B<Note that the hash seed is sensitive information>: by knowing it one 191can craft a denial-of-service attack against Perl code, even remotely, 192see L<perlsec/"Algorithmic Complexity Attacks"> for more information. 193B<Do not disclose the hash seed> to people who don't need to know it. 194See also L<perlrun/PERL_HASH_SEED_DEBUG>. 195 196=cut 197 198sub hash_seed () { 199 Internals::rehash_seed(); 200} 201 202=back 203 204=head1 CAVEATS 205 206Note that the trapping of the restricted operations is not atomic: 207for example 208 209 eval { %hash = (illegal_key => 1) } 210 211leaves the C<%hash> empty rather than with its original contents. 212 213=head1 AUTHOR 214 215Michael G Schwern <schwern@pobox.com> on top of code by Nick 216Ing-Simmons and Jeffrey Friedl. 217 218=head1 SEE ALSO 219 220L<Scalar::Util>, L<List::Util>, L<Hash::Util>, 221and L<perlsec/"Algorithmic Complexity Attacks">. 222 223=cut 224 2251; 226