Commit | Line | Data |
---|---|---|
920dae64 AT |
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 hash_seed | |
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 | hash_seed); | |
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 | ||
36 | my $hashes_are_randomised = hash_seed() != 0; | |
37 | ||
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 | ||
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 | |
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. | |
70 | ||
71 | unlock_keys(%hash); | |
72 | ||
73 | Removes the restriction on the %hash's keyset. | |
74 | ||
75 | =cut | |
76 | ||
77 | sub lock_keys (\%;@) { | |
78 | my($hash, @keys) = @_; | |
79 | ||
80 | Internals::hv_clear_placeholders %$hash; | |
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 | } | |
93 | Internals::SvREADONLY %$hash, 1; | |
94 | ||
95 | foreach my $k (@keys) { | |
96 | delete $hash->{$k} unless $original_keys{$k}; | |
97 | } | |
98 | } | |
99 | else { | |
100 | Internals::SvREADONLY %$hash, 1; | |
101 | } | |
102 | ||
103 | return; | |
104 | } | |
105 | ||
106 | sub unlock_keys (\%) { | |
107 | my($hash) = shift; | |
108 | ||
109 | Internals::SvREADONLY %$hash, 0; | |
110 | return; | |
111 | } | |
112 | ||
113 | =item lock_value | |
114 | ||
115 | =item unlock_value | |
116 | ||
117 | lock_value (%hash, $key); | |
118 | unlock_value(%hash, $key); | |
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" | |
130 | unless Internals::SvREADONLY %$hash; | |
131 | Internals::SvREADONLY $hash->{$key}, 1; | |
132 | } | |
133 | ||
134 | sub unlock_value (\%$) { | |
135 | my($hash, $key) = @_; | |
136 | Internals::SvREADONLY $hash->{$key}, 0; | |
137 | } | |
138 | ||
139 | ||
140 | =item B<lock_hash> | |
141 | ||
142 | =item B<unlock_hash> | |
143 | ||
144 | lock_hash(%hash); | |
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 | ||
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. | |
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 | ||
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 | 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 | ||
196 | =cut | |
197 | ||
198 | sub hash_seed () { | |
199 | Internals::rehash_seed(); | |
200 | } | |
201 | ||
202 | =back | |
203 | ||
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 | ||
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 | ||
220 | L<Scalar::Util>, L<List::Util>, L<Hash::Util>, | |
221 | and L<perlsec/"Algorithmic Complexity Attacks">. | |
222 | ||
223 | =cut | |
224 | ||
225 | 1; |