This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
f6fed97ab481868000451deebbcbe6dd1cad574a
[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
15 =head1 NAME
16
17 Hash::Util - A selection of general-utility hash subroutines
18
19 =head1 SYNOPSIS
20
21   use Hash::Util qw(lock_keys   unlock_keys 
22                     lock_value  unlock_value
23                     lock_hash   unlock_hash
24                    );
25
26   %hash = (foo => 42, bar => 23);
27   lock_keys(%hash);
28   lock_keys(%hash, @keyset);
29   unlock_keys(%hash);
30
31   lock_value  (%hash, 'foo');
32   unlock_value(%hash, 'foo');
33
34   lock_hash  (%hash);
35   unlock_hash(%hash);
36
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   unlock_keys(%hash;)
64
65 Restricts the given %hash's set of keys to @keys.  If @keys is not
66 given it restricts it to its current keyset.  No more keys can be
67 added.  delete() and exists() will still work, but it does not effect
68 the set of allowed keys.
69
70 Removes the restriction on the %hash's keyset.
71
72 =cut
73
74 sub lock_keys (\%;@) {
75     my($hash, @keys) = @_;
76
77     if( @keys ) {
78         my %keys = map { ($_ => 1) } @keys;
79         my %original_keys = map { ($_ => 1) } keys %$hash;
80         foreach my $k (keys %original_keys) {
81             die sprintf "Hash has key '$k' which is not in the new key ".
82                         "set at %s line %d\n", (caller)[1,2]
83               unless $keys{$k};
84         }
85     
86         foreach my $k (@keys) {
87             $hash->{$k} = undef unless exists $hash->{$k};
88         }
89         Internals::SvREADONLY %$hash, 1;
90
91         foreach my $k (@keys) {
92             delete $hash->{$k} unless $original_keys{$k};
93         }
94     }
95     else {
96         Internals::SvREADONLY %$hash, 1;
97     }
98
99     return undef;
100 }
101
102 sub unlock_keys (\%) {
103     my($hash) = shift;
104
105     Internals::SvREADONLY %$hash, 0;
106     return undef;
107 }
108
109 =item lock_value
110
111 =item unlock_value
112
113   lock_key  (%hash, $key);
114   unlock_key(%hash, $key);
115
116 Locks and unlocks an individual key of a hash.  The value of a locked
117 key cannot be changed.
118
119 %hash must have already been locked for this to have useful effect.
120
121 =cut
122
123 sub lock_value (\%$) {
124     my($hash, $key) = @_;
125     carp "Cannot usefully lock values in an unlocked hash" 
126       unless Internals::SvREADONLY %$hash;
127     Internals::SvREADONLY $hash->{$key}, 1;
128 }
129
130 sub unlock_value (\%$) {
131     my($hash, $key) = @_;
132     Internals::SvREADONLY $hash->{$key}, 0;
133 }
134
135
136 =item B<lock_hash>
137
138 =item B<unlock_hash>
139
140     lock_hash(%hash);
141     unlock_hash(%hash);
142
143 lock_hash() locks an entire hash, making all keys and values readonly.
144 No value can be changed, no keys can be added or deleted.
145
146 unlock_hash() does the opposite.  All keys and values are made
147 read/write.  All values can be changed and keys can be added and
148 deleted.
149
150 =cut
151
152 sub lock_hash (\%) {
153     my($hash) = shift;
154
155     lock_keys(%$hash);
156
157     foreach my $key (keys %$hash) {
158         lock_value(%$hash, $key);
159     }
160
161     return 1;
162 }
163
164 sub unlock_hash (\%) {
165     my($hash) = shift;
166
167     foreach my $key (keys %$hash) {
168         unlock_value(%$hash, $key);
169     }
170
171     unlock_keys(%$hash);
172
173     return 1;
174 }
175
176
177 =back
178
179 =head1 AUTHOR
180
181 Michael G Schwern <schwern@pobox.com> on top of code by Nick
182 Ing-Simmons and Jeffrey Friedl.
183
184 =head1 SEE ALSO
185
186 L<Scalar::Util>, L<List::Util>, L<Hash::Util>
187
188 =cut
189
190 1;