Commit | Line | Data |
49293501 |
1 | package Hash::Util; |
2 | |
3 | require 5.007003; |
4 | use strict; |
49293501 |
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 |
9a7034eb |
10 | lock_hash unlock_hash hash_seed |
49293501 |
11 | ); |
2af1ab88 |
12 | our $VERSION = 0.05; |
49293501 |
13 | |
49293501 |
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 |
c910b28a |
22 | lock_hash unlock_hash |
9a7034eb |
23 | hash_seed); |
49293501 |
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 | |
9a7034eb |
36 | my $hashes_are_randomised = hash_seed() != 0; |
c910b28a |
37 | |
49293501 |
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 |
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 |
641c4430 |
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 | |
0082b4c8 |
71 | unlock_keys(%hash); |
7767c512 |
72 | |
49293501 |
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 |
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 |
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 |
101 | } |
102 | |
95d43b76 |
103 | return; |
49293501 |
104 | } |
105 | |
106 | sub unlock_keys (\%) { |
107 | my($hash) = shift; |
108 | |
29569577 |
109 | Internals::SvREADONLY %$hash, 0; |
95d43b76 |
110 | return; |
49293501 |
111 | } |
112 | |
113 | =item lock_value |
114 | |
115 | =item unlock_value |
116 | |
0082b4c8 |
117 | lock_value (%hash, $key); |
118 | unlock_value(%hash, $key); |
49293501 |
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 |
130 | unless Internals::SvREADONLY %$hash; |
131 | Internals::SvREADONLY $hash->{$key}, 1; |
49293501 |
132 | } |
133 | |
134 | sub unlock_value (\%$) { |
135 | my($hash, $key) = @_; |
29569577 |
136 | Internals::SvREADONLY $hash->{$key}, 0; |
49293501 |
137 | } |
138 | |
139 | |
140 | =item B<lock_hash> |
141 | |
142 | =item B<unlock_hash> |
143 | |
144 | lock_hash(%hash); |
49293501 |
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 |
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 |
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 | |
9a7034eb |
182 | =item B<hash_seed> |
c910b28a |
183 | |
9a7034eb |
184 | my $hash_seed = hash_seed(); |
c910b28a |
185 | |
9a7034eb |
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. |
c910b28a |
189 | |
26a2d347 |
190 | B<Note that the hash seed is sensitive information>: by knowing it one |
191 | can craft a denial-of-service attack against Perl code, even remotely, |
192 | see L<perlsec/"Algorithmic Complexity Attacks"> for more information. |
193 | B<Do not disclose the hash seed> to people who don't need to know it. |
194 | See also L<perlrun/PERL_HASH_SEED_DEBUG>. |
195 | |
c910b28a |
196 | =cut |
197 | |
9a7034eb |
198 | sub hash_seed () { |
008fb0c0 |
199 | Internals::rehash_seed(); |
c910b28a |
200 | } |
201 | |
49293501 |
202 | =back |
203 | |
13cd9115 |
204 | =head1 CAVEATS |
205 | |
206 | Note that the trapping of the restricted operations is not atomic: |
207 | for example |
208 | |
209 | eval { %hash = (illegal_key => 1) } |
210 | |
211 | leaves the C<%hash> empty rather than with its original contents. |
212 | |
49293501 |
213 | =head1 AUTHOR |
214 | |
215 | Michael G Schwern <schwern@pobox.com> on top of code by Nick |
216 | Ing-Simmons and Jeffrey Friedl. |
217 | |
218 | =head1 SEE ALSO |
219 | |
c910b28a |
220 | L<Scalar::Util>, L<List::Util>, L<Hash::Util>, |
221 | and L<perlsec/"Algorithmic Complexity Attacks">. |
49293501 |
222 | |
223 | =cut |
224 | |
225 | 1; |