Commit | Line | Data |
7a4e305a |
1 | #--------------------------------------------------------------------- |
2 | package Tie::CPHash; |
3 | # |
4 | # Copyright 1997 Christopher J. Madsen |
5 | # |
6 | # Author: Christopher J. Madsen <cjm@pobox.com> |
7 | # Created: 08 Nov 1997 |
8 | # $Revision$ $Date$ |
9 | # |
10 | # This program is free software; you can redistribute it and/or modify |
11 | # it under the same terms as Perl itself. |
12 | # |
13 | # This program is distributed in the hope that it will be useful, |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the |
16 | # GNU General Public License or the Artistic License for more details. |
17 | # |
18 | # Case preserving but case insensitive hash |
19 | #--------------------------------------------------------------------- |
20 | |
21 | require 5.000; |
22 | use strict; |
eed8b6fa |
23 | use warnings; |
7a4e305a |
24 | use vars qw(@ISA $VERSION); |
25 | |
26 | @ISA = qw(); |
27 | |
28 | #===================================================================== |
29 | # Package Global Variables: |
30 | |
31 | $VERSION = '1.02'; |
32 | |
33 | #===================================================================== |
34 | # Tied Methods: |
35 | #--------------------------------------------------------------------- |
36 | # TIEHASH classname |
37 | # The method invoked by the command `tie %hash, classname'. |
38 | # Associates a new hash instance with the specified class. |
39 | |
40 | sub TIEHASH |
41 | { |
42 | bless {}, $_[0]; |
43 | } # end TIEHASH |
44 | |
45 | #--------------------------------------------------------------------- |
46 | # STORE this, key, value |
47 | # Store datum *value* into *key* for the tied hash *this*. |
48 | |
49 | sub STORE |
50 | { |
51 | $_[0]->{lc $_[1]} = [ $_[1], $_[2] ]; |
52 | } # end STORE |
53 | |
54 | #--------------------------------------------------------------------- |
55 | # FETCH this, key |
56 | # Retrieve the datum in *key* for the tied hash *this*. |
57 | |
58 | sub FETCH |
59 | { |
60 | my $v = $_[0]->{lc $_[1]}; |
61 | ($v ? $v->[1] : undef); |
62 | } # end FETCH |
63 | |
64 | #--------------------------------------------------------------------- |
65 | # FIRSTKEY this |
66 | # Return the (key, value) pair for the first key in the hash. |
67 | |
68 | sub FIRSTKEY |
69 | { |
70 | my $a = scalar keys %{$_[0]}; |
71 | &NEXTKEY; |
72 | } # end FIRSTKEY |
73 | |
74 | #--------------------------------------------------------------------- |
75 | # NEXTKEY this, lastkey |
76 | # Return the next (key, value) pair for the hash. |
77 | |
78 | sub NEXTKEY |
79 | { |
80 | my $v = (each %{$_[0]})[1]; |
81 | ($v ? $v->[0] : undef ); |
82 | } # end NEXTKEY |
83 | |
84 | #--------------------------------------------------------------------- |
85 | # SCALAR this |
86 | # Return bucket usage information for the hash (0 if empty). |
87 | |
88 | sub SCALAR |
89 | { |
90 | scalar %{$_[0]}; |
91 | } # end SCALAR |
92 | |
93 | #--------------------------------------------------------------------- |
94 | # EXISTS this, key |
95 | # Verify that *key* exists with the tied hash *this*. |
96 | |
97 | sub EXISTS |
98 | { |
99 | exists $_[0]->{lc $_[1]}; |
100 | } # end EXISTS |
101 | |
102 | #--------------------------------------------------------------------- |
103 | # DELETE this, key |
104 | # Delete the key *key* from the tied hash *this*. |
105 | # Returns the old value, or undef if it didn't exist. |
106 | |
107 | sub DELETE |
108 | { |
109 | my $v = delete $_[0]->{lc $_[1]}; |
110 | ($v ? $v->[1] : undef); |
111 | } # end DELETE |
112 | |
113 | #--------------------------------------------------------------------- |
114 | # CLEAR this |
115 | # Clear all values from the tied hash *this*. |
116 | |
117 | sub CLEAR |
118 | { |
119 | %{$_[0]} = (); |
120 | } # end CLEAR |
121 | |
122 | #===================================================================== |
123 | # Other Methods: |
124 | #--------------------------------------------------------------------- |
125 | # Return the case of KEY. |
126 | |
127 | sub key |
128 | { |
129 | my $v = $_[0]->{lc $_[1]}; |
130 | ($v ? $v->[0] : undef); |
131 | } |
132 | |
133 | #===================================================================== |
134 | # Package Return Value: |
135 | |
136 | 1; |
137 | |
138 | __END__ |
139 | |
140 | =head1 NAME |
141 | |
142 | Tie::CPHash - Case preserving but case insensitive hash table |
143 | |
144 | =head1 SYNOPSIS |
145 | |
146 | require Tie::CPHash; |
147 | tie %cphash, 'Tie::CPHash'; |
148 | |
149 | $cphash{'Hello World'} = 'Hi there!'; |
150 | printf("The key `%s' was used to store `%s'.\n", |
151 | tied(%cphash)->key('HELLO WORLD'), |
152 | $cphash{'HELLO world'}); |
153 | |
154 | =head1 DESCRIPTION |
155 | |
156 | The B<Tie::CPHash> module provides a hash table that is case |
157 | preserving but case insensitive. This means that |
158 | |
159 | $cphash{KEY} $cphash{key} |
160 | $cphash{Key} $cphash{keY} |
161 | |
162 | all refer to the same entry. Also, the hash remembers which form of |
163 | the key was last used to store the entry. The C<keys> and C<each> |
164 | functions will return the key that was used to set the value. |
165 | |
166 | An example should make this clear: |
167 | |
168 | tie %h, 'Tie::CPHash'; |
169 | $h{Hello} = 'World'; |
170 | print $h{HELLO}; # Prints 'World' |
171 | print keys(%h); # Prints 'Hello' |
172 | $h{HELLO} = 'WORLD'; |
173 | print $h{hello}; # Prints 'WORLD' |
174 | print keys(%h); # Prints 'HELLO' |
175 | |
176 | The additional C<key> method lets you fetch the case of a specific key: |
177 | |
178 | # When run after the previous example, this prints 'HELLO': |
179 | print tied(%h)->key('Hello'); |
180 | |
181 | (The C<tied> function returns the object that C<%h> is tied to.) |
182 | |
183 | If you need a case insensitive hash, but don't need to preserve case, |
184 | just use C<$hash{lc $key}> instead of C<$hash{$key}>. This has a lot |
185 | less overhead than B<Tie::CPHash>. |
186 | |
187 | =head1 AUTHOR |
188 | |
189 | Christopher J. Madsen E<lt>F<cjm@pobox.com>E<gt> |
190 | |
191 | =cut |
192 | |
193 | # Local Variables: |
194 | # tmtrack-file-task: "Tie::CPHash.pm" |
195 | # End: |