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.04;
  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 it does not effect
  63 the set of allowed keys.
  64
  65   unlock_keys(%hash;)
  66
  67 Removes the restriction on the %hash's keyset.
  68
  69 =cut
  70
  71 sub lock_keys (\%;@) {
  72     my($hash, @keys) = @_;
  73
  74     Internals::hv_clear_placeholders %$hash;
  75     if( @keys ) {
  76         my %keys = map { ($_ => 1) } @keys;
  77         my %original_keys = map { ($_ => 1) } keys %$hash;
  78         foreach my $k (keys %original_keys) {
  79             die sprintf "Hash has key '$k' which is not in the new key ".
  80                         "set at %s line %d\n", (caller)[1,2]
  81               unless $keys{$k};
  82         }
  83
  84         foreach my $k (@keys) {
  85             $hash->{$k} = undef unless exists $hash->{$k};
  86         }
  87         Internals::SvREADONLY %$hash, 1;
  88
  89         foreach my $k (@keys) {
  90             delete $hash->{$k} unless $original_keys{$k};
  91         }
  92     }
  93     else {
  94         Internals::SvREADONLY %$hash, 1;
  95     }
  96
  97     return;
  98 }
  99
 100 sub unlock_keys (\%) {
 101     my($hash) = shift;
 102
 103     Internals::SvREADONLY %$hash, 0;
 104     return;
 105 }
 106
 107 =item lock_value
 108
 109 =item unlock_value
 110
 111   lock_key  (%hash, $key);
 112   unlock_key(%hash, $key);
 113
 114 Locks and unlocks an individual key of a hash.  The value of a locked
 115 key cannot be changed.
 116
 117 %hash must have already been locked for this to have useful effect.
 118
 119 =cut
 120
 121 sub lock_value (\%$) {
 122     my($hash, $key) = @_;
 123     carp "Cannot usefully lock values in an unlocked hash"
 124       unless Internals::SvREADONLY %$hash;
 125     Internals::SvREADONLY $hash->{$key}, 1;
 126 }
 127
 128 sub unlock_value (\%$) {
 129     my($hash, $key) = @_;
 130     Internals::SvREADONLY $hash->{$key}, 0;
 131 }
 132
 133
 134 =item B<lock_hash>
 135
 136 =item B<unlock_hash>
 137
 138     lock_hash(%hash);
 139
 140 lock_hash() locks an entire hash, making all keys and values readonly.
 141 No value can be changed, no keys can be added or deleted.
 142
 143     unlock_hash(%hash);
 144
 145 unlock_hash() does the opposite of lock_hash().  All keys and values
 146 are made read/write.  All values can be changed and keys can be added
 147 and deleted.
 148
 149 =cut
 150
 151 sub lock_hash (\%) {
 152     my($hash) = shift;
 153
 154     lock_keys(%$hash);
 155
 156     foreach my $key (keys %$hash) {
 157         lock_value(%$hash, $key);
 158     }
 159
 160     return 1;
 161 }
 162
 163 sub unlock_hash (\%) {
 164     my($hash) = shift;
 165
 166     foreach my $key (keys %$hash) {
 167         unlock_value(%$hash, $key);
 168     }
 169
 170     unlock_keys(%$hash);
 171
 172     return 1;
 173 }
 174
 175
 176 =back
 177
 178 =head1 AUTHOR
 179
 180 Michael G Schwern <schwern@pobox.com> on top of code by Nick
 181 Ing-Simmons and Jeffrey Friedl.
 182
 183 =head1 SEE ALSO
 184
 185 L<Scalar::Util>, L<List::Util>, L<Hash::Util>
 186
 187 =cut
 188
 189 1;