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;