Commit | Line | Data |
---|---|---|
86530b38 AT |
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 | Internals::hv_clear_placeholders %$hash; | |
75 | if( @keys ) { | |
76 | my %keys = map { ($_ => 1) } @keys; | |
77 | my %original_keys = map { ($_ => 1) } keys %$hash; | |
78 | foreach my $k (keys %original_keys) { | |
79 | die sprintf "Hash has key '$k' which is not in the new key ". | |
80 | "set at %s line %d\n", (caller)[1,2] | |
81 | unless $keys{$k}; | |
82 | } | |
83 | ||
84 | foreach my $k (@keys) { | |
85 | $hash->{$k} = undef unless exists $hash->{$k}; | |
86 | } | |
87 | Internals::SvREADONLY %$hash, 1; | |
88 | ||
89 | foreach my $k (@keys) { | |
90 | delete $hash->{$k} unless $original_keys{$k}; | |
91 | } | |
92 | } | |
93 | else { | |
94 | Internals::SvREADONLY %$hash, 1; | |
95 | } | |
96 | ||
97 | return; | |
98 | } | |
99 | ||
100 | sub unlock_keys (\%) { | |
101 | my($hash) = shift; | |
102 | ||
103 | Internals::SvREADONLY %$hash, 0; | |
104 | return; | |
105 | } | |
106 | ||
107 | =item lock_value | |
108 | ||
109 | =item unlock_value | |
110 | ||
111 | lock_key (%hash, $key); | |
112 | unlock_key(%hash, $key); | |
113 | ||
114 | Locks and unlocks an individual key of a hash. The value of a locked | |
115 | key cannot be changed. | |
116 | ||
117 | %hash must have already been locked for this to have useful effect. | |
118 | ||
119 | =cut | |
120 | ||
121 | sub lock_value (\%$) { | |
122 | my($hash, $key) = @_; | |
123 | carp "Cannot usefully lock values in an unlocked hash" | |
124 | unless Internals::SvREADONLY %$hash; | |
125 | Internals::SvREADONLY $hash->{$key}, 1; | |
126 | } | |
127 | ||
128 | sub unlock_value (\%$) { | |
129 | my($hash, $key) = @_; | |
130 | Internals::SvREADONLY $hash->{$key}, 0; | |
131 | } | |
132 | ||
133 | ||
134 | =item B<lock_hash> | |
135 | ||
136 | =item B<unlock_hash> | |
137 | ||
138 | lock_hash(%hash); | |
139 | ||
140 | lock_hash() locks an entire hash, making all keys and values readonly. | |
141 | No value can be changed, no keys can be added or deleted. | |
142 | ||
143 | unlock_hash(%hash); | |
144 | ||
145 | unlock_hash() does the opposite of lock_hash(). All keys and values | |
146 | are made read/write. All values can be changed and keys can be added | |
147 | and deleted. | |
148 | ||
149 | =cut | |
150 | ||
151 | sub lock_hash (\%) { | |
152 | my($hash) = shift; | |
153 | ||
154 | lock_keys(%$hash); | |
155 | ||
156 | foreach my $key (keys %$hash) { | |
157 | lock_value(%$hash, $key); | |
158 | } | |
159 | ||
160 | return 1; | |
161 | } | |
162 | ||
163 | sub unlock_hash (\%) { | |
164 | my($hash) = shift; | |
165 | ||
166 | foreach my $key (keys %$hash) { | |
167 | unlock_value(%$hash, $key); | |
168 | } | |
169 | ||
170 | unlock_keys(%$hash); | |
171 | ||
172 | return 1; | |
173 | } | |
174 | ||
175 | ||
176 | =back | |
177 | ||
178 | =head1 AUTHOR | |
179 | ||
180 | Michael G Schwern <schwern@pobox.com> on top of code by Nick | |
181 | Ing-Simmons and Jeffrey Friedl. | |
182 | ||
183 | =head1 SEE ALSO | |
184 | ||
185 | L<Scalar::Util>, L<List::Util>, L<Hash::Util> | |
186 | ||
187 | =cut | |
188 | ||
189 | 1; |