This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POD nit found by Slaven Rezic.
[perl5.git] / ext / Hash / Util / lib / Hash / Util.pm
CommitLineData
96c33d98
YO
1package Hash::Util;
2
3require 5.007003;
4use strict;
5use Carp;
6use warnings;
7use warnings::register;
8use Scalar::Util qw(reftype);
9
10require Exporter;
11our @ISA = qw(Exporter);
12our @EXPORT_OK = qw(
1e73acc8
AS
13 fieldhash fieldhashes
14
96c33d98
YO
15 all_keys
16 lock_keys unlock_keys
17 lock_value unlock_value
18 lock_hash unlock_hash
19 lock_keys_plus hash_locked
20 hidden_keys legal_keys
21
22 lock_ref_keys unlock_ref_keys
23 lock_ref_value unlock_ref_value
24 lock_hashref unlock_hashref
25 lock_ref_keys_plus hashref_locked
26 hidden_ref_keys legal_ref_keys
27
28 hash_seed hv_store
29
30 );
1e73acc8 31our $VERSION = 0.07;
96c33d98
YO
32require DynaLoader;
33local @ISA = qw(DynaLoader);
34bootstrap Hash::Util $VERSION;
35
1e73acc8
AS
36sub import {
37 my $class = shift;
38 if ( grep /fieldhash/, @_ ) {
39 require Hash::Util::FieldHash;
40 Hash::Util::FieldHash->import(':all'); # for re-export
41 }
42 unshift @_, $class;
43 goto &Exporter::import;
44}
45
96c33d98
YO
46
47=head1 NAME
48
49Hash::Util - A selection of general-utility hash subroutines
50
51=head1 SYNOPSIS
52
1e73acc8
AS
53 # Restricted hashes
54
96c33d98
YO
55 use Hash::Util qw(
56 hash_seed all_keys
57 lock_keys unlock_keys
58 lock_value unlock_value
59 lock_hash unlock_hash
60 lock_keys_plus hash_locked
61 hidden_keys legal_keys
62 );
63
64 %hash = (foo => 42, bar => 23);
65 # Ways to restrict a hash
66 lock_keys(%hash);
67 lock_keys(%hash, @keyset);
68 lock_keys_plus(%hash, @additional_keys);
69
72712bfd
RGS
70 # Ways to inspect the properties of a restricted hash
71 my @legal = legal_keys(%hash);
72 my @hidden = hidden_keys(%hash);
73 my $ref = all_keys(%hash,@keys,@hidden);
74 my $is_locked = hash_locked(%hash);
96c33d98 75
72712bfd 76 # Remove restrictions on the hash
96c33d98
YO
77 unlock_keys(%hash);
78
72712bfd 79 # Lock individual values in a hash
96c33d98
YO
80 lock_value (%hash, 'foo');
81 unlock_value(%hash, 'foo');
82
72712bfd 83 # Ways to change the restrictions on both keys and values
96c33d98
YO
84 lock_hash (%hash);
85 unlock_hash(%hash);
86
87 my $hashes_are_randomised = hash_seed() != 0;
88
89=head1 DESCRIPTION
90
d74d639b
AS
91C<Hash::Util> and C<Hash::Util::FieldHash> contain special functions
92for manipulating hashes that don't really warrant a keyword.
1e73acc8 93
b299c47c
RGS
94C<Hash::Util> contains a set of functions that support
95L<restricted hashes|/"Restricted hashes">. These are described in
d74d639b
AS
96this document. C<Hash::Util::FieldHash> contains an (unrelated)
97set of functions that support the use of hashes in
98I<inside-out classes>, described in L<Hash::Util::FieldHash>.
1e73acc8 99
d74d639b 100By default C<Hash::Util> does not export anything.
1e73acc8 101
96c33d98
YO
102=head2 Restricted hashes
103
1045.8.0 introduces the ability to restrict a hash to a certain set of
105keys. No keys outside of this set can be added. It also introduces
106the ability to lock an individual key so it cannot be deleted and the
107ability to ensure that an individual value cannot be changed.
108
109This is intended to largely replace the deprecated pseudo-hashes.
110
111=over 4
112
113=item B<lock_keys>
114
115=item B<unlock_keys>
116
117 lock_keys(%hash);
118 lock_keys(%hash, @keys);
119
120Restricts the given %hash's set of keys to @keys. If @keys is not
121given it restricts it to its current keyset. No more keys can be
122added. delete() and exists() will still work, but will not alter
123the set of allowed keys. B<Note>: the current implementation prevents
124the hash from being bless()ed while it is in a locked state. Any attempt
125to do so will raise an exception. Of course you can still bless()
126the hash before you call lock_keys() so this shouldn't be a problem.
127
128 unlock_keys(%hash);
129
130Removes the restriction on the %hash's keyset.
131
132B<Note> that if any of the values of the hash have been locked they will not be unlocked
133after this sub executes.
134
135Both routines return a reference to the hash operated on.
136
137=cut
138
139sub lock_ref_keys {
140 my($hash, @keys) = @_;
141
142 Internals::hv_clear_placeholders %$hash;
143 if( @keys ) {
144 my %keys = map { ($_ => 1) } @keys;
145 my %original_keys = map { ($_ => 1) } keys %$hash;
146 foreach my $k (keys %original_keys) {
147 croak "Hash has key '$k' which is not in the new key set"
148 unless $keys{$k};
149 }
150
151 foreach my $k (@keys) {
152 $hash->{$k} = undef unless exists $hash->{$k};
153 }
154 Internals::SvREADONLY %$hash, 1;
155
156 foreach my $k (@keys) {
157 delete $hash->{$k} unless $original_keys{$k};
158 }
159 }
160 else {
161 Internals::SvREADONLY %$hash, 1;
162 }
163
164 return $hash;
165}
166
167sub unlock_ref_keys {
168 my $hash = shift;
169
170 Internals::SvREADONLY %$hash, 0;
171 return $hash;
172}
173
174sub lock_keys (\%;@) { lock_ref_keys(@_) }
175sub unlock_keys (\%) { unlock_ref_keys(@_) }
176
177=item B<lock_keys_plus>
178
179 lock_keys_plus(%hash,@additional_keys)
180
181Similar to C<lock_keys()>, with the difference being that the optional key list
182specifies keys that may or may not be already in the hash. Essentially this is
183an easier way to say
184
185 lock_keys(%hash,@additional_keys,keys %hash);
186
187Returns a reference to %hash
188
189=cut
190
191
192sub lock_ref_keys_plus {
193 my ($hash,@keys)=@_;
194 my @delete;
195 Internals::hv_clear_placeholders(%$hash);
196 foreach my $key (@keys) {
197 unless (exists($hash->{$key})) {
198 $hash->{$key}=undef;
199 push @delete,$key;
200 }
201 }
202 Internals::SvREADONLY(%$hash,1);
203 delete @{$hash}{@delete};
204 return $hash
205}
206
207sub lock_keys_plus(\%;@) { lock_ref_keys_plus(@_) }
208
209
210=item B<lock_value>
211
212=item B<unlock_value>
213
214 lock_value (%hash, $key);
215 unlock_value(%hash, $key);
216
217Locks and unlocks the value for an individual key of a hash. The value of a
218locked key cannot be changed.
219
220Unless %hash has already been locked the key/value could be deleted
221regardless of this setting.
222
223Returns a reference to the %hash.
224
225=cut
226
227sub lock_ref_value {
228 my($hash, $key) = @_;
229 # I'm doubtful about this warning, as it seems not to be true.
230 # Marking a value in the hash as RO is useful, regardless
231 # of the status of the hash itself.
232 carp "Cannot usefully lock values in an unlocked hash"
233 if !Internals::SvREADONLY(%$hash) && warnings::enabled;
234 Internals::SvREADONLY $hash->{$key}, 1;
235 return $hash
236}
237
238sub unlock_ref_value {
239 my($hash, $key) = @_;
240 Internals::SvREADONLY $hash->{$key}, 0;
241 return $hash
242}
243
244sub lock_value (\%$) { lock_ref_value(@_) }
245sub unlock_value (\%$) { unlock_ref_value(@_) }
246
247
248=item B<lock_hash>
249
250=item B<unlock_hash>
251
252 lock_hash(%hash);
253
72712bfd 254lock_hash() locks an entire hash, making all keys and values read-only.
96c33d98
YO
255No value can be changed, no keys can be added or deleted.
256
257 unlock_hash(%hash);
258
259unlock_hash() does the opposite of lock_hash(). All keys and values
260are made writable. All values can be changed and keys can be added
261and deleted.
262
263Returns a reference to the %hash.
264
265=cut
266
267sub lock_hashref {
268 my $hash = shift;
269
270 lock_ref_keys($hash);
271
272 foreach my $value (values %$hash) {
273 Internals::SvREADONLY($value,1);
274 }
275
276 return $hash;
277}
278
279sub unlock_hashref {
280 my $hash = shift;
281
282 foreach my $value (values %$hash) {
283 Internals::SvREADONLY($value, 0);
284 }
285
286 unlock_ref_keys($hash);
287
288 return $hash;
289}
290
291sub lock_hash (\%) { lock_hashref(@_) }
292sub unlock_hash (\%) { unlock_hashref(@_) }
293
294=item B<lock_hash_recurse>
295
296=item B<unlock_hash_recurse>
297
298 lock_hash_recurse(%hash);
299
300lock_hash() locks an entire hash and any hashes it references recursively,
72712bfd 301making all keys and values read-only. No value can be changed, no keys can
96c33d98
YO
302be added or deleted.
303
304B<Only> recurses into hashes that are referenced by another hash. Thus a
305Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of Hashes
306(HoAoH) will only have the top hash restricted.
307
308 unlock_hash_recurse(%hash);
309
310unlock_hash_recurse() does the opposite of lock_hash_recurse(). All keys and
311values are made writable. All values can be changed and keys can be added
312and deleted. Identical recursion restrictions apply as to lock_hash_recurse().
313
314Returns a reference to the %hash.
315
316=cut
317
318sub lock_hashref_recurse {
319 my $hash = shift;
320
321 lock_ref_keys($hash);
322 foreach my $value (values %$hash) {
323 if (reftype($value) eq 'HASH') {
324 lock_hashref_recurse($value);
325 }
326 Internals::SvREADONLY($value,1);
327 }
328 return $hash
329}
330
331sub unlock_hashref_recurse {
332 my $hash = shift;
333
334 foreach my $value (values %$hash) {
335 if (reftype($value) eq 'HASH') {
336 unlock_hashref_recurse($value);
337 }
338 Internals::SvREADONLY($value,1);
339 }
340 unlock_ref_keys($hash);
341 return $hash;
342}
343
344sub lock_hash_recurse (\%) { lock_hashref_recurse(@_) }
345sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
346
347
348=item B<hash_unlocked>
349
350 hash_unlocked(%hash) and print "Hash is unlocked!\n";
351
352Returns true if the hash and its keys are unlocked.
353
354=cut
355
356sub hashref_unlocked {
357 my $hash=shift;
358 return Internals::SvREADONLY($hash)
359}
360
361sub hash_unlocked(\%) { hashref_unlocked(@_) }
362
363=for demerphqs_editor
364sub legal_ref_keys{}
365sub hidden_ref_keys{}
366sub all_keys{}
367
368=cut
369
370sub legal_keys(\%) { legal_ref_keys(@_) }
371sub hidden_keys(\%){ hidden_ref_keys(@_) }
372
3a6a06e3 373=item B<legal_keys>
96c33d98 374
72712bfd 375 my @keys = legal_keys(%hash);
96c33d98 376
72712bfd 377Returns the list of the keys that are legal in a restricted hash.
96c33d98
YO
378In the case of an unrestricted hash this is identical to calling
379keys(%hash).
380
381=item B<hidden_keys>
382
72712bfd 383 my @keys = hidden_keys(%hash);
96c33d98 384
72712bfd 385Returns the list of the keys that are legal in a restricted hash but
96c33d98
YO
386do not have a value associated to them. Thus if 'foo' is a
387"hidden" key of the %hash it will return false for both C<defined>
388and C<exists> tests.
389
390In the case of an unrestricted hash this will return an empty list.
391
392B<NOTE> this is an experimental feature that is heavily dependent
393on the current implementation of restricted hashes. Should the
72712bfd 394implementation change, this routine may become meaningless, in which
96c33d98
YO
395case it will return an empty list.
396
397=item B<all_keys>
398
399 all_keys(%hash,@keys,@hidden);
400
401Populates the arrays @keys with the all the keys that would pass
402an C<exists> tests, and populates @hidden with the remaining legal
403keys that have not been utilized.
404
405Returns a reference to the hash.
406
72712bfd 407In the case of an unrestricted hash this will be equivalent to
96c33d98 408
72712bfd
RGS
409 $ref = do {
410 @keys = keys %hash;
411 @hidden = ();
412 \%hash
413 };
96c33d98
YO
414
415B<NOTE> this is an experimental feature that is heavily dependent
416on the current implementation of restricted hashes. Should the
417implementation change this routine may become meaningless in which
418case it will behave identically to how it would behave on an
72712bfd 419unrestricted hash.
96c33d98
YO
420
421=item B<hash_seed>
422
423 my $hash_seed = hash_seed();
424
425hash_seed() returns the seed number used to randomise hash ordering.
426Zero means the "traditional" random hash ordering, non-zero means the
427new even more random hash ordering introduced in Perl 5.8.1.
428
429B<Note that the hash seed is sensitive information>: by knowing it one
430can craft a denial-of-service attack against Perl code, even remotely,
431see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
432B<Do not disclose the hash seed> to people who don't need to know it.
433See also L<perlrun/PERL_HASH_SEED_DEBUG>.
434
435=cut
436
437sub hash_seed () {
438 Internals::rehash_seed();
439}
440
441=item B<hv_store>
442
72712bfd 443 my $sv = 0;
96c33d98 444 hv_store(%hash,$key,$sv) or die "Failed to alias!";
72712bfd 445 $hash{$key} = 1;
96c33d98
YO
446 print $sv; # prints 1
447
448Stores an alias to a variable in a hash instead of copying the value.
449
450=back
451
452=head2 Operating on references to hashes.
453
72712bfd 454Most subroutines documented in this module have equivalent versions
96c33d98
YO
455that operate on references to hashes instead of native hashes.
456The following is a list of these subs. They are identical except
457in name and in that instead of taking a %hash they take a $hashref,
458and additionally are not prototyped.
459
460=over 4
461
462=item lock_ref_keys
463
464=item unlock_ref_keys
465
466=item lock_ref_keys_plus
467
468=item lock_ref_value
469
470=item unlock_ref_value
471
472=item lock_hashref
473
474=item unlock_hashref
475
476=item lock_hashref_recurse
477
478=item unlock_hashref_recurse
479
480=item hash_ref_unlocked
481
482=item legal_ref_keys
483
484=item hidden_ref_keys
485
486=back
487
488=head1 CAVEATS
489
490Note that the trapping of the restricted operations is not atomic:
491for example
492
493 eval { %hash = (illegal_key => 1) }
494
495leaves the C<%hash> empty rather than with its original contents.
496
497=head1 BUGS
498
499The interface exposed by this module is very close to the current
72712bfd 500implementation of restricted hashes. Over time it is expected that
96c33d98
YO
501this behavior will be extended and the interface abstracted further.
502
503=head1 AUTHOR
504
505Michael G Schwern <schwern@pobox.com> on top of code by Nick
506Ing-Simmons and Jeffrey Friedl.
507
508hv_store() is from Array::RefElem, Copyright 2000 Gisle Aas.
509
510Additional code by Yves Orton.
511
512=head1 SEE ALSO
513
d74d639b
AS
514L<Scalar::Util>, L<List::Util> and L<perlsec/"Algorithmic Complexity Attacks">.
515
516L<Hash::Util::FieldHash>.
96c33d98
YO
517
518=cut
519
5201;