This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tiny pod tweaks.
[perl5.git] / lib / Hash / Util.pm
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
11                     );
12 our $VERSION    = 0.04;
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
24   %hash = (foo => 42, bar => 23);
25   lock_keys(%hash);
26   lock_keys(%hash, @keyset);
27   unlock_keys(%hash);
28
29   lock_value  (%hash, 'foo');
30   unlock_value(%hash, 'foo');
31
32   lock_hash  (%hash);
33   unlock_hash(%hash);
34
35 =head1 DESCRIPTION
36
37 C<Hash::Util> contains special functions for manipulating hashes that
38 don't really warrant a keyword.
39
40 By default C<Hash::Util> does not export anything.
41
42 =head2 Restricted hashes
43
44 5.8.0 introduces the ability to restrict a hash to a certain set of
45 keys.  No keys outside of this set can be added.  It also introduces
46 the ability to lock an individual key so it cannot be deleted and the
47 value cannot be changed.
48
49 This is intended to largely replace the deprecated pseudo-hashes.
50
51 =over 4
52
53 =item lock_keys
54
55 =item unlock_keys
56
57   lock_keys(%hash);
58   lock_keys(%hash, @keys);
59
60 Restricts the given %hash's set of keys to @keys.  If @keys is not
61 given it restricts it to its current keyset.  No more keys can be
62 added.  delete() and exists() will still work, but it does not effect
63 the set of allowed keys.
64
65   unlock_keys(%hash;)
66
67 Removes the restriction on the %hash's keyset.
68
69 =cut
70
71 sub lock_keys (\%;@) {
72     my($hash, @keys) = @_;
73
74     if( @keys ) {
75         my %keys = map { ($_ => 1) } @keys;
76         my %original_keys = map { ($_ => 1) } keys %$hash;
77         foreach my $k (keys %original_keys) {
78             die sprintf "Hash has key '$k' which is not in the new key ".
79                         "set at %s line %d\n", (caller)[1,2]
80               unless $keys{$k};
81         }
82     
83         foreach my $k (@keys) {
84             $hash->{$k} = undef unless exists $hash->{$k};
85         }
86         Internals::SvREADONLY %$hash, 1;
87
88         foreach my $k (@keys) {
89             delete $hash->{$k} unless $original_keys{$k};
90         }
91     }
92     else {
93         Internals::SvREADONLY %$hash, 1;
94     }
95
96     return undef;
97 }
98
99 sub unlock_keys (\%) {
100     my($hash) = shift;
101
102     Internals::SvREADONLY %$hash, 0;
103     return undef;
104 }
105
106 =item lock_value
107
108 =item unlock_value
109
110   lock_key  (%hash, $key);
111   unlock_key(%hash, $key);
112
113 Locks and unlocks an individual key of a hash.  The value of a locked
114 key cannot be changed.
115
116 %hash must have already been locked for this to have useful effect.
117
118 =cut
119
120 sub lock_value (\%$) {
121     my($hash, $key) = @_;
122     carp "Cannot usefully lock values in an unlocked hash" 
123       unless Internals::SvREADONLY %$hash;
124     Internals::SvREADONLY $hash->{$key}, 1;
125 }
126
127 sub unlock_value (\%$) {
128     my($hash, $key) = @_;
129     Internals::SvREADONLY $hash->{$key}, 0;
130 }
131
132
133 =item B<lock_hash>
134
135 =item B<unlock_hash>
136
137     lock_hash(%hash);
138
139 lock_hash() locks an entire hash, making all keys and values readonly.
140 No value can be changed, no keys can be added or deleted.
141
142     unlock_hash(%hash);
143
144 unlock_hash() does the opposite of lock_hash().  All keys and values
145 are made read/write.  All values can be changed and keys can be added
146 and deleted.
147
148 =cut
149
150 sub lock_hash (\%) {
151     my($hash) = shift;
152
153     lock_keys(%$hash);
154
155     foreach my $key (keys %$hash) {
156         lock_value(%$hash, $key);
157     }
158
159     return 1;
160 }
161
162 sub unlock_hash (\%) {
163     my($hash) = shift;
164
165     foreach my $key (keys %$hash) {
166         unlock_value(%$hash, $key);
167     }
168
169     unlock_keys(%$hash);
170
171     return 1;
172 }
173
174
175 =back
176
177 =head1 AUTHOR
178
179 Michael G Schwern <schwern@pobox.com> on top of code by Nick
180 Ing-Simmons and Jeffrey Friedl.
181
182 =head1 SEE ALSO
183
184 L<Scalar::Util>, L<List::Util>, L<Hash::Util>
185
186 =cut
187
188 1;