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