Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Tie::DxHash; |
2 | ||
3 | use strict; | |
4 | use vars qw($VERSION @ISA); | |
5 | ||
6 | use Tie::Hash; | |
7 | ||
8 | ||
9 | ||
10 | $VERSION = '0.93'; | |
11 | @ISA = qw(Tie::StdHash); | |
12 | ||
13 | ||
14 | ||
15 | sub CLEAR { | |
16 | my($self) = @_; | |
17 | ||
18 | $self->{data} = []; | |
19 | $self->{iterators} = {}; | |
20 | $self->{occurrences} = {}; | |
21 | $self->ckey(0); | |
22 | ||
23 | $self; | |
24 | } | |
25 | ||
26 | ||
27 | ||
28 | sub DELETE { | |
29 | my($self, $key) = @_; | |
30 | ||
31 | my($offset); | |
32 | ||
33 | $offset = 0; | |
34 | ||
35 | ELEMENT: | |
36 | while ($offset < @{$self->{data}}) { | |
37 | if ($key eq $self->{data}[$offset]{key}) { | |
38 | splice @{$self->{data}}, $offset, 1; | |
39 | } | |
40 | else { | |
41 | $offset++; | |
42 | } | |
43 | } | |
44 | ||
45 | delete $self->{iterators}{$key}; | |
46 | delete $self->{occurrences}{$key}; | |
47 | $self; | |
48 | } | |
49 | ||
50 | ||
51 | ||
52 | sub EXISTS { | |
53 | my($self, $key) = @_; | |
54 | ||
55 | exists $self->{occurrences}{$key}; | |
56 | } | |
57 | ||
58 | ||
59 | ||
60 | sub FETCH { | |
61 | my($self, $key) = @_; | |
62 | ||
63 | my($dup, $offset); | |
64 | ||
65 | $dup = 1; | |
66 | ||
67 | HASH_KEY: | |
68 | foreach $offset (0 .. @{$self->{data}} - 1) { | |
69 | next HASH_KEY unless $key eq $self->{data}[$offset]{key}; | |
70 | next HASH_KEY unless $dup++ == $self->{iterators}{$key}; | |
71 | $self->{iterators}{$key}++; | |
72 | $self->{iterators}{$key} = 1 if $self->{iterators}{$key} > $self->{occurrences}{$key}; | |
73 | return $self->{data}[$offset]{value}; | |
74 | } | |
75 | ||
76 | return; | |
77 | } | |
78 | ||
79 | ||
80 | ||
81 | sub FIRSTKEY { | |
82 | my($self) = @_; | |
83 | ||
84 | $self->ckey(0); | |
85 | $self->NEXTKEY; | |
86 | } | |
87 | ||
88 | ||
89 | ||
90 | sub NEXTKEY { | |
91 | my($self) = @_; | |
92 | ||
93 | my($ckey, $key); | |
94 | ||
95 | $ckey = $self->ckey; | |
96 | $self->ckey($ckey + 1); | |
97 | $self->{data}[$ckey]{key}; | |
98 | } | |
99 | ||
100 | ||
101 | ||
102 | sub STORE { | |
103 | my($self, $key, $value) = @_; | |
104 | ||
105 | push @{$self->{data}}, { key => $key, value => $value }; | |
106 | $self->{iterators}{$key} ||= 1; | |
107 | $self->{occurrences}{$key}++; | |
108 | ||
109 | $self; | |
110 | } | |
111 | ||
112 | ||
113 | ||
114 | sub TIEHASH { | |
115 | my($class, @args) = @_; | |
116 | ||
117 | my($self); | |
118 | ||
119 | $self = {}; | |
120 | bless $self, $class; | |
121 | ||
122 | $self->init(@args); | |
123 | $self; | |
124 | } | |
125 | ||
126 | ||
127 | ||
128 | sub ckey { | |
129 | my($self, $ckey) = @_; | |
130 | ||
131 | $self->{ckey} = $ckey if defined $ckey; | |
132 | $self->{ckey}; | |
133 | } | |
134 | ||
135 | ||
136 | ||
137 | sub init { | |
138 | my($self, @args) = @_; | |
139 | ||
140 | my($key, $value); | |
141 | ||
142 | $self->CLEAR; | |
143 | $self->STORE($key, $value) while ($key, $value) = splice(@args, 0, 2); | |
144 | $self; | |
145 | } | |
146 | ||
147 | ||
148 | ||
149 | 1; | |
150 | __END__ | |
151 | ||
152 | =head1 NAME | |
153 | ||
154 | Tie::DxHash - keeps insertion order; allows duplicate keys | |
155 | ||
156 | =head1 SYNOPSIS | |
157 | ||
158 | use Tie::DxHash; | |
159 | my(%vhost); | |
160 | tie %vhost, 'Tie::DxHash' [, LIST]; | |
161 | %vhost = ( | |
162 | ServerName => 'foo', | |
163 | RewriteCond => 'bar', | |
164 | RewriteRule => 'bletch', | |
165 | RewriteCond => 'phooey', | |
166 | RewriteRule => 'squelch', | |
167 | ); | |
168 | ||
169 | =head1 DESCRIPTION | |
170 | ||
171 | This module was written to allow the use of rewrite rules in Apache | |
172 | configuration files written with Perl Sections. However, a potential user has | |
173 | stated that he needs it to support the use of multiple ScriptAlias directives | |
174 | within a single Virtual Host (which is required by FrontPage, apparently). If | |
175 | you find a completely different use for it, great. | |
176 | ||
177 | The original purpose of this module is not quite so obscure as it might sound. | |
178 | Perl Sections bring the power of a general-purpose programming language to | |
179 | Apache configuration files and, having used them once, many people use them | |
180 | throughout. (I take this approach since, even in sections of the configuration | |
181 | where I do not need the flexibility, I find it easier to use a consistent | |
182 | syntax. This also makes the code easier for XEmacs to colour in ;-) Similarly, | |
183 | mod_rewrite is easily the most powerful way to perform URL rewriting and I tend | |
184 | to use it exclusively, even when a simpler directive would do the trick, in | |
185 | order to group my redirections together and keep them consistent. So, I came up | |
186 | against the following problem quite early on. | |
187 | ||
188 | The synopsis shows some syntax which might be needed when using mod_rewrite | |
189 | within a Perl Section. Clearly, using an ordinary hash will not do what you | |
190 | want. The two additional features we need are to preserve insertion order and | |
191 | to allow duplicate keys. When retrieving an element from the hash by name, | |
192 | successive requests for the same name must iterate through the duplicate entries | |
193 | (and, presumably, wrap around when the end of the chain is reached). This is | |
194 | where Tie::DxHash comes in. Simply by tying the offending hash, the | |
195 | corresponding configuration directives work as expected. | |
196 | ||
197 | Running an Apache syntax check (with docroot check) on your configuration file | |
198 | (with C<httpd -t>) and checking virtual host settings (with C<httpd -S>) succeed | |
199 | without complaint. Incidentally, I strongly recommend building your Apache | |
200 | configuration files with make (or equivalent) in order to enforce the above two | |
201 | checks, preceded by a Perl syntax check (with C<perl -cx>). | |
202 | ||
203 | =head1 INTERNALS | |
204 | ||
205 | For those interested, Tie::IxHash works by storing the hash data in an array of | |
206 | hash references (containing the key/value pairs). This preserves insertion | |
207 | order. A separate set of iterators (one per distinct key) keeps track of the | |
208 | last retrieved value for a given key, thus allowing the successive retrieval of | |
209 | multiple values for the same key to work as expected. | |
210 | ||
211 | =head1 SEE ALSO | |
212 | ||
213 | perltie(1), for information on ties generally. | |
214 | ||
215 | Tie::IxHash(3), by Gurusamy Sarathy, if you need to preserve insertion order but | |
216 | not allow duplicate keys. | |
217 | ||
218 | For information on Ralf S. Engelschall's powerful URL rewriting module, | |
219 | mod_rewrite, check out the reference documentation at | |
220 | "http://httpd.apache.org/docs/mod/mod_rewrite.html" and the URL Rewriting Guide | |
221 | at "http://httpd.apache.org/docs/misc/rewriteguide.html". | |
222 | ||
223 | For help in using Perl Sections to configure Apache, take a look at the section | |
224 | called "Apache Configuration in Perl" at | |
225 | "http://perl.apache.org/guide/config.html#Apache_Configuration_in_Perl", part of | |
226 | the mod_perl guide, by Stas Bekman. Alternatively, buy the O'Reilly book | |
227 | Writing Apache Modules with Perl and C, by Lincoln Stein & Doug MacEachern, and | |
228 | study Chapter 8: Customizing the Apache Configuration Process. | |
229 | ||
230 | =head1 BUGS | |
231 | ||
232 | The algorithms used to retrieve and delete elements by key run in O(N) time, so | |
233 | do not expect this module to work well on large data sets. This is not a | |
234 | problem for the module's intended use. If you find another use for the module | |
235 | which involves larger quantities of data, let me know and I will put some effort | |
236 | into optimising for speed. | |
237 | ||
238 | The mod_rewrite directives for which this module was written (primarily | |
239 | RewriteCond and RewriteRule) can occur in all four configuration file contexts | |
240 | (i.e. server config, virtual host, directory, .htaccess). However, Tie::DxHash | |
241 | only helps when you are using a directive which is mapped onto a Perl hash. | |
242 | This limits you to directives which are block sections with begin and end tags | |
243 | (like <VirtualHost> and <Directory>). I get round this by sticking my | |
244 | mod_rewrite directives in a name-based virtual host container (as shown in the | |
245 | synopsis) even in the degenerate case where the web server only has one virtual | |
246 | host. | |
247 | ||
248 | =head1 AUTHOR | |
249 | ||
250 | Kevin Ruscoe | |
251 | ||
252 | =cut |