Commit | Line | Data |
49293501 |
1 | package Hash::Util; |
2 | |
3 | require 5.007003; |
4 | use strict; |
49293501 |
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 | |
49293501 |
14 | =head1 NAME |
15 | |
16 | Hash::Util - A selection of general-utility hash subroutines |
17 | |
18 | =head1 SYNOPSIS |
19 | |
0082b4c8 |
20 | use Hash::Util qw(lock_keys unlock_keys |
49293501 |
21 | lock_value unlock_value |
7767c512 |
22 | lock_hash unlock_hash); |
49293501 |
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 |
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 | |
49293501 |
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 |
a94e8023 |
63 | the set of allowed keys. B<Note>: the current implementation does not |
64 | allow you to bless() the resulting hash, so if you want to use |
65 | lock_keys() for an object, you need to bless it prior to locking it. |
49293501 |
66 | |
0082b4c8 |
67 | unlock_keys(%hash); |
7767c512 |
68 | |
49293501 |
69 | Removes the restriction on the %hash's keyset. |
70 | |
71 | =cut |
72 | |
73 | sub lock_keys (\%;@) { |
74 | my($hash, @keys) = @_; |
75 | |
dfd4ef2f |
76 | Internals::hv_clear_placeholders %$hash; |
49293501 |
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 | } |
29569577 |
89 | Internals::SvREADONLY %$hash, 1; |
49293501 |
90 | |
91 | foreach my $k (@keys) { |
92 | delete $hash->{$k} unless $original_keys{$k}; |
93 | } |
94 | } |
95 | else { |
29569577 |
96 | Internals::SvREADONLY %$hash, 1; |
49293501 |
97 | } |
98 | |
95d43b76 |
99 | return; |
49293501 |
100 | } |
101 | |
102 | sub unlock_keys (\%) { |
103 | my($hash) = shift; |
104 | |
29569577 |
105 | Internals::SvREADONLY %$hash, 0; |
95d43b76 |
106 | return; |
49293501 |
107 | } |
108 | |
109 | =item lock_value |
110 | |
111 | =item unlock_value |
112 | |
0082b4c8 |
113 | lock_value (%hash, $key); |
114 | unlock_value(%hash, $key); |
49293501 |
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" |
29569577 |
126 | unless Internals::SvREADONLY %$hash; |
127 | Internals::SvREADONLY $hash->{$key}, 1; |
49293501 |
128 | } |
129 | |
130 | sub unlock_value (\%$) { |
131 | my($hash, $key) = @_; |
29569577 |
132 | Internals::SvREADONLY $hash->{$key}, 0; |
49293501 |
133 | } |
134 | |
135 | |
136 | =item B<lock_hash> |
137 | |
138 | =item B<unlock_hash> |
139 | |
140 | lock_hash(%hash); |
49293501 |
141 | |
142 | lock_hash() locks an entire hash, making all keys and values readonly. |
143 | No value can be changed, no keys can be added or deleted. |
144 | |
7767c512 |
145 | unlock_hash(%hash); |
146 | |
147 | unlock_hash() does the opposite of lock_hash(). All keys and values |
148 | are made read/write. All values can be changed and keys can be added |
149 | and deleted. |
49293501 |
150 | |
151 | =cut |
152 | |
153 | sub lock_hash (\%) { |
154 | my($hash) = shift; |
155 | |
156 | lock_keys(%$hash); |
157 | |
158 | foreach my $key (keys %$hash) { |
159 | lock_value(%$hash, $key); |
160 | } |
161 | |
162 | return 1; |
163 | } |
164 | |
165 | sub unlock_hash (\%) { |
166 | my($hash) = shift; |
167 | |
168 | foreach my $key (keys %$hash) { |
169 | unlock_value(%$hash, $key); |
170 | } |
171 | |
172 | unlock_keys(%$hash); |
173 | |
174 | return 1; |
175 | } |
176 | |
177 | |
178 | =back |
179 | |
180 | =head1 AUTHOR |
181 | |
182 | Michael G Schwern <schwern@pobox.com> on top of code by Nick |
183 | Ing-Simmons and Jeffrey Friedl. |
184 | |
185 | =head1 SEE ALSO |
186 | |
187 | L<Scalar::Util>, L<List::Util>, L<Hash::Util> |
188 | |
189 | =cut |
190 | |
191 | 1; |