[Summary view] [Print] [Text view]

   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;