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
CommitLineData
49293501
MS
1package Hash::Util;
2
3require 5.007003;
4use strict;
49293501
MS
5use Carp;
6
7require Exporter;
8our @ISA = qw(Exporter);
9our @EXPORT_OK = qw(lock_keys unlock_keys lock_value unlock_value
10 lock_hash unlock_hash
11 );
12our $VERSION = 0.04;
13
49293501
MS
14=head1 NAME
15
16Hash::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
7767c512 22 lock_hash unlock_hash);
49293501
MS
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
49293501
MS
35=head1 DESCRIPTION
36
37C<Hash::Util> contains special functions for manipulating hashes that
38don't really warrant a keyword.
39
40By default C<Hash::Util> does not export anything.
41
42=head2 Restricted hashes
43
445.8.0 introduces the ability to restrict a hash to a certain set of
45keys. No keys outside of this set can be added. It also introduces
46the ability to lock an individual key so it cannot be deleted and the
47value cannot be changed.
48
49This 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
49293501
MS
60Restricts the given %hash's set of keys to @keys. If @keys is not
61given it restricts it to its current keyset. No more keys can be
62added. delete() and exists() will still work, but it does not effect
63the set of allowed keys.
64
7767c512
JH
65 unlock_keys(%hash;)
66
49293501
MS
67Removes the restriction on the %hash's keyset.
68
69=cut
70
71sub 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 }
29569577 86 Internals::SvREADONLY %$hash, 1;
49293501
MS
87
88 foreach my $k (@keys) {
89 delete $hash->{$k} unless $original_keys{$k};
90 }
91 }
92 else {
29569577 93 Internals::SvREADONLY %$hash, 1;
49293501
MS
94 }
95
96 return undef;
97}
98
99sub unlock_keys (\%) {
100 my($hash) = shift;
101
29569577 102 Internals::SvREADONLY %$hash, 0;
49293501
MS
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
113Locks and unlocks an individual key of a hash. The value of a locked
114key cannot be changed.
115
116%hash must have already been locked for this to have useful effect.
117
118=cut
119
120sub lock_value (\%$) {
121 my($hash, $key) = @_;
122 carp "Cannot usefully lock values in an unlocked hash"
29569577
JH
123 unless Internals::SvREADONLY %$hash;
124 Internals::SvREADONLY $hash->{$key}, 1;
49293501
MS
125}
126
127sub unlock_value (\%$) {
128 my($hash, $key) = @_;
29569577 129 Internals::SvREADONLY $hash->{$key}, 0;
49293501
MS
130}
131
132
133=item B<lock_hash>
134
135=item B<unlock_hash>
136
137 lock_hash(%hash);
49293501
MS
138
139lock_hash() locks an entire hash, making all keys and values readonly.
140No value can be changed, no keys can be added or deleted.
141
7767c512
JH
142 unlock_hash(%hash);
143
144unlock_hash() does the opposite of lock_hash(). All keys and values
145are made read/write. All values can be changed and keys can be added
146and deleted.
49293501
MS
147
148=cut
149
150sub 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
162sub 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
179Michael G Schwern <schwern@pobox.com> on top of code by Nick
180Ing-Simmons and Jeffrey Friedl.
181
182=head1 SEE ALSO
183
184L<Scalar::Util>, L<List::Util>, L<Hash::Util>
185
186=cut
187
1881;