1package Hash::Util; 2 3require 5.007003; 4use strict; 5use Carp; 6use warnings; 7no warnings 'uninitialized'; 8use warnings::register; 9no warnings 'experimental::builtin'; 10use builtin qw(reftype); 11 12require Exporter; 13our @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 hv_store 32 bucket_stats bucket_stats_formatted bucket_info bucket_array 33 lock_hash_recurse unlock_hash_recurse 34 lock_hashref_recurse unlock_hashref_recurse 35 36 hash_traversal_mask 37 38 bucket_ratio 39 used_buckets 40 num_buckets 41 ); 42BEGIN { 43 # make sure all our XS routines are available early so their prototypes 44 # are correctly applied in the following code. 45 our $VERSION = '0.32'; 46 require XSLoader; 47 XSLoader::load(); 48} 49 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 60 61=head1 NAME 62 63Hash::Util - A selection of general-utility hash subroutines 64 65=head1 SYNOPSIS 66 67 # Restricted hashes 68 69 use Hash::Util qw( 70 fieldhash fieldhashes 71 72 all_keys 73 lock_keys unlock_keys 74 lock_value unlock_value 75 lock_hash unlock_hash 76 lock_keys_plus 77 hash_locked hash_unlocked 78 hashref_locked hashref_unlocked 79 hidden_keys legal_keys 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 87 hash_seed hash_value hv_store 88 bucket_stats bucket_info bucket_array 89 lock_hash_recurse unlock_hash_recurse 90 lock_hashref_recurse unlock_hashref_recurse 91 92 hash_traversal_mask 93 ); 94 95 my %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 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); 106 107 # Remove restrictions on the hash 108 unlock_keys(%hash); 109 110 # Lock individual values in a hash 111 lock_value (%hash, 'foo'); 112 unlock_value(%hash, 'foo'); 113 114 # Ways to change the restrictions on both keys and values 115 lock_hash (%hash); 116 unlock_hash(%hash); 117 118 my $hashes_are_randomised = hash_seed() !~ /^\0+$/; 119 120 my $int_hash_value = hash_value( 'string' ); 121 122 my $mask= hash_traversal_mask(%hash); 123 124 hash_traversal_mask(%hash,1234); 125 126=head1 DESCRIPTION 127 128C<Hash::Util> and C<Hash::Util::FieldHash> contain special functions 129for manipulating hashes that don't really warrant a keyword. 130 131C<Hash::Util> contains a set of functions that support 132L<restricted hashes|/"Restricted hashes">. These are described in 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>. 136 137By default C<Hash::Util> does not export anything. 138 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 169B<Note> that if any of the values of the hash have been locked they will not 170be unlocked after this sub executes. 171 172Both routines return a reference to the hash operated on. 173 174=cut 175 176sub lock_ref_keys { 177 my($hash, @keys) = @_; 178 179 _clear_placeholders(%$hash); 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 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 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 { 243 my ($hash,@keys) = @_; 244 my @delete; 245 _clear_placeholders(%$hash); 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 304lock_hash() locks an entire hash, making all keys and values read-only. 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, 351making all keys and values read-only. No value can be changed, no keys can 352be added or deleted. 353 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. 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) { 373 my $type = reftype($value); 374 if (defined($type) and $type eq 'HASH') { 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) { 386 my $type = reftype($value); 387 if (defined($type) and $type eq 'HASH') { 388 unlock_hashref_recurse($value); 389 } 390 Internals::SvREADONLY($value,0); 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 399=item B<hashref_locked> 400 401=item B<hash_locked> 402 403 hashref_locked(\%hash) and print "Hash is locked!\n"; 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; 412 Internals::SvREADONLY(%$hash); 413} 414 415sub hash_locked(\%) { hashref_locked(@_) } 416 417=item B<hashref_unlocked> 418 419=item B<hash_unlocked> 420 421 hashref_unlocked(\%hash) and print "Hash is unlocked!\n"; 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; 430 !Internals::SvREADONLY(%$hash); 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 445=item B<legal_keys> 446 447 my @keys = legal_keys(%hash); 448 449Returns the list of the keys that are legal in a restricted hash. 450In the case of an unrestricted hash this is identical to calling 451keys(%hash). 452 453=item B<hidden_keys> 454 455 my @keys = hidden_keys(%hash); 456 457Returns the list of the keys that are legal in a restricted hash but 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 466implementation change, this routine may become meaningless, in which 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 479In the case of an unrestricted hash this will be equivalent to 480 481 $ref = do { 482 @keys = keys %hash; 483 @hidden = (); 484 \%hash 485 }; 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 491unrestricted hash. 492 493=item B<hash_seed> 494 495 my $hash_seed = hash_seed(); 496 497hash_seed() returns the seed bytes used to randomise hash ordering. 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 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 my $hash_value = hash_value($string, $seed); 514 515C<hash_value($string)> 516returns 517the current perl's internal hash value for a given string. 518C<hash_value($string, $seed)> 519returns the hash value as if computed with a different seed. 520If the custom seed is too short, the function errors out. 521The minimum length of the seed is implementation-dependent. 522 523Returns a 32-bit integer 524representing the hash value of the string passed in. 525The 1-parameter value is only reliable 526for the lifetime of the process. 527It may be different 528depending on invocation, environment variables, perl version, 529architectures, and build options. 530 531B<Note that the hash value of a given string is sensitive information>: 532by knowing it one can deduce the hash seed which in turn can allow one to 533craft a denial-of-service attack against Perl code, even remotely, 534see L<perlsec/"Algorithmic Complexity Attacks"> for more information. 535B<Do not disclose the hash value of a string> to people who don't need to 536know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>. 537 538=item B<bucket_info> 539 540Return a set of basic information about a hash. 541 542 my ($keys, $buckets, $used, @length_counts)= bucket_info($hash); 543 544Fields are as follows: 545 546 0: Number of keys in the hash 547 1: Number of buckets in the hash 548 2: Number of used buckets in the hash 549 rest : list of counts, Kth element is the number of buckets 550 with K keys in it. 551 552See also bucket_stats() and bucket_array(). 553 554=item B<bucket_stats> 555 556Returns a list of statistics about a hash. 557 558 my ($keys, $buckets, $used, $quality, $utilization_ratio, 559 $collision_pct, $mean, $stddev, @length_counts) 560 = bucket_stats($hashref); 561 562Fields are as follows: 563 564 0: Number of keys in the hash 565 1: Number of buckets in the hash 566 2: Number of used buckets in the hash 567 3: Hash Quality Score 568 4: Percent of buckets used 569 5: Percent of keys which are in collision 570 6: Mean bucket length of occupied buckets 571 7: Standard Deviation of bucket lengths of occupied buckets 572 rest : list of counts, Kth element is the number of buckets 573 with K keys in it. 574 575See also bucket_info() and bucket_array(). 576 577Note that Hash Quality Score would be 1 for an ideal hash, numbers 578close to and below 1 indicate good hashing, and number significantly 579above indicate a poor score. In practice it should be around 0.95 to 1.05. 580It is defined as: 581 582 $score= sum( $count[$length] * ($length * ($length + 1) / 2) ) 583 / 584 ( ( $keys / 2 * $buckets ) * 585 ( $keys + ( 2 * $buckets ) - 1 ) ) 586 587The formula is from the Red Dragon book (reformulated to use the data available) 588and is documented at L<http://www.strchr.com/hash_functions> 589 590=item B<bucket_array> 591 592 my $array= bucket_array(\%hash); 593 594Returns a packed representation of the bucket array associated with a hash. Each element 595of the array is either an integer K, in which case it represents K empty buckets, or 596a reference to another array which contains the keys that are in that bucket. 597 598B<Note that the information returned by bucket_array is sensitive information>: 599by knowing it one can directly attack perl's hash function which in turn may allow 600one to craft a denial-of-service attack against Perl code, even remotely, 601see L<perlsec/"Algorithmic Complexity Attacks"> for more information. 602B<Do not disclose the output of this function> to people who don't need to 603know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>. This function is provided strictly 604for debugging and diagnostics purposes only, it is hard to imagine a reason why it 605would be used in production code. 606 607=cut 608 609 610sub bucket_stats { 611 my ($hash) = @_; 612 my ($keys, $buckets, $used, @length_counts) = bucket_info($hash); 613 my $sum; 614 my $score; 615 for (1 .. $#length_counts) { 616 $sum += ($length_counts[$_] * $_); 617 $score += $length_counts[$_] * ( $_ * ($_ + 1 ) / 2 ); 618 } 619 $score = $score / 620 (( $keys / (2 * $buckets )) * ( $keys + ( 2 * $buckets ) - 1 )) 621 if $keys; 622 my ($mean, $stddev)= (0, 0); 623 if ($used) { 624 $mean= $sum / $used; 625 $sum= 0; 626 $sum += ($length_counts[$_] * (($_-$mean)**2)) for 1 .. $#length_counts; 627 628 $stddev= sqrt($sum/$used); 629 } 630 return $keys, $buckets, $used, $keys ? ($score, $used/$buckets, ($keys-$used)/$keys, $mean, $stddev, @length_counts) : (); 631} 632 633=item B<bucket_stats_formatted> 634 635 print bucket_stats_formatted($hashref); 636 637Return a formatted report of the information returned by bucket_stats(). 638An example report looks like this: 639 640 Keys: 50 Buckets: 33/64 Quality-Score: 1.01 (Good) 641 Utilized Buckets: 51.56% Optimal: 78.12% Keys In Collision: 34.00% 642 Chain Length - mean: 1.52 stddev: 0.66 643 Buckets 64 [0000000000000000000000000000000111111111111111111122222222222333] 644 Len 0 Pct: 48.44 [###############################] 645 Len 1 Pct: 29.69 [###################] 646 Len 2 Pct: 17.19 [###########] 647 Len 3 Pct: 4.69 [###] 648 Keys 50 [11111111111111111111111111111111122222222222222333] 649 Pos 1 Pct: 66.00 [#################################] 650 Pos 2 Pct: 28.00 [##############] 651 Pos 3 Pct: 6.00 [###] 652 653The first set of stats gives some summary statistical information, 654including the quality score translated into "Good", "Poor" and "Bad", 655(score<=1.05, score<=1.2, score>1.2). See the documentation in 656bucket_stats() for more details. 657 658The two sets of barcharts give stats and a visual indication of performance 659of the hash. 660 661The first gives data on bucket chain lengths and provides insight on how 662much work a fetch *miss* will take. In this case we have to inspect every item 663in a bucket before we can be sure the item is not in the list. The performance 664for an insert is equivalent to this case, as is a delete where the item 665is not in the hash. 666 667The second gives data on how many keys are at each depth in the chain, and 668gives an idea of how much work a fetch *hit* will take. The performance for 669an update or delete of an item in the hash is equivalent to this case. 670 671Note that these statistics are summary only. Actual performance will depend 672on real hit/miss ratios accessing the hash. If you are concerned by hit ratios 673you are recommended to "oversize" your hash by using something like: 674 675 keys(%hash)= keys(%hash) << $k; 676 677With $k chosen carefully, and likely to be a small number like 1 or 2. In 678theory the larger the bucket array the less chance of collision. 679 680=cut 681 682 683sub _bucket_stats_formatted_bars { 684 my ($total, $ary, $start_idx, $title, $row_title)= @_; 685 686 my $return = ""; 687 my $max_width= $total > 64 ? 64 : $total; 688 my $bar_width= $max_width / $total; 689 690 my $str= ""; 691 if ( @$ary < 10) { 692 for my $idx ($start_idx .. $#$ary) { 693 $str .= $idx x sprintf("%.0f", ($ary->[$idx] * $bar_width)); 694 } 695 } else { 696 $str= "-" x $max_width; 697 } 698 $return .= sprintf "%-7s %6d [%s]\n",$title, $total, $str; 699 700 foreach my $idx ($start_idx .. $#$ary) { 701 $return .= sprintf "%-.3s %3d %6.2f%% %6d [%s]\n", 702 $row_title, 703 $idx, 704 $ary->[$idx] / $total * 100, 705 $ary->[$idx], 706 "#" x sprintf("%.0f", ($ary->[$idx] * $bar_width)), 707 ; 708 } 709 return $return; 710} 711 712sub bucket_stats_formatted { 713 my ($hashref)= @_; 714 my ($keys, $buckets, $used, $score, $utilization_ratio, $collision_pct, 715 $mean, $stddev, @length_counts) = bucket_stats($hashref); 716 717 my $return= sprintf "Keys: %d Buckets: %d/%d Quality-Score: %.2f (%s)\n" 718 . "Utilized Buckets: %.2f%% Optimal: %.2f%% Keys In Collision: %.2f%%\n" 719 . "Chain Length - mean: %.2f stddev: %.2f\n", 720 $keys, $used, $buckets, $score, $score <= 1.05 ? "Good" : $score < 1.2 ? "Poor" : "Bad", 721 $utilization_ratio * 100, 722 $keys/$buckets * 100, 723 $collision_pct * 100, 724 $mean, $stddev; 725 726 my @key_depth; 727 $key_depth[$_]= $length_counts[$_] + ( $key_depth[$_+1] || 0 ) 728 for reverse 1 .. $#length_counts; 729 730 if ($keys) { 731 $return .= _bucket_stats_formatted_bars($buckets, \@length_counts, 0, "Buckets", "Len"); 732 $return .= _bucket_stats_formatted_bars($keys, \@key_depth, 1, "Keys", "Pos"); 733 } 734 return $return 735} 736 737=item B<hv_store> 738 739 my $sv = 0; 740 hv_store(%hash,$key,$sv) or die "Failed to alias!"; 741 $hash{$key} = 1; 742 print $sv; # prints 1 743 744Stores an alias to a variable in a hash instead of copying the value. 745 746=item B<hash_traversal_mask> 747 748As of Perl 5.18 every hash has its own hash traversal order, and this order 749changes every time a new element is inserted into the hash. This functionality 750is provided by maintaining an unsigned integer mask (U32) which is xor'ed 751with the actual bucket id during a traversal of the hash buckets using keys(), 752values() or each(). 753 754You can use this subroutine to get and set the traversal mask for a specific 755hash. Setting the mask ensures that a given hash will produce the same key 756order. B<Note> that this does B<not> guarantee that B<two> hashes will produce 757the same key order for the same hash seed and traversal mask, items that 758collide into one bucket may have different orders regardless of this setting. 759 760=item B<bucket_ratio> 761 762This function behaves the same way that scalar(%hash) behaved prior to 763Perl 5.25. Specifically if the hash is tied, then it calls the SCALAR tied 764hash method, if untied then if the hash is empty it return 0, otherwise it 765returns a string containing the number of used buckets in the hash, 766followed by a slash, followed by the total number of buckets in the hash. 767 768 my %hash=("foo"=>1); 769 print Hash::Util::bucket_ratio(%hash); # prints "1/8" 770 771=item B<used_buckets> 772 773This function returns the count of used buckets in the hash. It is expensive 774to calculate and the value is NOT cached, so avoid use of this function 775in production code. 776 777=item B<num_buckets> 778 779This function returns the total number of buckets the hash holds, or would 780hold if the array were created. (When a hash is freshly created the array 781may not be allocated even though this value will be non-zero.) 782 783=back 784 785=head2 Operating on references to hashes 786 787Most subroutines documented in this module have equivalent versions 788that operate on references to hashes instead of native hashes. 789The following is a list of these subs. They are identical except 790in name and in that instead of taking a %hash they take a $hashref, 791and additionally are not prototyped. 792 793=over 4 794 795=item lock_ref_keys 796 797=item unlock_ref_keys 798 799=item lock_ref_keys_plus 800 801=item lock_ref_value 802 803=item unlock_ref_value 804 805=item lock_hashref 806 807=item unlock_hashref 808 809=item lock_hashref_recurse 810 811=item unlock_hashref_recurse 812 813=item hash_ref_unlocked 814 815=item legal_ref_keys 816 817=item hidden_ref_keys 818 819=back 820 821=head1 CAVEATS 822 823Note that the trapping of the restricted operations is not atomic: 824for example 825 826 eval { %hash = (illegal_key => 1) } 827 828leaves the C<%hash> empty rather than with its original contents. 829 830=head1 BUGS 831 832The interface exposed by this module is very close to the current 833implementation of restricted hashes. Over time it is expected that 834this behavior will be extended and the interface abstracted further. 835 836=head1 AUTHOR 837 838Michael G Schwern <schwern@pobox.com> on top of code by Nick 839Ing-Simmons and Jeffrey Friedl. 840 841hv_store() is from Array::RefElem, Copyright 2000 Gisle Aas. 842 843Additional code by Yves Orton. 844 845Description of C<hash_value($string, $seed)> 846by Christopher Yeleighton <ne01026@shark.2a.pl> 847 848=head1 SEE ALSO 849 850L<Scalar::Util>, L<List::Util> and L<perlsec/"Algorithmic Complexity Attacks">. 851 852L<Hash::Util::FieldHash>. 853 854=cut 855 8561; 857