Tie-DxHash-1.05/0040755002065400101720000000000011151355014012513 5ustar ruscoekeerdTie-DxHash-1.05/README0100644002065400101720000000137510537204034013400 0ustar ruscoekeerdTie-DxHash ========== DESCRIPTION Tie::DxHash implements a hash which preserves insertion order and allows duplicate keys. It was written to facilitate the use of more complex mod_rewrite rules in Apache configuration files written with Perl Sections. See the module's POD for details. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES None. COPYRIGHT AND LICENCE Copyright (C) 2001, Kevin Ruscoe This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Tie-DxHash-1.05/META.yml0100644002065400101720000000070610725402745013776 0ustar ruscoekeerd--- name: Tie-DxHash version: 1.03 author: - 'Kevin Ruscoe ' abstract: keeps insertion order; allows duplicate keys license: perl resources: license: http://dev.perl.org/licenses/ requires: Test::More: 0 version: 0 provides: Tie::DxHash: file: lib/Tie/DxHash.pm version: 1.03 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Tie-DxHash-1.05/MANIFEST0100644002065400101720000000046710725402745013662 0ustar ruscoekeerdBuild.PL Changes lib/Tie/DxHash.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/00-distribution.t t/01-kwalitee.t t/02-perl-critic.t t/03-pod.t t/04-pod-coverage.t t/clear.t t/defined.t t/delete.t t/destroy.t t/exists.t t/fetch.t t/keys.t t/multi.t t/scalar.t t/store.t t/tiehash.t META.yml Tie-DxHash-1.05/Changes0100644002065400101720000000331211151355007014004 0ustar ruscoekeerdRevision history for Tie-DxHash 1.05 - delete was not returning the expected value. It now returns a reference to a list of the removed values. If no values were removed, it returns a reference to the empty list. Thanks to Bart Lateur for the spot. 1.04 - did not upload to PAUSE successfully 1.03 - only run Test::Perl::Critic if AUTHOR_TEST env var is set 1.02 - Removed the SIGNATURE file. A number of people have reported failures during automatic installation caused by SIGNATURE files. My own file caused an installation failure for one of the CPAN testers and I was able to repeat the failure for myself when installing as root. I will reinstate this feature when the mechanism works more reliably. 1.01 - Changed version numbering style back to a Numeric Version (see the documentation for the version pragma). PAUSE does not appear to like Extended Versions. 1.0.0 - fixed bug: tied hashes did not work correctly when used with keys/values; tested with keys.t and scalar.t - Added Build.PL, MANIFEST.SKIP, META.yml and SIGNATURE files to distribution - Added support for testing with Test::Distribution, Test::Kwalitee, Test::Perl::Critic, Test::Pod and Test::Pod::Coverage - Updated code to match Perl Best Practices and pass all tests down to severity 1 - Ran tests through Devel::Cover and confirmed 100% coverage 0.93 - added a version number to the top-level directory within the tarball. 0.92 - fixed a bug related to passing additional arguments to the tie function; thanks to Daniel Kubb for the spot 0.91 - added a version number to the tarball - shortened the module's short description in order that it is not truncated on CPAN 0.90 Thu Mar 8 18:13:47 2001 - original version; created by h2xs 1.19 Tie-DxHash-1.05/Makefile.PL0100644002065400101720000000100710537204034014462 0ustar ruscoekeerduse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Tie::DxHash', AUTHOR => 'Kevin Ruscoe ', VERSION_FROM => 'lib/Tie/DxHash.pm', ABSTRACT_FROM => 'lib/Tie/DxHash.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'version' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Tie-DxHash-*' }, ); Tie-DxHash-1.05/Build.PL0100644002065400101720000000067010537204034014011 0ustar ruscoekeerduse strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Tie::DxHash', license => 'perl', dist_author => 'Kevin Ruscoe ', dist_version_from => 'lib/Tie/DxHash.pm', requires => { 'Test::More' => 0, 'version' => 0, }, add_to_cleanup => [ 'Tie-DxHash-*' ], ); $builder->create_build_script(); Tie-DxHash-1.05/MANIFEST.SKIP0100644002065400101720000000017110537204034014407 0ustar ruscoekeerd#defaults \.bak$ \.gz$ \.svn \.tdy$ \.tmp$ ^Build$ ^Makefile$ ^\.cvs ^_build/ ^blib/ ^blibdirs ^cover_db/ ^pm_to_blib ~$ Tie-DxHash-1.05/lib/0040755002065400101720000000000010537204034013263 5ustar ruscoekeerdTie-DxHash-1.05/lib/Tie/0040755002065400101720000000000011146436266014017 5ustar ruscoekeerdTie-DxHash-1.05/lib/Tie/DxHash.pm0100644002065400101720000002305111146436266015532 0ustar ruscoekeerd# $Id $ # $Revision 1.03 $ package Tie::DxHash; use warnings; use strict; use base qw(Tie::Hash); use Tie::Hash; our $VERSION = '1.03'; sub CLEAR { my ($self) = @_; my $test; $self->{data} = []; $self->{iterators} = {}; $self->{occurrences} = {}; $self->_ckey(0); return $self; } sub DELETE { my ( $self, $key ) = @_; my $offset = 0; my @deleted_elements = (); ELEMENT: while ( $offset < @{ $self->{data} } ) { if ( $key eq $self->{data}[$offset]{key} ) { push @deleted_elements, $self->{data}[$offset]{value}; splice @{ $self->{data} }, $offset, 1; } else { $offset++; } } delete $self->{iterators}{$key}; delete $self->{occurrences}{$key}; return \@deleted_elements; } sub EXISTS { my ( $self, $key ) = @_; return exists $self->{occurrences}{$key}; } sub FETCH { my ( $self, $key ) = @_; my ($dup) = 1; HASH_KEY: foreach my $offset ( 0 .. @{ $self->{data} } - 1 ) { next HASH_KEY if $key ne $self->{data}[$offset]{key}; next HASH_KEY if $dup++ != $self->{iterators}{$key}; $self->{iterators}{$key}++; if ( $self->{iterators}{$key} > $self->{occurrences}{$key} ) { $self->{iterators}{$key} = 1; } return $self->{data}[$offset]{value}; } return; } sub FIRSTKEY { my ($self) = @_; $self->_ckey(0); return $self->NEXTKEY; } sub NEXTKEY { my ($self) = @_; my ($ckey) = $self->_ckey; if ( $ckey == @{ $self->{data} } ) { return; } else { $self->_ckey( $ckey + 1 ); return $self->{data}[$ckey]{key}; } } sub SCALAR { my ($self) = @_; my $hash_size = 0; HASH_KEY: foreach my $key ( keys %{ $self->{occurrences} } ) { $hash_size += $self->{occurrences}{$key}; } return $hash_size; } sub STORE { my ( $self, $key, $value ) = @_; push @{ $self->{data} }, { key => $key, value => $value }; $self->{iterators}{$key} ||= 1; $self->{occurrences}{$key}++; return $self; } sub TIEHASH { my ( $class, @args ) = @_; my ($self); $self = {}; bless $self, $class; $self->_init(@args); return $self; } sub _ckey { my ( $self, $ckey ) = @_; if ( defined $ckey ) { $self->{ckey} = $ckey; } return $self->{ckey}; } sub _init { my ( $self, @args ) = @_; $self->CLEAR; while ( my ( $key, $value ) = splice @args, 0, 2 ) { $self->STORE( $key, $value ); } return $self; } 1; # Magic true value required at end of module __END__ =head1 NAME Tie::DxHash - keeps insertion order; allows duplicate keys =head1 VERSION This document describes Tie::DxHash version 1.03 =head1 SYNOPSIS use Tie::DxHash; my(%vhost); tie %vhost, 'Tie::DxHash' [, LIST]; %vhost = ( ServerName => 'foo', RewriteCond => 'bar', RewriteRule => 'bletch', RewriteCond => 'phooey', RewriteRule => 'squelch', ); =head1 DESCRIPTION This module was written to allow the use of rewrite rules in Apache configuration files written with Perl Sections. However, a potential user has stated that he needs it to support the use of multiple ScriptAlias directives within a single Virtual Host (which is required by FrontPage, apparently). If you find a completely different use for it, great. The original purpose of this module is not quite so obscure as it might sound. Perl Sections bring the power of a general-purpose programming language to Apache configuration files and, having used them once, many people use them throughout. (I take this approach since, even in sections of the configuration where I do not need the flexibility, I find it easier to use a consistent syntax. This also makes the code easier for XEmacs to colour in ;-) Similarly, mod_rewrite is easily the most powerful way to perform URL rewriting and I tend to use it exclusively, even when a simpler directive would do the trick, in order to group my redirections together and keep them consistent. So, I came up against the following problem quite early on. The synopsis shows some syntax which might be needed when using mod_rewrite within a Perl Section. Clearly, using an ordinary hash will not do what you want. The two additional features we need are to preserve insertion order and to allow duplicate keys. When retrieving an element from the hash by name, successive requests for the same name must iterate through the duplicate entries (and, presumably, wrap around when the end of the chain is reached). This is where Tie::DxHash comes in. Simply by tying the offending hash, the corresponding configuration directives work as expected. Running an Apache syntax check (with docroot check) on your configuration file (with C) and checking virtual host settings (with C) succeed without complaint. Incidentally, I strongly recommend building your Apache configuration files with make (or equivalent) in order to enforce the above two checks, preceded by a Perl syntax check (with C). =head1 SUBROUTINES/METHODS This module is intended to be called through Perl's tie interface. For reference, the following methods have been defined: CLEAR DELETE EXISTS FETCH FIRSTKEY NEXTKEY SCALAR STORE TIEHASH =head1 DIAGNOSTICS None. =head1 CONFIGURATION AND ENVIRONMENT Tie::DxHash requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 INCOMPATIBILITIES None reported. =head1 INTERNALS For those interested, Tie::DxHash works by storing the hash data in an array of hash references (containing the key/value pairs). This preserves insertion order. A separate set of iterators (one per distinct key) keeps track of the last retrieved value for a given key, thus allowing the successive retrieval of multiple values for the same key to work as expected. =head1 BUGS AND LIMITATIONS The algorithms used to retrieve and delete elements by key run in O(N) time, so do not expect this module to work well on large data sets. This is not a problem for the module's intended use. If you find another use for the module which involves larger quantities of data, let me know and I will put some effort into optimising for speed. The mod_rewrite directives for which this module was written (primarily RewriteCond and RewriteRule) can occur in all four configuration file contexts (i.e. server config, virtual host, directory, .htaccess). However, Tie::DxHash only helps when you are using a directive which is mapped onto a Perl hash. This limits you to directives which are block sections with begin and end tags (like and ). I get round this by sticking my mod_rewrite directives in a name-based virtual host container (as shown in the synopsis) even in the degenerate case where the web server only has one virtual host. =head1 SEE ALSO perltie(1), for information on ties generally. Tie::IxHash(3), by Gurusamy Sarathy, if you need to preserve insertion order but not allow duplicate keys. For information on Ralf S. Engelschall's powerful URL rewriting module, mod_rewrite, check out the reference documentation at "http://httpd.apache.org/docs/mod/mod_rewrite.html" and the URL Rewriting Guide at "http://httpd.apache.org/docs/misc/rewriteguide.html". For help in using Perl Sections to configure Apache, take a look at the section called "Apache Configuration in Perl" at "http://perl.apache.org/guide/config.html#Apache_Configuration_in_Perl", part of the mod_perl guide, by Stas Bekman. Alternatively, buy the O'Reilly book Writing Apache Modules with Perl and C, by Lincoln Stein & Doug MacEachern, and study Chapter 8: Customizing the Apache Configuration Process. =head1 AUTHOR Kevin Ruscoe C<< >> =head1 LICENSE AND COPYRIGHT Copyright (c) 2006, Kevin Ruscoe C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. Tie-DxHash-1.05/t/0040755002065400101720000000000011151355041012756 5ustar ruscoekeerdTie-DxHash-1.05/t/store.t0100644002065400101720000000045010537204034014275 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 2 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my (%obj); tie %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); ok(1); ok( join( '', keys %obj ), 'rggb' ); Tie-DxHash-1.05/t/delete.t0100644002065400101720000000111511146435431014406 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use warnings; use base qw(Tie::DxHash); use Test::More; BEGIN { plan tests => 4 } tie my %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); my $element = delete $obj{x}; is_deeply( $element, [ ], 'non-existent key'); $element = delete $obj{r}; is_deeply( $element, [ 'red' ], 'scalar return value'); my @elements = delete @obj{ qw(g b x) }; is( keys %obj, 0, 'all hash elements removed' ); is_deeply( \@elements, [ [ qw(green greenish) ], [ 'blue' ], [ ] ], 'list return value correctly defined'); Tie-DxHash-1.05/t/multi.t0100644002065400101720000000113310537204034014272 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 2 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my ( $key1, $key2, %obj1, %obj2, @out ); tie %obj1, 'Tie::DxHash::Child'; tie %obj2, 'Tie::DxHash::Child'; %obj1 = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); %obj2 = ( m => 'monday', t => 'tuesday', w => 'wednesday', w => 'wednesday' ); OUTER: while ( $key1 = each %obj1 ) { push @out, $key1; INNER: while ( $key2 = each %obj2 ) { push @out, $key2; next OUTER; } } ok(1); ok( join( '', @out ), 'rmgtgwbw' ); Tie-DxHash-1.05/t/01-kwalitee.t0100644002065400101720000000022110537204034015160 0ustar ruscoekeerduse Test::More; eval { require Test::Kwalitee; Test::Kwalitee->import() }; plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; Tie-DxHash-1.05/t/exists.t0100644002065400101720000000051110537204034014456 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 4 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my (%obj); tie %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); ok(1); ok( exists $obj{r} ); ok( exists $obj{g} ); ok( not exists $obj{x} ); Tie-DxHash-1.05/t/04-pod-coverage.t0100644002065400101720000000031411151355041015732 0ustar ruscoekeerduse Test::More; eval "use Test::Pod::Coverage 1.05"; plan skip_all => "Test::Pod::Coverage 1.05 required for testing POD coverage" if $@; all_pod_coverage_ok( { also_private => [qr/^SCALAR$/x] } ); Tie-DxHash-1.05/t/keys.t0100644002065400101720000000046510537204034014122 0ustar ruscoekeerduse Test::More qw(no_plan); use Tie::DxHash; my %dx_hash; tie( %dx_hash, Tie::DxHash ); $dx_hash{foo} = '1'; $dx_hash{bar} = '2'; is( scalar keys %dx_hash, 2, 'keys() returns the correct number of keys' ); $dx_hash{bletch} = '3'; is( scalar keys %dx_hash, 3, 'calling keys() does not mess up the hash' ); Tie-DxHash-1.05/t/tiehash.t0100644002065400101720000000052210537204034014566 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 2 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my ( %obj1, %obj2 ); tie %obj1, 'Tie::DxHash::Child'; tie %obj2, 'Tie::DxHash::Child', ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); ok(1); ok( join( '', keys %obj2 ), 'rggb' ); Tie-DxHash-1.05/t/03-pod.t0100644002065400101720000000020310537204034014137 0ustar ruscoekeerduse Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Tie-DxHash-1.05/t/scalar.t0100644002065400101720000000050310537204034014405 0ustar ruscoekeerduse Test::More tests => 2; use Tie::DxHash; my %dx_hash; tie( %dx_hash, Tie::DxHash ); is( scalar %dx_hash, 0, 'scalar %dx_hash returns zero for an empty tied hash' ); $dx_hash{foo} = '1'; $dx_hash{bar} = '2'; $dx_hash{bar} = '3'; is( scalar %dx_hash, 3, 'scalar %dx_hash returns the correct number of keys' ); Tie-DxHash-1.05/t/destroy.t0100644002065400101720000000044310537204034014634 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 2 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my (%obj); tie %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); undef %obj; ok(1); ok( keys %obj, 0 ); Tie-DxHash-1.05/t/fetch.t0100644002065400101720000000054410537204034014236 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 5 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my (%obj); tie %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); ok(1); ok( $obj{r}, 'red' ); ok( $obj{g}, 'green' ); ok( $obj{g}, 'greenish' ); ok( $obj{g}, 'green' ); Tie-DxHash-1.05/t/defined.t0100644002065400101720000000053310537204034014541 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 4 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my (%obj); tie %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => undef, b => 'blue' ); delete $obj{b}; ok(1); ok( defined $obj{g} ); ok( not defined $obj{g} ); ok( not defined $obj{b} ); Tie-DxHash-1.05/t/clear.t0100644002065400101720000000044210537204034014230 0ustar ruscoekeerdpackage Tie::DxHash::Child; use strict; use vars qw(@ISA); use Test; BEGIN { plan tests => 2 } use Tie::DxHash; @ISA = qw(Tie::DxHash); my (%obj); tie %obj, 'Tie::DxHash::Child'; %obj = ( r => 'red', g => 'green', g => 'greenish', b => 'blue' ); %obj = (); ok(1); ok( keys %obj, 0 ); Tie-DxHash-1.05/t/00-distribution.t0100644002065400101720000000041210537204034016073 0ustar ruscoekeerduse Test::More; BEGIN { eval { require Test::Distribution; }; if ($@) { plan skip_all => 'Test::Distribution not installed'; } else { import Test::Distribution podcoveropts => { also_private => [qr/^SCALAR$/x] }; } } Tie-DxHash-1.05/t/02-perl-critic.t0100644002065400101720000000043010725402574015603 0ustar ruscoekeerduse Test::More; eval "use Test::Perl::Critic( -severity => 1 )"; plan skip_all => 'Test::Perl::Critic only run for author tests' unless $ENV{AUTHOR_TEST}; plan skip_all => "Test::Perl::Critic required for reviewing coding style" if $@; Test::Perl::Critic::all_critic_ok();