This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[Patch] Enhance Hash::Util
[perl5.git] / ext / Hash / Util / lib / Hash / Util.pm
1 package Hash::Util;
2
3 require 5.007003;
4 use strict;
5 use Carp;
6 use warnings;
7 use warnings::register;
8 use Scalar::Util qw(reftype);
9
10 require Exporter;
11 our @ISA        = qw(Exporter);
12 our @EXPORT_OK  = qw(
13                      all_keys
14                      lock_keys unlock_keys
15                      lock_value unlock_value
16                      lock_hash unlock_hash
17                      lock_keys_plus hash_locked
18                      hidden_keys legal_keys
19
20                      lock_ref_keys unlock_ref_keys
21                      lock_ref_value unlock_ref_value
22                      lock_hashref unlock_hashref
23                      lock_ref_keys_plus hashref_locked
24                      hidden_ref_keys legal_ref_keys
25
26                      hash_seed hv_store
27
28                     );
29 our $VERSION    = 0.06;
30 require DynaLoader;
31 local @ISA = qw(DynaLoader);
32 bootstrap Hash::Util $VERSION;
33
34
35 =head1 NAME
36
37 Hash::Util - A selection of general-utility hash subroutines
38
39 =head1 SYNOPSIS
40
41   use Hash::Util qw(
42                      hash_seed all_keys
43                      lock_keys unlock_keys
44                      lock_value unlock_value
45                      lock_hash unlock_hash
46                      lock_keys_plus hash_locked
47                      hidden_keys legal_keys
48                    );
49
50   %hash = (foo => 42, bar => 23);
51   # Ways to restrict a hash
52   lock_keys(%hash);
53   lock_keys(%hash, @keyset);
54   lock_keys_plus(%hash, @additional_keys);
55
56   #Ways to inspect the properties of a restricted hash
57   my @legal=legal_keys(%hash);
58   my @hidden=hidden_keys(%hash);
59   my $ref=all_keys(%hash,@keys,@hidden);
60   my $is_locked=hash_locked(%hash);
61
62   #Remove restrictions on the hash
63   unlock_keys(%hash);
64
65   #Lock individual values in a hash
66   lock_value  (%hash, 'foo');
67   unlock_value(%hash, 'foo');
68
69   #Ways to change the restrictions on both keys and values
70   lock_hash  (%hash);
71   unlock_hash(%hash);
72
73   my $hashes_are_randomised = hash_seed() != 0;
74
75 =head1 DESCRIPTION
76
77 C<Hash::Util> contains special functions for manipulating hashes that
78 don't really warrant a keyword.
79
80 By default C<Hash::Util> does not export anything.
81
82 =head2 Restricted hashes
83
84 5.8.0 introduces the ability to restrict a hash to a certain set of
85 keys.  No keys outside of this set can be added.  It also introduces
86 the ability to lock an individual key so it cannot be deleted and the
87 ability to ensure that an individual value cannot be changed.
88
89 This is intended to largely replace the deprecated pseudo-hashes.
90
91 =over 4
92
93 =item B<lock_keys>
94
95 =item B<unlock_keys>
96
97   lock_keys(%hash);
98   lock_keys(%hash, @keys);
99
100 Restricts the given %hash's set of keys to @keys.  If @keys is not
101 given it restricts it to its current keyset.  No more keys can be
102 added. delete() and exists() will still work, but will not alter
103 the set of allowed keys. B<Note>: the current implementation prevents
104 the hash from being bless()ed while it is in a locked state. Any attempt
105 to do so will raise an exception. Of course you can still bless()
106 the hash before you call lock_keys() so this shouldn't be a problem.
107
108   unlock_keys(%hash);
109
110 Removes the restriction on the %hash's keyset.
111
112 B<Note> that if any of the values of the hash have been locked they will not be unlocked
113 after this sub executes.
114
115 Both routines return a reference to the hash operated on.
116
117 =cut
118
119 sub lock_ref_keys {
120     my($hash, @keys) = @_;
121
122     Internals::hv_clear_placeholders %$hash;
123     if( @keys ) {
124         my %keys = map { ($_ => 1) } @keys;
125         my %original_keys = map { ($_ => 1) } keys %$hash;
126         foreach my $k (keys %original_keys) {
127             croak "Hash has key '$k' which is not in the new key set"
128               unless $keys{$k};
129         }
130
131         foreach my $k (@keys) {
132             $hash->{$k} = undef unless exists $hash->{$k};
133         }
134         Internals::SvREADONLY %$hash, 1;
135
136         foreach my $k (@keys) {
137             delete $hash->{$k} unless $original_keys{$k};
138         }
139     }
140     else {
141         Internals::SvREADONLY %$hash, 1;
142     }
143
144     return $hash;
145 }
146
147 sub unlock_ref_keys {
148     my $hash = shift;
149
150     Internals::SvREADONLY %$hash, 0;
151     return $hash;
152 }
153
154 sub   lock_keys (\%;@) {   lock_ref_keys(@_) }
155 sub unlock_keys (\%)   { unlock_ref_keys(@_) }
156
157 =item B<lock_keys_plus>
158
159   lock_keys_plus(%hash,@additional_keys)
160
161 Similar to C<lock_keys()>, with the difference being that the optional key list
162 specifies keys that may or may not be already in the hash. Essentially this is
163 an easier way to say
164
165   lock_keys(%hash,@additional_keys,keys %hash);
166
167 Returns a reference to %hash
168
169 =cut
170
171
172 sub lock_ref_keys_plus {
173     my ($hash,@keys)=@_;
174     my @delete;
175     Internals::hv_clear_placeholders(%$hash);
176     foreach my $key (@keys) {
177         unless (exists($hash->{$key})) {
178             $hash->{$key}=undef;
179             push @delete,$key;
180         }
181     }
182     Internals::SvREADONLY(%$hash,1);
183     delete @{$hash}{@delete};
184     return $hash
185 }
186
187 sub lock_keys_plus(\%;@) { lock_ref_keys_plus(@_) }
188
189
190 =item B<lock_value>
191
192 =item B<unlock_value>
193
194   lock_value  (%hash, $key);
195   unlock_value(%hash, $key);
196
197 Locks and unlocks the value for an individual key of a hash.  The value of a
198 locked key cannot be changed.
199
200 Unless %hash has already been locked the key/value could be deleted
201 regardless of this setting.
202
203 Returns a reference to the %hash.
204
205 =cut
206
207 sub lock_ref_value {
208     my($hash, $key) = @_;
209     # I'm doubtful about this warning, as it seems not to be true.
210     # Marking a value in the hash as RO is useful, regardless
211     # of the status of the hash itself.
212     carp "Cannot usefully lock values in an unlocked hash"
213       if !Internals::SvREADONLY(%$hash) && warnings::enabled;
214     Internals::SvREADONLY $hash->{$key}, 1;
215     return $hash
216 }
217
218 sub unlock_ref_value {
219     my($hash, $key) = @_;
220     Internals::SvREADONLY $hash->{$key}, 0;
221     return $hash
222 }
223
224 sub   lock_value (\%$) {   lock_ref_value(@_) }
225 sub unlock_value (\%$) { unlock_ref_value(@_) }
226
227
228 =item B<lock_hash>
229
230 =item B<unlock_hash>
231
232     lock_hash(%hash);
233
234 lock_hash() locks an entire hash, making all keys and values readonly.
235 No value can be changed, no keys can be added or deleted.
236
237     unlock_hash(%hash);
238
239 unlock_hash() does the opposite of lock_hash().  All keys and values
240 are made writable.  All values can be changed and keys can be added
241 and deleted.
242
243 Returns a reference to the %hash.
244
245 =cut
246
247 sub lock_hashref {
248     my $hash = shift;
249
250     lock_ref_keys($hash);
251
252     foreach my $value (values %$hash) {
253         Internals::SvREADONLY($value,1);
254     }
255
256     return $hash;
257 }
258
259 sub unlock_hashref {
260     my $hash = shift;
261
262     foreach my $value (values %$hash) {
263         Internals::SvREADONLY($value, 0);
264     }
265
266     unlock_ref_keys($hash);
267
268     return $hash;
269 }
270
271 sub   lock_hash (\%) {   lock_hashref(@_) }
272 sub unlock_hash (\%) { unlock_hashref(@_) }
273
274 =item B<lock_hash_recurse>
275
276 =item B<unlock_hash_recurse>
277
278     lock_hash_recurse(%hash);
279
280 lock_hash() locks an entire hash and any hashes it references recursively,
281 making all keys and values readonly. No value can be changed, no keys can
282 be added or deleted.
283
284 B<Only> recurses into hashes that are referenced by another hash. Thus a
285 Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of Hashes
286 (HoAoH) will only have the top hash restricted.
287
288     unlock_hash_recurse(%hash);
289
290 unlock_hash_recurse() does the opposite of lock_hash_recurse().  All keys and
291 values are made writable.  All values can be changed and keys can be added
292 and deleted. Identical recursion restrictions apply as to lock_hash_recurse().
293
294 Returns a reference to the %hash.
295
296 =cut
297
298 sub lock_hashref_recurse {
299     my $hash = shift;
300
301     lock_ref_keys($hash);
302     foreach my $value (values %$hash) {
303         if (reftype($value) eq 'HASH') {
304             lock_hashref_recurse($value);
305         }
306         Internals::SvREADONLY($value,1);
307     }
308     return $hash
309 }
310
311 sub unlock_hashref_recurse {
312     my $hash = shift;
313
314     foreach my $value (values %$hash) {
315         if (reftype($value) eq 'HASH') {
316             unlock_hashref_recurse($value);
317         }
318         Internals::SvREADONLY($value,1);
319     }
320     unlock_ref_keys($hash);
321     return $hash;
322 }
323
324 sub   lock_hash_recurse (\%) {   lock_hashref_recurse(@_) }
325 sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
326
327
328 =item B<hash_unlocked>
329
330   hash_unlocked(%hash) and print "Hash is unlocked!\n";
331
332 Returns true if the hash and its keys are unlocked.
333
334 =cut
335
336 sub hashref_unlocked {
337     my $hash=shift;
338     return Internals::SvREADONLY($hash)
339 }
340
341 sub hash_unlocked(\%) { hashref_unlocked(@_) }
342
343 =for demerphqs_editor
344 sub legal_ref_keys{}
345 sub hidden_ref_keys{}
346 sub all_keys{}
347
348 =cut
349
350 sub legal_keys(\%) { legal_ref_keys(@_)  }
351 sub hidden_keys(\%){ hidden_ref_keys(@_) }
352
353 =item b<legal_keys>
354
355   my @keys=legal_keys(%hash);
356
357 Returns a list of the keys that are legal in a restricted hash.
358 In the case of an unrestricted hash this is identical to calling
359 keys(%hash).
360
361 =item B<hidden_keys>
362
363   my @keys=hidden_keys(%hash);
364
365 Returns a list of the keys that are legal in a restricted hash but
366 do not have a value associated to them. Thus if 'foo' is a
367 "hidden" key of the %hash it will return false for both C<defined>
368 and C<exists> tests.
369
370 In the case of an unrestricted hash this will return an empty list.
371
372 B<NOTE> this is an experimental feature that is heavily dependent
373 on the current implementation of restricted hashes. Should the
374 implementation change this routine may become meaningless in which
375 case it will return an empty list.
376
377 =item B<all_keys>
378
379   all_keys(%hash,@keys,@hidden);
380
381 Populates the arrays @keys with the all the keys that would pass
382 an C<exists> tests, and populates @hidden with the remaining legal
383 keys that have not been utilized.
384
385 Returns a reference to the hash.
386
387 In the case of an unrestricted hash this will be equivelent to
388
389   $ref=do{
390             @keys  =keys %hash;
391             @hidden=();
392             \%hash
393          };
394
395 B<NOTE> this is an experimental feature that is heavily dependent
396 on the current implementation of restricted hashes. Should the
397 implementation change this routine may become meaningless in which
398 case it will behave identically to how it would behave on an
399 unrestrcited hash.
400
401 =item B<hash_seed>
402
403     my $hash_seed = hash_seed();
404
405 hash_seed() returns the seed number used to randomise hash ordering.
406 Zero means the "traditional" random hash ordering, non-zero means the
407 new even more random hash ordering introduced in Perl 5.8.1.
408
409 B<Note that the hash seed is sensitive information>: by knowing it one
410 can craft a denial-of-service attack against Perl code, even remotely,
411 see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
412 B<Do not disclose the hash seed> to people who don't need to know it.
413 See also L<perlrun/PERL_HASH_SEED_DEBUG>.
414
415 =cut
416
417 sub hash_seed () {
418     Internals::rehash_seed();
419 }
420
421 =item B<hv_store>
422
423   my $sv=0;
424   hv_store(%hash,$key,$sv) or die "Failed to alias!";
425   $hash{$key}=1;
426   print $sv; # prints 1
427
428 Stores an alias to a variable in a hash instead of copying the value.
429
430 =back
431
432 =head2 Operating on references to hashes.
433
434 Most subroutines documented in this module have equivelent versions
435 that operate on references to hashes instead of native hashes.
436 The following is a list of these subs. They are identical except
437 in name and in that instead of taking a %hash they take a $hashref,
438 and additionally are not prototyped.
439
440 =over 4
441
442 =item lock_ref_keys
443
444 =item unlock_ref_keys
445
446 =item lock_ref_keys_plus
447
448 =item lock_ref_value
449
450 =item unlock_ref_value
451
452 =item lock_hashref
453
454 =item unlock_hashref
455
456 =item lock_hashref_recurse
457
458 =item unlock_hashref_recurse
459
460 =item hash_ref_unlocked
461
462 =item legal_ref_keys
463
464 =item hidden_ref_keys
465
466 =back
467
468 =head1 CAVEATS
469
470 Note that the trapping of the restricted operations is not atomic:
471 for example
472
473     eval { %hash = (illegal_key => 1) }
474
475 leaves the C<%hash> empty rather than with its original contents.
476
477 =head1 BUGS
478
479 The interface exposed by this module is very close to the current
480 imlementation of restricted hashes. Over time it is expected that
481 this behavior will be extended and the interface abstracted further.
482
483 =head1 AUTHOR
484
485 Michael G Schwern <schwern@pobox.com> on top of code by Nick
486 Ing-Simmons and Jeffrey Friedl.
487
488 hv_store() is from Array::RefElem, Copyright 2000 Gisle Aas.
489
490 Additional code by Yves Orton.
491
492 =head1 SEE ALSO
493
494 L<Scalar::Util>, L<List::Util>, L<Hash::Util>,
495 and L<perlsec/"Algorithmic Complexity Attacks">.
496
497 =cut
498
499 1;