This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Hash::Util::hash_seed() which answers among
[perl5.git] / 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 =cut
191
192 sub hash_seed () {
193     Internals::hash_seed();
194 }
195
196 =back
197
198 =head1 CAVEATS
199
200 Note that the trapping of the restricted operations is not atomic:
201 for example
202
203     eval { %hash = (illegal_key => 1) }
204
205 leaves the C<%hash> empty rather than with its original contents.
206
207 =head1 AUTHOR
208
209 Michael G Schwern <schwern@pobox.com> on top of code by Nick
210 Ing-Simmons and Jeffrey Friedl.
211
212 =head1 SEE ALSO
213
214 L<Scalar::Util>, L<List::Util>, L<Hash::Util>,
215 and L<perlsec/"Algorithmic Complexity Attacks">.
216
217 =cut
218
219 1;