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