lib/Hash/Util.pm

   1 package Hash::Util;
   2
   3 require 5.007003;
   4 use strict;
   5 use Carp;
   6
   7 require Exporter;
   8 our @ISA        = qw(Exporter);
   9 our @EXPORT_OK  = qw(lock_keys unlock_keys lock_value unlock_value
  10                      lock_hash unlock_hash
  11                     );
  12 our $VERSION    = 0.05;
  13
  14 =head1 NAME
  15
  16 Hash::Util - A selection of general-utility hash subroutines
  17
  18 =head1 SYNOPSIS
  19
  20   use Hash::Util qw(lock_keys   unlock_keys
  21                     lock_value  unlock_value
  22                     lock_hash   unlock_hash);
  23
  24   %hash = (foo => 42, bar => 23);
  25   lock_keys(%hash);
  26   lock_keys(%hash, @keyset);
  27   unlock_keys(%hash);
  28
  29   lock_value  (%hash, 'foo');
  30   unlock_value(%hash, 'foo');
  31
  32   lock_hash  (%hash);
  33   unlock_hash(%hash);
  34
  35 =head1 DESCRIPTION
  36
  37 C<Hash::Util> contains special functions for manipulating hashes that
  38 don't really warrant a keyword.
  39
  40 By default C<Hash::Util> does not export anything.
  41
  42 =head2 Restricted hashes
  43
  44 5.8.0 introduces the ability to restrict a hash to a certain set of
  45 keys.  No keys outside of this set can be added.  It also introduces
  46 the ability to lock an individual key so it cannot be deleted and the
  47 value cannot be changed.
  48
  49 This is intended to largely replace the deprecated pseudo-hashes.
  50
  51 =over 4
  52
  53 =item lock_keys
  54
  55 =item unlock_keys
  56
  57   lock_keys(%hash);
  58   lock_keys(%hash, @keys);
  59
  60 Restricts the given %hash's set of keys to @keys.  If @keys is not
  61 given it restricts it to its current keyset.  No more keys can be
  62 added. delete() and exists() will still work, but will not alter
  63 the set of allowed keys. B<Note>: the current implementation prevents
  64 the hash from being bless()ed while it is in a locked state. Any attempt
  65 to do so will raise an exception. Of course you can still bless()
  66 the hash before you call lock_keys() so this shouldn't be a problem.
  67
  68   unlock_keys(%hash);
  69
  70 Removes the restriction on the %hash's keyset.
  71
  72 =cut
  73
  74 sub lock_keys (\%;@) {
  75     my($hash, @keys) = @_;
  76
  77     Internals::hv_clear_placeholders %$hash;
  78     if( @keys ) {
  79         my %keys = map { ($_ => 1) } @keys;
  80         my %original_keys = map { ($_ => 1) } keys %$hash;
  81         foreach my $k (keys %original_keys) {
  82             die sprintf "Hash has key '$k' which is not in the new key ".
  83                         "set at %s line %d\n", (caller)[1,2]
  84               unless $keys{$k};
  85         }
  86
  87         foreach my $k (@keys) {
  88             $hash->{$k} = undef unless exists $hash->{$k};
  89         }
  90         Internals::SvREADONLY %$hash, 1;
  91
  92         foreach my $k (@keys) {
  93             delete $hash->{$k} unless $original_keys{$k};
  94         }
  95     }
  96     else {
  97         Internals::SvREADONLY %$hash, 1;
  98     }
  99
 100     return;
 101 }
 102
 103 sub unlock_keys (\%) {
 104     my($hash) = shift;
 105
 106     Internals::SvREADONLY %$hash, 0;
 107     return;
 108 }
 109
 110 =item lock_value
 111
 112 =item unlock_value
 113
 114   lock_value  (%hash, $key);
 115   unlock_value(%hash, $key);
 116
 117 Locks and unlocks an individual key of a hash.  The value of a locked
 118 key cannot be changed.
 119
 120 %hash must have already been locked for this to have useful effect.
 121
 122 =cut
 123
 124 sub lock_value (\%$) {
 125     my($hash, $key) = @_;
 126     carp "Cannot usefully lock values in an unlocked hash"
 127       unless Internals::SvREADONLY %$hash;
 128     Internals::SvREADONLY $hash->{$key}, 1;
 129 }
 130
 131 sub unlock_value (\%$) {
 132     my($hash, $key) = @_;
 133     Internals::SvREADONLY $hash->{$key}, 0;
 134 }
 135
 136
 137 =item B<lock_hash>
 138
 139 =item B<unlock_hash>
 140
 141     lock_hash(%hash);
 142
 143 lock_hash() locks an entire hash, making all keys and values readonly.
 144 No value can be changed, no keys can be added or deleted.
 145
 146     unlock_hash(%hash);
 147
 148 unlock_hash() does the opposite of lock_hash().  All keys and values
 149 are made read/write.  All values can be changed and keys can be added
 150 and deleted.
 151
 152 =cut
 153
 154 sub lock_hash (\%) {
 155     my($hash) = shift;
 156
 157     lock_keys(%$hash);
 158
 159     foreach my $key (keys %$hash) {
 160         lock_value(%$hash, $key);
 161     }
 162
 163     return 1;
 164 }
 165
 166 sub unlock_hash (\%) {
 167     my($hash) = shift;
 168
 169     foreach my $key (keys %$hash) {
 170         unlock_value(%$hash, $key);
 171     }
 172
 173     unlock_keys(%$hash);
 174
 175     return 1;
 176 }
 177
 178
 179 =back
 180
 181 =head1 CAVEATS
 182
 183 Note that the trapping of the restricted operations is not atomic:
 184 for example
 185
 186     eval { %hash = (illegal_key => 1) }
 187
 188 leaves the C<%hash> empty rather than with its original contents.
 189
 190 =head1 AUTHOR
 191
 192 Michael G Schwern <schwern@pobox.com> on top of code by Nick
 193 Ing-Simmons and Jeffrey Friedl.
 194
 195 =head1 SEE ALSO
 196
 197 L<Scalar::Util>, L<List::Util>, L<Hash::Util>
 198
 199 =cut
 200
 201 1;