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