Hash Function Change - Murmur hash and true per process hash seed
[perl.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 no warnings 'uninitialized';
8 use warnings::register;
9 use Scalar::Util qw(reftype);
10
11 require Exporter;
12 our @ISA        = qw(Exporter);
13 our @EXPORT_OK  = qw(
14                      fieldhash fieldhashes
15
16                      all_keys
17                      lock_keys unlock_keys
18                      lock_value unlock_value
19                      lock_hash unlock_hash
20                      lock_keys_plus
21                      hash_locked hash_unlocked
22                      hashref_locked hashref_unlocked
23                      hidden_keys legal_keys
24
25                      lock_ref_keys unlock_ref_keys
26                      lock_ref_value unlock_ref_value
27                      lock_hashref unlock_hashref
28                      lock_ref_keys_plus
29                      hidden_ref_keys legal_ref_keys
30
31                      hash_seed hash_value bucket_stats bucket_info bucket_array
32                      hv_store
33                      lock_hash_recurse unlock_hash_recurse
34                     );
35 our $VERSION = '0.13';
36 require XSLoader;
37 XSLoader::load();
38
39 sub import {
40     my $class = shift;
41     if ( grep /fieldhash/, @_ ) {
42         require Hash::Util::FieldHash;
43         Hash::Util::FieldHash->import(':all'); # for re-export
44     }
45     unshift @_, $class;
46     goto &Exporter::import;
47 }
48
49
50 =head1 NAME
51
52 Hash::Util - A selection of general-utility hash subroutines
53
54 =head1 SYNOPSIS
55
56   # Restricted hashes
57
58   use Hash::Util qw(
59                      fieldhash fieldhashes
60
61                      all_keys
62                      lock_keys unlock_keys
63                      lock_value unlock_value
64                      lock_hash unlock_hash
65                      lock_keys_plus
66                      hash_locked hash_unlocked
67                      hashref_locked hashref_unlocked
68                      hidden_keys legal_keys
69
70                      lock_ref_keys unlock_ref_keys
71                      lock_ref_value unlock_ref_value
72                      lock_hashref unlock_hashref
73                      lock_ref_keys_plus
74                      hidden_ref_keys legal_ref_keys
75
76                      hash_seed hv_store
77                      lock_hash_recurse unlock_hash_recurse
78                    );
79
80   %hash = (foo => 42, bar => 23);
81   # Ways to restrict a hash
82   lock_keys(%hash);
83   lock_keys(%hash, @keyset);
84   lock_keys_plus(%hash, @additional_keys);
85
86   # Ways to inspect the properties of a restricted hash
87   my @legal = legal_keys(%hash);
88   my @hidden = hidden_keys(%hash);
89   my $ref = all_keys(%hash,@keys,@hidden);
90   my $is_locked = hash_locked(%hash);
91
92   # Remove restrictions on the hash
93   unlock_keys(%hash);
94
95   # Lock individual values in a hash
96   lock_value  (%hash, 'foo');
97   unlock_value(%hash, 'foo');
98
99   # Ways to change the restrictions on both keys and values
100   lock_hash  (%hash);
101   unlock_hash(%hash);
102
103   my $hashes_are_randomised = hash_seed() != 0;
104
105 =head1 DESCRIPTION
106
107 C<Hash::Util> and C<Hash::Util::FieldHash> contain special functions
108 for manipulating hashes that don't really warrant a keyword.
109
110 C<Hash::Util> contains a set of functions that support
111 L<restricted hashes|/"Restricted hashes">. These are described in
112 this document.  C<Hash::Util::FieldHash> contains an (unrelated)
113 set of functions that support the use of hashes in
114 I<inside-out classes>, described in L<Hash::Util::FieldHash>.
115
116 By default C<Hash::Util> does not export anything.
117
118 =head2 Restricted hashes
119
120 5.8.0 introduces the ability to restrict a hash to a certain set of
121 keys.  No keys outside of this set can be added.  It also introduces
122 the ability to lock an individual key so it cannot be deleted and the
123 ability to ensure that an individual value cannot be changed.
124
125 This is intended to largely replace the deprecated pseudo-hashes.
126
127 =over 4
128
129 =item B<lock_keys>
130
131 =item B<unlock_keys>
132
133   lock_keys(%hash);
134   lock_keys(%hash, @keys);
135
136 Restricts the given %hash's set of keys to @keys.  If @keys is not
137 given it restricts it to its current keyset.  No more keys can be
138 added. delete() and exists() will still work, but will not alter
139 the set of allowed keys. B<Note>: the current implementation prevents
140 the hash from being bless()ed while it is in a locked state. Any attempt
141 to do so will raise an exception. Of course you can still bless()
142 the hash before you call lock_keys() so this shouldn't be a problem.
143
144   unlock_keys(%hash);
145
146 Removes the restriction on the %hash's keyset.
147
148 B<Note> that if any of the values of the hash have been locked they will not
149 be unlocked after this sub executes.
150
151 Both routines return a reference to the hash operated on.
152
153 =cut
154
155 sub lock_ref_keys {
156     my($hash, @keys) = @_;
157
158     Internals::hv_clear_placeholders %$hash;
159     if( @keys ) {
160         my %keys = map { ($_ => 1) } @keys;
161         my %original_keys = map { ($_ => 1) } keys %$hash;
162         foreach my $k (keys %original_keys) {
163             croak "Hash has key '$k' which is not in the new key set"
164               unless $keys{$k};
165         }
166
167         foreach my $k (@keys) {
168             $hash->{$k} = undef unless exists $hash->{$k};
169         }
170         Internals::SvREADONLY %$hash, 1;
171
172         foreach my $k (@keys) {
173             delete $hash->{$k} unless $original_keys{$k};
174         }
175     }
176     else {
177         Internals::SvREADONLY %$hash, 1;
178     }
179
180     return $hash;
181 }
182
183 sub unlock_ref_keys {
184     my $hash = shift;
185
186     Internals::SvREADONLY %$hash, 0;
187     return $hash;
188 }
189
190 sub   lock_keys (\%;@) {   lock_ref_keys(@_) }
191 sub unlock_keys (\%)   { unlock_ref_keys(@_) }
192
193 =item B<lock_keys_plus>
194
195   lock_keys_plus(%hash,@additional_keys)
196
197 Similar to C<lock_keys()>, with the difference being that the optional key list
198 specifies keys that may or may not be already in the hash. Essentially this is
199 an easier way to say
200
201   lock_keys(%hash,@additional_keys,keys %hash);
202
203 Returns a reference to %hash
204
205 =cut
206
207
208 sub lock_ref_keys_plus {
209     my ($hash,@keys)=@_;
210     my @delete;
211     Internals::hv_clear_placeholders(%$hash);
212     foreach my $key (@keys) {
213         unless (exists($hash->{$key})) {
214             $hash->{$key}=undef;
215             push @delete,$key;
216         }
217     }
218     Internals::SvREADONLY(%$hash,1);
219     delete @{$hash}{@delete};
220     return $hash
221 }
222
223 sub lock_keys_plus(\%;@) { lock_ref_keys_plus(@_) }
224
225
226 =item B<lock_value>
227
228 =item B<unlock_value>
229
230   lock_value  (%hash, $key);
231   unlock_value(%hash, $key);
232
233 Locks and unlocks the value for an individual key of a hash.  The value of a
234 locked key cannot be changed.
235
236 Unless %hash has already been locked the key/value could be deleted
237 regardless of this setting.
238
239 Returns a reference to the %hash.
240
241 =cut
242
243 sub lock_ref_value {
244     my($hash, $key) = @_;
245     # I'm doubtful about this warning, as it seems not to be true.
246     # Marking a value in the hash as RO is useful, regardless
247     # of the status of the hash itself.
248     carp "Cannot usefully lock values in an unlocked hash"
249       if !Internals::SvREADONLY(%$hash) && warnings::enabled;
250     Internals::SvREADONLY $hash->{$key}, 1;
251     return $hash
252 }
253
254 sub unlock_ref_value {
255     my($hash, $key) = @_;
256     Internals::SvREADONLY $hash->{$key}, 0;
257     return $hash
258 }
259
260 sub   lock_value (\%$) {   lock_ref_value(@_) }
261 sub unlock_value (\%$) { unlock_ref_value(@_) }
262
263
264 =item B<lock_hash>
265
266 =item B<unlock_hash>
267
268     lock_hash(%hash);
269
270 lock_hash() locks an entire hash, making all keys and values read-only.
271 No value can be changed, no keys can be added or deleted.
272
273     unlock_hash(%hash);
274
275 unlock_hash() does the opposite of lock_hash().  All keys and values
276 are made writable.  All values can be changed and keys can be added
277 and deleted.
278
279 Returns a reference to the %hash.
280
281 =cut
282
283 sub lock_hashref {
284     my $hash = shift;
285
286     lock_ref_keys($hash);
287
288     foreach my $value (values %$hash) {
289         Internals::SvREADONLY($value,1);
290     }
291
292     return $hash;
293 }
294
295 sub unlock_hashref {
296     my $hash = shift;
297
298     foreach my $value (values %$hash) {
299         Internals::SvREADONLY($value, 0);
300     }
301
302     unlock_ref_keys($hash);
303
304     return $hash;
305 }
306
307 sub   lock_hash (\%) {   lock_hashref(@_) }
308 sub unlock_hash (\%) { unlock_hashref(@_) }
309
310 =item B<lock_hash_recurse>
311
312 =item B<unlock_hash_recurse>
313
314     lock_hash_recurse(%hash);
315
316 lock_hash() locks an entire hash and any hashes it references recursively,
317 making all keys and values read-only. No value can be changed, no keys can
318 be added or deleted.
319
320 This method B<only> recurses into hashes that are referenced by another hash.
321 Thus a Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of
322 Hashes (HoAoH) will only have the top hash restricted.
323
324     unlock_hash_recurse(%hash);
325
326 unlock_hash_recurse() does the opposite of lock_hash_recurse().  All keys and
327 values are made writable.  All values can be changed and keys can be added
328 and deleted. Identical recursion restrictions apply as to lock_hash_recurse().
329
330 Returns a reference to the %hash.
331
332 =cut
333
334 sub lock_hashref_recurse {
335     my $hash = shift;
336
337     lock_ref_keys($hash);
338     foreach my $value (values %$hash) {
339         my $type = reftype($value);
340         if (defined($type) and $type eq 'HASH') {
341             lock_hashref_recurse($value);
342         }
343         Internals::SvREADONLY($value,1);
344     }
345     return $hash
346 }
347
348 sub unlock_hashref_recurse {
349     my $hash = shift;
350
351     foreach my $value (values %$hash) {
352         my $type = reftype($value);
353         if (defined($type) and $type eq 'HASH') {
354             unlock_hashref_recurse($value);
355         }
356         Internals::SvREADONLY($value,1);
357     }
358     unlock_ref_keys($hash);
359     return $hash;
360 }
361
362 sub   lock_hash_recurse (\%) {   lock_hashref_recurse(@_) }
363 sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
364
365 =item B<hashref_locked>
366
367 =item B<hash_locked>
368
369   hashref_locked(\%hash) and print "Hash is locked!\n";
370   hash_locked(%hash) and print "Hash is locked!\n";
371
372 Returns true if the hash and its keys are locked.
373
374 =cut
375
376 sub hashref_locked {
377     my $hash=shift;
378     Internals::SvREADONLY(%$hash);
379 }
380
381 sub hash_locked(\%) { hashref_locked(@_) }
382
383 =item B<hashref_unlocked>
384
385 =item B<hash_unlocked>
386
387   hashref_unlocked(\%hash) and print "Hash is unlocked!\n";
388   hash_unlocked(%hash) and print "Hash is unlocked!\n";
389
390 Returns true if the hash and its keys are unlocked.
391
392 =cut
393
394 sub hashref_unlocked {
395     my $hash=shift;
396     !Internals::SvREADONLY(%$hash);
397 }
398
399 sub hash_unlocked(\%) { hashref_unlocked(@_) }
400
401 =for demerphqs_editor
402 sub legal_ref_keys{}
403 sub hidden_ref_keys{}
404 sub all_keys{}
405
406 =cut
407
408 sub legal_keys(\%) { legal_ref_keys(@_)  }
409 sub hidden_keys(\%){ hidden_ref_keys(@_) }
410
411 =item B<legal_keys>
412
413   my @keys = legal_keys(%hash);
414
415 Returns the list of the keys that are legal in a restricted hash.
416 In the case of an unrestricted hash this is identical to calling
417 keys(%hash).
418
419 =item B<hidden_keys>
420
421   my @keys = hidden_keys(%hash);
422
423 Returns the list of the keys that are legal in a restricted hash but
424 do not have a value associated to them. Thus if 'foo' is a
425 "hidden" key of the %hash it will return false for both C<defined>
426 and C<exists> tests.
427
428 In the case of an unrestricted hash this will return an empty list.
429
430 B<NOTE> this is an experimental feature that is heavily dependent
431 on the current implementation of restricted hashes. Should the
432 implementation change, this routine may become meaningless, in which
433 case it will return an empty list.
434
435 =item B<all_keys>
436
437   all_keys(%hash,@keys,@hidden);
438
439 Populates the arrays @keys with the all the keys that would pass
440 an C<exists> tests, and populates @hidden with the remaining legal
441 keys that have not been utilized.
442
443 Returns a reference to the hash.
444
445 In the case of an unrestricted hash this will be equivalent to
446
447   $ref = do {
448       @keys = keys %hash;
449       @hidden = ();
450       \%hash
451   };
452
453 B<NOTE> this is an experimental feature that is heavily dependent
454 on the current implementation of restricted hashes. Should the
455 implementation change this routine may become meaningless in which
456 case it will behave identically to how it would behave on an
457 unrestricted hash.
458
459 =item B<hash_seed>
460
461     my $hash_seed = hash_seed();
462
463 hash_seed() returns the seed bytes used to randomise hash ordering.
464
465 B<Note that the hash seed is sensitive information>: by knowing it one
466 can craft a denial-of-service attack against Perl code, even remotely,
467 see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
468 B<Do not disclose the hash seed> to people who don't need to know it.
469 See also L<perlrun/PERL_HASH_SEED_DEBUG>.
470
471 Prior to Perl 5.17.6 this function returned a UV, it now returns a string,
472 which may be of nearly any size as determined by the hash function your
473 Perl has been built with. Possible sizes may be but are not limited to
474 4 bytes (for most hash algorithms) and 16 bytes (for siphash).
475
476 =item B<hash_value>
477
478     my $hash_value = hash_value($string);
479
480 hash_value() returns the current perls internal hash value for a given
481 string.
482
483 Returns a 32 bit integer representing the hash value of the string passed
484 in. This value is only reliable for the lifetime of the process. It may
485 be different depending on invocation, environment variables,  perl version,
486 architectures, and build options.
487
488 B<Note that the hash value of a given string is sensitive information>:
489 by knowing it one can deduce the hash seed which in turn can allow one to
490 craft a denial-of-service attack against Perl code, even remotely,
491 see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
492 B<Do not disclose the hash value of a string> to people who don't need to
493 know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>.
494
495 =item B<bucket_info>
496
497 Return a set of basic information about a hash.
498
499     my ($keys, $buckets, $used, @length_counts)= bucket_info($hash);
500
501 Fields are as follows:
502
503     0: Number of keys in the hash
504     1: Number of buckets in the hash
505     2: Number of used buckets in the hash
506     rest : list of counts, Kth element is the number of buckets
507            with K keys in it.
508
509 See also bucket_stats() and bucket_array().
510
511 =item B<bucket_stats>
512
513 Returns a list of statistics about a hash.
514
515     my ($keys, buckets, $used, $utilization_ratio, $collision_pct,
516         $mean, $stddev, @length_counts)= bucket_info($hashref);
517
518
519 Fields are as follows:
520
521
522     0: Number of keys in the hash
523     1: Number of buckets in the hash
524     2: Number of used buckets in the hash
525     3: Percent of buckets used
526     4: Percent of keys which are in collision
527     5: Average bucket length
528     6: Standard Deviation of bucket lengths.
529     rest : list of counts, Kth element is the number of buckets
530            with K keys in it.
531
532 See also bucket_info() and bucket_array().
533
534 =item B<bucket_array>
535
536     my $array= bucket_array(\%hash);
537
538 Returns a packed representation of the bucket array associated with a hash. Each element
539 of the array is either an integer K, in which case it represents K empty buckets, or
540 a reference to another array which contains the keys that are in that bucket.
541
542 B<Note that the information returned by bucket_array is sensitive information>:
543 by knowing it one can directly attack perls hash function which in turn may allow
544 one to craft a denial-of-service attack against Perl code, even remotely,
545 see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
546 B<Do not disclose the outputof this function> to people who don't need to
547 know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>. This function is provided strictly
548 for  debugging and diagnostics purposes only, it is hard to imagine a reason why it
549 would be used in production code.
550
551 =cut
552
553
554 sub bucket_stats {
555     my ($hash)= @_;
556     my ($keys, $buckets, $used, @length_counts)= bucket_info($hash);
557     my $sum;
558     $sum += ($length_counts[$_] * $_) for 0 .. $#length_counts;
559     my $mean= $sum/$buckets;
560     $sum= 0;
561     $sum += ($length_counts[$_] * (($_-$mean)**2)) for 0 .. $#length_counts;
562
563     my $stddev= sqrt($sum/$buckets);
564     return $keys, $buckets, $used, $keys ? ($used/$buckets, ($keys-$used)/$keys, $mean, $stddev, @length_counts) : ();
565 }
566
567 =item B<hv_store>
568
569   my $sv = 0;
570   hv_store(%hash,$key,$sv) or die "Failed to alias!";
571   $hash{$key} = 1;
572   print $sv; # prints 1
573
574 Stores an alias to a variable in a hash instead of copying the value.
575
576 =back
577
578 =head2 Operating on references to hashes.
579
580 Most subroutines documented in this module have equivalent versions
581 that operate on references to hashes instead of native hashes.
582 The following is a list of these subs. They are identical except
583 in name and in that instead of taking a %hash they take a $hashref,
584 and additionally are not prototyped.
585
586 =over 4
587
588 =item lock_ref_keys
589
590 =item unlock_ref_keys
591
592 =item lock_ref_keys_plus
593
594 =item lock_ref_value
595
596 =item unlock_ref_value
597
598 =item lock_hashref
599
600 =item unlock_hashref
601
602 =item lock_hashref_recurse
603
604 =item unlock_hashref_recurse
605
606 =item hash_ref_unlocked
607
608 =item legal_ref_keys
609
610 =item hidden_ref_keys
611
612 =back
613
614 =head1 CAVEATS
615
616 Note that the trapping of the restricted operations is not atomic:
617 for example
618
619     eval { %hash = (illegal_key => 1) }
620
621 leaves the C<%hash> empty rather than with its original contents.
622
623 =head1 BUGS
624
625 The interface exposed by this module is very close to the current
626 implementation of restricted hashes. Over time it is expected that
627 this behavior will be extended and the interface abstracted further.
628
629 =head1 AUTHOR
630
631 Michael G Schwern <schwern@pobox.com> on top of code by Nick
632 Ing-Simmons and Jeffrey Friedl.
633
634 hv_store() is from Array::RefElem, Copyright 2000 Gisle Aas.
635
636 Additional code by Yves Orton.
637
638 =head1 SEE ALSO
639
640 L<Scalar::Util>, L<List::Util> and L<perlsec/"Algorithmic Complexity Attacks">.
641
642 L<Hash::Util::FieldHash>.
643
644 =cut
645
646 1;