Commit | Line | Data |
---|---|---|
49293501 MS |
1 | package Hash::Util; |
2 | ||
3 | require 5.007003; | |
4 | use strict; | |
49293501 MS |
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 | ||
49293501 MS |
14 | =head1 NAME |
15 | ||
16 | Hash::Util - A selection of general-utility hash subroutines | |
17 | ||
18 | =head1 SYNOPSIS | |
19 | ||
0082b4c8 | 20 | use Hash::Util qw(lock_keys unlock_keys |
49293501 | 21 | lock_value unlock_value |
7767c512 | 22 | lock_hash unlock_hash); |
49293501 MS |
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 | ||
49293501 MS |
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 | ||
49293501 MS |
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 | |
641c4430 A |
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. | |
49293501 | 67 | |
0082b4c8 | 68 | unlock_keys(%hash); |
7767c512 | 69 | |
49293501 MS |
70 | Removes the restriction on the %hash's keyset. |
71 | ||
72 | =cut | |
73 | ||
74 | sub lock_keys (\%;@) { | |
75 | my($hash, @keys) = @_; | |
76 | ||
dfd4ef2f | 77 | Internals::hv_clear_placeholders %$hash; |
49293501 MS |
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 | } | |
29569577 | 90 | Internals::SvREADONLY %$hash, 1; |
49293501 MS |
91 | |
92 | foreach my $k (@keys) { | |
93 | delete $hash->{$k} unless $original_keys{$k}; | |
94 | } | |
95 | } | |
96 | else { | |
29569577 | 97 | Internals::SvREADONLY %$hash, 1; |
49293501 MS |
98 | } |
99 | ||
95d43b76 | 100 | return; |
49293501 MS |
101 | } |
102 | ||
103 | sub unlock_keys (\%) { | |
104 | my($hash) = shift; | |
105 | ||
29569577 | 106 | Internals::SvREADONLY %$hash, 0; |
95d43b76 | 107 | return; |
49293501 MS |
108 | } |
109 | ||
110 | =item lock_value | |
111 | ||
112 | =item unlock_value | |
113 | ||
0082b4c8 SR |
114 | lock_value (%hash, $key); |
115 | unlock_value(%hash, $key); | |
49293501 MS |
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" | |
29569577 JH |
127 | unless Internals::SvREADONLY %$hash; |
128 | Internals::SvREADONLY $hash->{$key}, 1; | |
49293501 MS |
129 | } |
130 | ||
131 | sub unlock_value (\%$) { | |
132 | my($hash, $key) = @_; | |
29569577 | 133 | Internals::SvREADONLY $hash->{$key}, 0; |
49293501 MS |
134 | } |
135 | ||
136 | ||
137 | =item B<lock_hash> | |
138 | ||
139 | =item B<unlock_hash> | |
140 | ||
141 | lock_hash(%hash); | |
49293501 MS |
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 | ||
7767c512 JH |
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. | |
49293501 MS |
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 | ||
13cd9115 JH |
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 | ||
49293501 MS |
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; |