This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
658fd86bce5e49f3641fe85594d89fae4fafcc8a
[perl5.git] / 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;