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