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