This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update documentation for hash_seed()
[perl5.git] / ext / Hash-Util / lib / Hash / Util.pm
CommitLineData
96c33d98
YO
1package Hash::Util;
2
3require 5.007003;
4use strict;
5use Carp;
6use warnings;
1e6ffe56 7no warnings 'uninitialized';
96c33d98
YO
8use warnings::register;
9use Scalar::Util qw(reftype);
10
11require Exporter;
12our @ISA = qw(Exporter);
13our @EXPORT_OK = qw(
1e73acc8
AS
14 fieldhash fieldhashes
15
96c33d98
YO
16 all_keys
17 lock_keys unlock_keys
18 lock_value unlock_value
19 lock_hash unlock_hash
08579537
JK
20 lock_keys_plus
21 hash_locked hash_unlocked
22 hashref_locked hashref_unlocked
96c33d98
YO
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
08579537 28 lock_ref_keys_plus
96c33d98
YO
29 hidden_ref_keys legal_ref_keys
30
77a92142 31 hash_seed hash_value hv_store
3eaa3d14 32 bucket_stats bucket_stats_formatted bucket_info bucket_array
5114d263 33 lock_hash_recurse unlock_hash_recurse
1437ab4a 34 lock_hashref_recurse unlock_hashref_recurse
4950784d
YO
35
36 hash_traversal_mask
8bf4c401
YO
37
38 bucket_ratio
39 used_buckets
40 num_buckets
96c33d98 41 );
10f9b9bf
YO
42BEGIN {
43 # make sure all our XS routines are available early so their prototypes
44 # are correctly applied in the following code.
1328e3b8 45 our $VERSION = '0.23';
10f9b9bf
YO
46 require XSLoader;
47 XSLoader::load();
48}
96c33d98 49
1e73acc8
AS
50sub import {
51 my $class = shift;
52 if ( grep /fieldhash/, @_ ) {
53 require Hash::Util::FieldHash;
54 Hash::Util::FieldHash->import(':all'); # for re-export
55 }
56 unshift @_, $class;
57 goto &Exporter::import;
58}
59
96c33d98
YO
60
61=head1 NAME
62
63Hash::Util - A selection of general-utility hash subroutines
64
65=head1 SYNOPSIS
66
1e73acc8
AS
67 # Restricted hashes
68
96c33d98 69 use Hash::Util qw(
08579537
JK
70 fieldhash fieldhashes
71
72 all_keys
96c33d98
YO
73 lock_keys unlock_keys
74 lock_value unlock_value
75 lock_hash unlock_hash
08579537
JK
76 lock_keys_plus
77 hash_locked hash_unlocked
78 hashref_locked hashref_unlocked
96c33d98 79 hidden_keys legal_keys
08579537
JK
80
81 lock_ref_keys unlock_ref_keys
82 lock_ref_value unlock_ref_value
83 lock_hashref unlock_hashref
84 lock_ref_keys_plus
85 hidden_ref_keys legal_ref_keys
86
77a92142 87 hash_seed hash_value hv_store
88 bucket_stats bucket_info bucket_array
5114d263 89 lock_hash_recurse unlock_hash_recurse
1437ab4a 90 lock_hashref_recurse unlock_hashref_recurse
4950784d
YO
91
92 hash_traversal_mask
96c33d98
YO
93 );
94
95 %hash = (foo => 42, bar => 23);
96 # Ways to restrict a hash
97 lock_keys(%hash);
98 lock_keys(%hash, @keyset);
99 lock_keys_plus(%hash, @additional_keys);
100
72712bfd
RGS
101 # Ways to inspect the properties of a restricted hash
102 my @legal = legal_keys(%hash);
103 my @hidden = hidden_keys(%hash);
104 my $ref = all_keys(%hash,@keys,@hidden);
105 my $is_locked = hash_locked(%hash);
96c33d98 106
72712bfd 107 # Remove restrictions on the hash
96c33d98
YO
108 unlock_keys(%hash);
109
72712bfd 110 # Lock individual values in a hash
96c33d98
YO
111 lock_value (%hash, 'foo');
112 unlock_value(%hash, 'foo');
113
72712bfd 114 # Ways to change the restrictions on both keys and values
96c33d98
YO
115 lock_hash (%hash);
116 unlock_hash(%hash);
117
1328e3b8 118 my $hashes_are_randomised = hash_seed() !~ /^\0+$/;
96c33d98 119
77a92142 120 my $int_hash_value = hash_value( 'string' );
121
4950784d
YO
122 my $mask= hash_traversal_mask(%hash);
123
124 hash_traversal_mask(%hash,1234);
125
96c33d98
YO
126=head1 DESCRIPTION
127
d74d639b
AS
128C<Hash::Util> and C<Hash::Util::FieldHash> contain special functions
129for manipulating hashes that don't really warrant a keyword.
1e73acc8 130
b299c47c
RGS
131C<Hash::Util> contains a set of functions that support
132L<restricted hashes|/"Restricted hashes">. These are described in
d74d639b
AS
133this document. C<Hash::Util::FieldHash> contains an (unrelated)
134set of functions that support the use of hashes in
135I<inside-out classes>, described in L<Hash::Util::FieldHash>.
1e73acc8 136
d74d639b 137By default C<Hash::Util> does not export anything.
1e73acc8 138
96c33d98
YO
139=head2 Restricted hashes
140
1415.8.0 introduces the ability to restrict a hash to a certain set of
142keys. No keys outside of this set can be added. It also introduces
143the ability to lock an individual key so it cannot be deleted and the
144ability to ensure that an individual value cannot be changed.
145
146This is intended to largely replace the deprecated pseudo-hashes.
147
148=over 4
149
150=item B<lock_keys>
151
152=item B<unlock_keys>
153
154 lock_keys(%hash);
155 lock_keys(%hash, @keys);
156
157Restricts the given %hash's set of keys to @keys. If @keys is not
158given it restricts it to its current keyset. No more keys can be
159added. delete() and exists() will still work, but will not alter
160the set of allowed keys. B<Note>: the current implementation prevents
161the hash from being bless()ed while it is in a locked state. Any attempt
162to do so will raise an exception. Of course you can still bless()
163the hash before you call lock_keys() so this shouldn't be a problem.
164
165 unlock_keys(%hash);
166
167Removes the restriction on the %hash's keyset.
168
5114d263
JK
169B<Note> that if any of the values of the hash have been locked they will not
170be unlocked after this sub executes.
96c33d98
YO
171
172Both routines return a reference to the hash operated on.
173
174=cut
175
176sub lock_ref_keys {
177 my($hash, @keys) = @_;
178
10f9b9bf 179 _clear_placeholders(%$hash);
96c33d98
YO
180 if( @keys ) {
181 my %keys = map { ($_ => 1) } @keys;
182 my %original_keys = map { ($_ => 1) } keys %$hash;
183 foreach my $k (keys %original_keys) {
184 croak "Hash has key '$k' which is not in the new key set"
185 unless $keys{$k};
186 }
187
188 foreach my $k (@keys) {
189 $hash->{$k} = undef unless exists $hash->{$k};
190 }
191 Internals::SvREADONLY %$hash, 1;
192
193 foreach my $k (@keys) {
194 delete $hash->{$k} unless $original_keys{$k};
195 }
196 }
197 else {
198 Internals::SvREADONLY %$hash, 1;
199 }
200
201 return $hash;
202}
203
204sub unlock_ref_keys {
205 my $hash = shift;
206
207 Internals::SvREADONLY %$hash, 0;
208 return $hash;
209}
210
211sub lock_keys (\%;@) { lock_ref_keys(@_) }
212sub unlock_keys (\%) { unlock_ref_keys(@_) }
213
10f9b9bf
YO
214#=item B<_clear_placeholders>
215#
216# This function removes any placeholder keys from a hash. See Perl_hv_clear_placeholders()
217# in hv.c for what it does exactly. It is currently exposed as XS by universal.c and
218# injected into the Hash::Util namespace.
219#
220# It is not intended for use outside of this module, and may be changed
221# or removed without notice or deprecation cycle.
222#
223#=cut
224#
225# sub _clear_placeholders {} # just in case someone searches...
226
96c33d98
YO
227=item B<lock_keys_plus>
228
229 lock_keys_plus(%hash,@additional_keys)
230
231Similar to C<lock_keys()>, with the difference being that the optional key list
232specifies keys that may or may not be already in the hash. Essentially this is
233an easier way to say
234
235 lock_keys(%hash,@additional_keys,keys %hash);
236
237Returns a reference to %hash
238
239=cut
240
241
242sub lock_ref_keys_plus {
77a92142 243 my ($hash,@keys) = @_;
96c33d98 244 my @delete;
10f9b9bf 245 _clear_placeholders(%$hash);
96c33d98
YO
246 foreach my $key (@keys) {
247 unless (exists($hash->{$key})) {
248 $hash->{$key}=undef;
249 push @delete,$key;
250 }
251 }
252 Internals::SvREADONLY(%$hash,1);
253 delete @{$hash}{@delete};
254 return $hash
255}
256
257sub lock_keys_plus(\%;@) { lock_ref_keys_plus(@_) }
258
259
260=item B<lock_value>
261
262=item B<unlock_value>
263
264 lock_value (%hash, $key);
265 unlock_value(%hash, $key);
266
267Locks and unlocks the value for an individual key of a hash. The value of a
268locked key cannot be changed.
269
270Unless %hash has already been locked the key/value could be deleted
271regardless of this setting.
272
273Returns a reference to the %hash.
274
275=cut
276
277sub lock_ref_value {
278 my($hash, $key) = @_;
279 # I'm doubtful about this warning, as it seems not to be true.
280 # Marking a value in the hash as RO is useful, regardless
281 # of the status of the hash itself.
282 carp "Cannot usefully lock values in an unlocked hash"
283 if !Internals::SvREADONLY(%$hash) && warnings::enabled;
284 Internals::SvREADONLY $hash->{$key}, 1;
285 return $hash
286}
287
288sub unlock_ref_value {
289 my($hash, $key) = @_;
290 Internals::SvREADONLY $hash->{$key}, 0;
291 return $hash
292}
293
294sub lock_value (\%$) { lock_ref_value(@_) }
295sub unlock_value (\%$) { unlock_ref_value(@_) }
296
297
298=item B<lock_hash>
299
300=item B<unlock_hash>
301
302 lock_hash(%hash);
303
72712bfd 304lock_hash() locks an entire hash, making all keys and values read-only.
96c33d98
YO
305No value can be changed, no keys can be added or deleted.
306
307 unlock_hash(%hash);
308
309unlock_hash() does the opposite of lock_hash(). All keys and values
310are made writable. All values can be changed and keys can be added
311and deleted.
312
313Returns a reference to the %hash.
314
315=cut
316
317sub lock_hashref {
318 my $hash = shift;
319
320 lock_ref_keys($hash);
321
322 foreach my $value (values %$hash) {
323 Internals::SvREADONLY($value,1);
324 }
325
326 return $hash;
327}
328
329sub unlock_hashref {
330 my $hash = shift;
331
332 foreach my $value (values %$hash) {
333 Internals::SvREADONLY($value, 0);
334 }
335
336 unlock_ref_keys($hash);
337
338 return $hash;
339}
340
341sub lock_hash (\%) { lock_hashref(@_) }
342sub unlock_hash (\%) { unlock_hashref(@_) }
343
344=item B<lock_hash_recurse>
345
346=item B<unlock_hash_recurse>
347
348 lock_hash_recurse(%hash);
349
350lock_hash() locks an entire hash and any hashes it references recursively,
72712bfd 351making all keys and values read-only. No value can be changed, no keys can
96c33d98
YO
352be added or deleted.
353
5114d263
JK
354This method B<only> recurses into hashes that are referenced by another hash.
355Thus a Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of
356Hashes (HoAoH) will only have the top hash restricted.
96c33d98
YO
357
358 unlock_hash_recurse(%hash);
359
360unlock_hash_recurse() does the opposite of lock_hash_recurse(). All keys and
361values are made writable. All values can be changed and keys can be added
362and deleted. Identical recursion restrictions apply as to lock_hash_recurse().
363
364Returns a reference to the %hash.
365
366=cut
367
368sub lock_hashref_recurse {
369 my $hash = shift;
370
371 lock_ref_keys($hash);
372 foreach my $value (values %$hash) {
2793cb42
CO
373 my $type = reftype($value);
374 if (defined($type) and $type eq 'HASH') {
96c33d98
YO
375 lock_hashref_recurse($value);
376 }
377 Internals::SvREADONLY($value,1);
378 }
379 return $hash
380}
381
382sub unlock_hashref_recurse {
383 my $hash = shift;
384
385 foreach my $value (values %$hash) {
2793cb42
CO
386 my $type = reftype($value);
387 if (defined($type) and $type eq 'HASH') {
96c33d98
YO
388 unlock_hashref_recurse($value);
389 }
0ddb27d7 390 Internals::SvREADONLY($value,0);
96c33d98
YO
391 }
392 unlock_ref_keys($hash);
393 return $hash;
394}
395
396sub lock_hash_recurse (\%) { lock_hashref_recurse(@_) }
397sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
398
5114d263
JK
399=item B<hashref_locked>
400
08579537
JK
401=item B<hash_locked>
402
5114d263 403 hashref_locked(\%hash) and print "Hash is locked!\n";
08579537
JK
404 hash_locked(%hash) and print "Hash is locked!\n";
405
406Returns true if the hash and its keys are locked.
407
408=cut
409
410sub hashref_locked {
411 my $hash=shift;
5114d263 412 Internals::SvREADONLY(%$hash);
08579537
JK
413}
414
415sub hash_locked(\%) { hashref_locked(@_) }
96c33d98 416
5114d263
JK
417=item B<hashref_unlocked>
418
96c33d98
YO
419=item B<hash_unlocked>
420
5114d263 421 hashref_unlocked(\%hash) and print "Hash is unlocked!\n";
96c33d98
YO
422 hash_unlocked(%hash) and print "Hash is unlocked!\n";
423
424Returns true if the hash and its keys are unlocked.
425
426=cut
427
428sub hashref_unlocked {
429 my $hash=shift;
5114d263 430 !Internals::SvREADONLY(%$hash);
96c33d98
YO
431}
432
433sub hash_unlocked(\%) { hashref_unlocked(@_) }
434
435=for demerphqs_editor
436sub legal_ref_keys{}
437sub hidden_ref_keys{}
438sub all_keys{}
439
440=cut
441
442sub legal_keys(\%) { legal_ref_keys(@_) }
443sub hidden_keys(\%){ hidden_ref_keys(@_) }
444
3a6a06e3 445=item B<legal_keys>
96c33d98 446
72712bfd 447 my @keys = legal_keys(%hash);
96c33d98 448
72712bfd 449Returns the list of the keys that are legal in a restricted hash.
96c33d98
YO
450In the case of an unrestricted hash this is identical to calling
451keys(%hash).
452
453=item B<hidden_keys>
454
72712bfd 455 my @keys = hidden_keys(%hash);
96c33d98 456
72712bfd 457Returns the list of the keys that are legal in a restricted hash but
96c33d98
YO
458do not have a value associated to them. Thus if 'foo' is a
459"hidden" key of the %hash it will return false for both C<defined>
460and C<exists> tests.
461
462In the case of an unrestricted hash this will return an empty list.
463
464B<NOTE> this is an experimental feature that is heavily dependent
465on the current implementation of restricted hashes. Should the
72712bfd 466implementation change, this routine may become meaningless, in which
96c33d98
YO
467case it will return an empty list.
468
469=item B<all_keys>
470
471 all_keys(%hash,@keys,@hidden);
472
473Populates the arrays @keys with the all the keys that would pass
474an C<exists> tests, and populates @hidden with the remaining legal
475keys that have not been utilized.
476
477Returns a reference to the hash.
478
72712bfd 479In the case of an unrestricted hash this will be equivalent to
96c33d98 480
72712bfd
RGS
481 $ref = do {
482 @keys = keys %hash;
483 @hidden = ();
484 \%hash
485 };
96c33d98
YO
486
487B<NOTE> this is an experimental feature that is heavily dependent
488on the current implementation of restricted hashes. Should the
489implementation change this routine may become meaningless in which
490case it will behave identically to how it would behave on an
72712bfd 491unrestricted hash.
96c33d98
YO
492
493=item B<hash_seed>
494
495 my $hash_seed = hash_seed();
496
7dc86639 497hash_seed() returns the seed bytes used to randomise hash ordering.
96c33d98
YO
498
499B<Note that the hash seed is sensitive information>: by knowing it one
500can craft a denial-of-service attack against Perl code, even remotely,
501see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
502B<Do not disclose the hash seed> to people who don't need to know it.
503See also L<perlrun/PERL_HASH_SEED_DEBUG>.
504
7dc86639
YO
505Prior to Perl 5.17.6 this function returned a UV, it now returns a string,
506which may be of nearly any size as determined by the hash function your
507Perl has been built with. Possible sizes may be but are not limited to
5084 bytes (for most hash algorithms) and 16 bytes (for siphash).
509
510=item B<hash_value>
511
512 my $hash_value = hash_value($string);
513
77a92142 514hash_value() returns the current perl's internal hash value for a given
7dc86639
YO
515string.
516
517Returns a 32 bit integer representing the hash value of the string passed
518in. This value is only reliable for the lifetime of the process. It may
519be different depending on invocation, environment variables, perl version,
520architectures, and build options.
521
522B<Note that the hash value of a given string is sensitive information>:
523by knowing it one can deduce the hash seed which in turn can allow one to
524craft a denial-of-service attack against Perl code, even remotely,
525see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
526B<Do not disclose the hash value of a string> to people who don't need to
527know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>.
528
529=item B<bucket_info>
530
531Return a set of basic information about a hash.
532
9fc1b446 533 my ($keys, $buckets, $used, @length_counts)= bucket_info($hash);
7dc86639
YO
534
535Fields are as follows:
536
537 0: Number of keys in the hash
538 1: Number of buckets in the hash
539 2: Number of used buckets in the hash
540 rest : list of counts, Kth element is the number of buckets
541 with K keys in it.
542
543See also bucket_stats() and bucket_array().
544
545=item B<bucket_stats>
546
547Returns a list of statistics about a hash.
548
e09da698
KW
549 my ($keys, $buckets, $used, $quality, $utilization_ratio,
550 $collision_pct, $mean, $stddev, @length_counts)
551 = bucket_stats($hashref);
7dc86639
YO
552
553Fields are as follows:
554
7dc86639
YO
555 0: Number of keys in the hash
556 1: Number of buckets in the hash
557 2: Number of used buckets in the hash
a740dcb9
YO
558 3: Hash Quality Score
559 4: Percent of buckets used
560 5: Percent of keys which are in collision
3eaa3d14
YO
561 6: Mean bucket length of occupied buckets
562 7: Standard Deviation of bucket lengths of occupied buckets
7dc86639
YO
563 rest : list of counts, Kth element is the number of buckets
564 with K keys in it.
565
566See also bucket_info() and bucket_array().
567
a740dcb9
YO
568Note that Hash Quality Score would be 1 for an ideal hash, numbers
569close to and below 1 indicate good hashing, and number significantly
570above indicate a poor score. In practice it should be around 0.95 to 1.05.
571It is defined as:
572
573 $score= sum( $count[$length] * ($length * ($length + 1) / 2) )
574 /
575 ( ( $keys / 2 * $buckets ) *
576 ( $keys + ( 2 * $buckets ) - 1 ) )
577
578The formula is from the Red Dragon book (reformulated to use the data available)
579and is documented at L<http://www.strchr.com/hash_functions>
580
7dc86639
YO
581=item B<bucket_array>
582
583 my $array= bucket_array(\%hash);
584
585Returns a packed representation of the bucket array associated with a hash. Each element
586of the array is either an integer K, in which case it represents K empty buckets, or
587a reference to another array which contains the keys that are in that bucket.
588
589B<Note that the information returned by bucket_array is sensitive information>:
77a92142 590by knowing it one can directly attack perl's hash function which in turn may allow
7dc86639
YO
591one to craft a denial-of-service attack against Perl code, even remotely,
592see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
77a92142 593B<Do not disclose the output of this function> to people who don't need to
7dc86639
YO
594know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>. This function is provided strictly
595for debugging and diagnostics purposes only, it is hard to imagine a reason why it
596would be used in production code.
597
96c33d98
YO
598=cut
599
7dc86639
YO
600
601sub bucket_stats {
77a92142 602 my ($hash) = @_;
603 my ($keys, $buckets, $used, @length_counts) = bucket_info($hash);
7dc86639 604 my $sum;
a740dcb9 605 my $score;
3eaa3d14 606 for (1 .. $#length_counts) {
a740dcb9
YO
607 $sum += ($length_counts[$_] * $_);
608 $score += $length_counts[$_] * ( $_ * ($_ + 1 ) / 2 );
609 }
610 $score = $score /
611 (( $keys / (2 * $buckets )) * ( $keys + ( 2 * $buckets ) - 1 ))
612 if $keys;
3eaa3d14
YO
613 my ($mean, $stddev)= (0, 0);
614 if ($used) {
615 $mean= $sum / $used;
616 $sum= 0;
617 $sum += ($length_counts[$_] * (($_-$mean)**2)) for 1 .. $#length_counts;
7dc86639 618
3eaa3d14
YO
619 $stddev= sqrt($sum/$used);
620 }
a740dcb9 621 return $keys, $buckets, $used, $keys ? ($score, $used/$buckets, ($keys-$used)/$keys, $mean, $stddev, @length_counts) : ();
96c33d98
YO
622}
623
3eaa3d14
YO
624=item B<bucket_stats_formatted>
625
626 print bucket_stats_formatted($hashref);
627
628Return a formatted report of the information returned by bucket_stats().
629An example report looks like this:
630
e09da698
KW
631 Keys: 50 Buckets: 33/64 Quality-Score: 1.01 (Good)
632 Utilized Buckets: 51.56% Optimal: 78.12% Keys In Collision: 34.00%
633 Chain Length - mean: 1.52 stddev: 0.66
634 Buckets 64 [0000000000000000000000000000000111111111111111111122222222222333]
635 Len 0 Pct: 48.44 [###############################]
636 Len 1 Pct: 29.69 [###################]
637 Len 2 Pct: 17.19 [###########]
638 Len 3 Pct: 4.69 [###]
639 Keys 50 [11111111111111111111111111111111122222222222222333]
640 Pos 1 Pct: 66.00 [#################################]
641 Pos 2 Pct: 28.00 [##############]
642 Pos 3 Pct: 6.00 [###]
3eaa3d14
YO
643
644The first set of stats gives some summary statistical information,
645including the quality score translated into "Good", "Poor" and "Bad",
646(score<=1.05, score<=1.2, score>1.2). See the documentation in
647bucket_stats() for more details.
648
649The two sets of barcharts give stats and a visual indication of performance
650of the hash.
651
652The first gives data on bucket chain lengths and provides insight on how
653much work a fetch *miss* will take. In this case we have to inspect every item
654in a bucket before we can be sure the item is not in the list. The performance
655for an insert is equivalent to this case, as is a delete where the item
656is not in the hash.
657
658The second gives data on how many keys are at each depth in the chain, and
659gives an idea of how much work a fetch *hit* will take. The performance for
660an update or delete of an item in the hash is equivalent to this case.
661
662Note that these statistics are summary only. Actual performance will depend
663on real hit/miss ratios accessing the hash. If you are concerned by hit ratios
664you are recommended to "oversize" your hash by using something like:
665
666 keys(%hash)= keys(%hash) << $k;
667
668With $k chosen carefully, and likely to be a small number like 1 or 2. In
669theory the larger the bucket array the less chance of collision.
670
671=cut
672
673
674sub _bucket_stats_formatted_bars {
675 my ($total, $ary, $start_idx, $title, $row_title)= @_;
676
677 my $return = "";
678 my $max_width= $total > 64 ? 64 : $total;
679 my $bar_width= $max_width / $total;
680
681 my $str= "";
682 if ( @$ary < 10) {
683 for my $idx ($start_idx .. $#$ary) {
684 $str .= $idx x sprintf("%.0f", ($ary->[$idx] * $bar_width));
685 }
686 } else {
687 $str= "-" x $max_width;
688 }
689 $return .= sprintf "%-7s %6d [%s]\n",$title, $total, $str;
690
691 foreach my $idx ($start_idx .. $#$ary) {
692 $return .= sprintf "%-.3s %3d %6.2f%% %6d [%s]\n",
693 $row_title,
694 $idx,
695 $ary->[$idx] / $total * 100,
696 $ary->[$idx],
697 "#" x sprintf("%.0f", ($ary->[$idx] * $bar_width)),
698 ;
699 }
700 return $return;
701}
702
703sub bucket_stats_formatted {
704 my ($hashref)= @_;
705 my ($keys, $buckets, $used, $score, $utilization_ratio, $collision_pct,
706 $mean, $stddev, @length_counts) = bucket_stats($hashref);
707
708 my $return= sprintf "Keys: %d Buckets: %d/%d Quality-Score: %.2f (%s)\n"
709 . "Utilized Buckets: %.2f%% Optimal: %.2f%% Keys In Collision: %.2f%%\n"
710 . "Chain Length - mean: %.2f stddev: %.2f\n",
711 $keys, $used, $buckets, $score, $score <= 1.05 ? "Good" : $score < 1.2 ? "Poor" : "Bad",
712 $utilization_ratio * 100,
713 $keys/$buckets * 100,
714 $collision_pct * 100,
715 $mean, $stddev;
716
717 my @key_depth;
718 $key_depth[$_]= $length_counts[$_] + ( $key_depth[$_+1] || 0 )
719 for reverse 1 .. $#length_counts;
720
721 if ($keys) {
722 $return .= _bucket_stats_formatted_bars($buckets, \@length_counts, 0, "Buckets", "Len");
723 $return .= _bucket_stats_formatted_bars($keys, \@key_depth, 1, "Keys", "Pos");
724 }
725 return $return
726}
727
96c33d98
YO
728=item B<hv_store>
729
72712bfd 730 my $sv = 0;
96c33d98 731 hv_store(%hash,$key,$sv) or die "Failed to alias!";
72712bfd 732 $hash{$key} = 1;
96c33d98
YO
733 print $sv; # prints 1
734
735Stores an alias to a variable in a hash instead of copying the value.
736
4950784d
YO
737=item B<hash_traversal_mask>
738
4d74c8eb
SM
739As of Perl 5.18 every hash has its own hash traversal order, and this order
740changes every time a new element is inserted into the hash. This functionality
4950784d 741is provided by maintaining an unsigned integer mask (U32) which is xor'ed
4d74c8eb 742with the actual bucket id during a traversal of the hash buckets using keys(),
4950784d
YO
743values() or each().
744
745You can use this subroutine to get and set the traversal mask for a specific
746hash. Setting the mask ensures that a given hash will produce the same key
4d74c8eb 747order. B<Note> that this does B<not> guarantee that B<two> hashes will produce
4950784d
YO
748the same key order for the same hash seed and traversal mask, items that
749collide into one bucket may have different orders regardless of this setting.
750
8bf4c401
YO
751=item B<bucket_ratio>
752
753This function behaves the same way that scalar(%hash) behaved prior to
754Perl 5.25. Specifically if the hash is tied, then it calls the SCALAR tied
755hash method, if untied then if the hash is empty it return 0, otherwise it
756returns a string containing the number of used buckets in the hash,
757followed by a slash, followed by the total number of buckets in the hash.
758
759 my %hash=("foo"=>1);
760 print Hash::Util::bucket_ratio(%hash); # prints "1/8"
761
762=item B<used_buckets>
763
764This function returns the count of used buckets in the hash. It is expensive
765to calculate and the value is NOT cached, so avoid use of this function
766in production code.
767
768=item B<num_buckets>
769
770This function returns the total number of buckets the hash holds, or would
771hold if the array were created. (When a hash is freshly created the array
772may not be allocated even though this value will be non-zero.)
773
96c33d98
YO
774=back
775
776=head2 Operating on references to hashes.
777
72712bfd 778Most subroutines documented in this module have equivalent versions
96c33d98
YO
779that operate on references to hashes instead of native hashes.
780The following is a list of these subs. They are identical except
781in name and in that instead of taking a %hash they take a $hashref,
782and additionally are not prototyped.
783
784=over 4
785
786=item lock_ref_keys
787
788=item unlock_ref_keys
789
790=item lock_ref_keys_plus
791
792=item lock_ref_value
793
794=item unlock_ref_value
795
796=item lock_hashref
797
798=item unlock_hashref
799
800=item lock_hashref_recurse
801
802=item unlock_hashref_recurse
803
804=item hash_ref_unlocked
805
806=item legal_ref_keys
807
808=item hidden_ref_keys
809
810=back
811
812=head1 CAVEATS
813
814Note that the trapping of the restricted operations is not atomic:
815for example
816
817 eval { %hash = (illegal_key => 1) }
818
819leaves the C<%hash> empty rather than with its original contents.
820
821=head1 BUGS
822
823The interface exposed by this module is very close to the current
72712bfd 824implementation of restricted hashes. Over time it is expected that
96c33d98
YO
825this behavior will be extended and the interface abstracted further.
826
827=head1 AUTHOR
828
829Michael G Schwern <schwern@pobox.com> on top of code by Nick
830Ing-Simmons and Jeffrey Friedl.
831
832hv_store() is from Array::RefElem, Copyright 2000 Gisle Aas.
833
834Additional code by Yves Orton.
835
836=head1 SEE ALSO
837
d74d639b
AS
838L<Scalar::Util>, L<List::Util> and L<perlsec/"Algorithmic Complexity Attacks">.
839
840L<Hash::Util::FieldHash>.
96c33d98
YO
841
842=cut
843
8441;