Tie-Hash-Regex-1.02/0000775000076400007640000000000011032114012012521 5ustar davedaveTie-Hash-Regex-1.02/META.yml0000444000076400007640000000077511032114012013777 0ustar davedave--- name: Tie-Hash-Regex version: 1.02 author: - 'Dave Cross ' abstract: Match hash keys using Regular Expressions license: perl resources: license: http://dev.perl.org/licenses/ requires: Attribute::Handlers: 0 Tie::Hash: 0 perl: 5.6.0 build_requires: Test::More: 0 provides: Tie::Hash::Regex: file: lib/Tie/Hash/Regex.pm version: 15 generated_by: Module::Build version 0.280801 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Tie-Hash-Regex-1.02/Makefile.PL0000444000076400007640000000102411032114012014464 0ustar davedave# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01 require 5.6.0; use ExtUtils::MakeMaker; WriteMakefile ( 'PL_FILES' => {}, 'INSTALLDIRS' => 'site', 'NAME' => 'Tie::Hash::Regex', 'EXE_FILES' => [], 'VERSION_FROM' => 'lib/Tie/Hash/Regex.pm', 'PREREQ_PM' => { 'Test::More' => 0, 'Attribute::Handlers' => 0, 'Tie::Hash' => 0 } ) ; Tie-Hash-Regex-1.02/README0000444000076400007640000000276611032114012013410 0ustar davedave Tie::Hash::Regex ---------------- NAME Tie::Hash::Regex DESCRIPTION WHAT IS Tie::Hash::Regex? Tie::Hash::Regex is a Perl module which extends the functionality of Perl hashes so that they can match regular expression keys. HOW DO I INSTALL IT? Tie::Hash::Regex uses the standard Perl module architecture and can therefore be installed using the standard Perl method which, in brief, goes something like this: gzip -cd Tie-Hash-Regex-X.XX.tar.gz | tar xvf - cd Tie-Hash-Regex-X.XX perl Makefile.PL make make test make install Where X.XX is the version number of the module which you are installing. If this doesn't work for you then creating a directory called Tie/Hash somewhere in your Perl library path (@INC) and copying the Regex.pm file into this directory should also do the trick. WHERE IS THE DOCUMENTATION? All of the documentation is currently in POD format in the Regex.pm file. If you install the module using the standard method you should be able to read it by typing perldoc Tie::Hash::Regex at a comand prompt. LATEST VERSION The latest version of this module will always be available from CPAN. COPYRIGHT Copyright (c) 2001, Magnum Solutions Ltd. All Rights Reserved. This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ANYTHING ELSE? If you have any further questions, please contact the author. AUTHOR Dave Cross Tie-Hash-Regex-1.02/Build.PL0000444000076400007640000000070111032114012014007 0ustar davedaveuse Module::Build; my $build = Module::Build->new( module_name => 'Tie::Hash::Regex', dist_version => '1.02', license => 'perl', requires => { perl => '5.6.0', 'Tie::Hash' => 0, 'Attribute::Handlers' => 0, }, build_requires => { 'Test::More' => 0, }, build_recommends => { 'Test::Pod' => 0, 'Test::Pod::Coverage' => 0, }, create_makefile_pl => 'traditional' ); $build->create_build_script; Tie-Hash-Regex-1.02/lib/0000775000076400007640000000000011032114012013267 5ustar davedaveTie-Hash-Regex-1.02/lib/Tie/0000775000076400007640000000000011032114012014010 5ustar davedaveTie-Hash-Regex-1.02/lib/Tie/Hash/0000775000076400007640000000000011032114012014673 5ustar davedaveTie-Hash-Regex-1.02/lib/Tie/Hash/Regex.pm0000444000076400007640000000762211032114012016306 0ustar davedave# $Id: Regex.pm 15 2006-06-01 18:50:38Z dave $ =head1 NAME Tie::Hash::Regex - Match hash keys using Regular Expressions =head1 SYNOPSIS use Tie::Hash::Regex; my %h; tie %h, 'Tie::Hash::Regex'; $h{key} = 'value'; $h{key2} = 'another value'; $h{stuff} = 'something else'; print $h{key}; # prints 'value' print $h{2}; # prints 'another value' print $h{'^s'}; # prints 'something else' print tied(%h)->FETCH(k); # prints 'value' and 'another value' delete $h{k}; # deletes $h{key} and $h{key2}; or (new! improved!) my $h : Regex; =head1 DESCRIPTION Someone asked on Perlmonks if a hash could do fuzzy matches on keys - this is the result. If there's no exact match on the key that you pass to the hash, then the key is treated as a regex and the first matching key is returned. You can force it to leap straight into the regex checking by passing a qr'ed regex into the hash like this: my $val = $h{qr/key/}; C and C also do regex matching. In the case of C I vlaues matching your regex key will be deleted from the hash. One slightly strange thing. Obviously if you give a hash a regex key, then it's possible that more than one key will match (consider c<$h{qw/./}>). It might be nice to be able to do stuff like: my @vals = $h{$pat}; to get I matching values back. Unfortuately, Perl knows that a given hash key can only ever return one value and so forces scalar context on the C call when using the tied interface. You can get round this using the slightly less readable: my @vals = tied(%h)->FETCH($pat); =head2 ATTRIBUTE INTERFACE From version 0.06, you can use attributes to define your hash as being tied to Tie::Hash::Regex. You'll need to install the module Attribute::Handlers. =cut package Tie::Hash::Regex; use 5.006; use strict; use warnings; our ($VERSION, @ISA, @EXPORT, @EXPORT_OK); require Exporter; require Tie::Hash; use Attribute::Handlers autotie => { "__CALLER__::Regex" => __PACKAGE__ }; @ISA = qw(Exporter Tie::StdHash); @EXPORT = qw(); @EXPORT_OK =(); $VERSION = sprintf "%d", '$Revision: 15 $ ' =~ /(\d+)/; =head1 METHODS =head2 FETCH Get a value from the hash. If there isn't an exact match try a regex match. =cut sub FETCH { my $self = shift; my $key = shift; my $is_re = (ref $key eq 'Regexp'); return $self->{$key} if !$is_re && exists $self->{$key}; $key = qr/$key/ unless $is_re; # NOTE: wantarray will _never_ be true when FETCH is called # using the standard hash semantics. I've put that piece # of code in for people who are happy using syntax like: # tied(%h)->FETCH(qr/$pat/); if (wantarray) { return @{$self}{ grep /$key/, keys %$self }; } else { /$key/ and return $self->{$_} for keys %$self; } return; } =head2 EXISTS See if a key exists in the hash. If there isn't an exact match try a regex match. =cut sub EXISTS { my $self = shift; my $key = shift; my $is_re = (ref $key eq 'Regexp'); return 1 if !$is_re && exists $self->{$key}; $key = qr/$key/ unless $is_re; /$key/ && return 1 for keys %$self; return; } =head2 DELETE Delete a key from the hash. If there isn't an exact match try a regex match. =cut sub DELETE { my $self = shift; my $key = shift; my $is_re = (ref $key eq 'Regexp'); return delete $self->{$key} if !$is_re && exists $self->{$key}; $key = qr/$key/ unless $is_re; for (keys %$self) { if (/$key/) { delete $self->{$_}; } } } 1; __END__ =head1 AUTHOR Dave Cross Thanks to the Perlmonks for the original idea and to Jeff "japhy" Pinyan for some useful code suggestions. =head1 COPYRIGHT Copyright (C) 2001-8, Magnum Solutions Ltd. All Rights Reserved. =head1 LICENSE This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1). perltie(1). Tie::RegexpHash(1) =cut Tie-Hash-Regex-1.02/t/0000775000076400007640000000000011032114012012764 5ustar davedaveTie-Hash-Regex-1.02/t/pod_coverage.t0000444000076400007640000000024111032114012015577 0ustar davedaveuse Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); Tie-Hash-Regex-1.02/t/test.t0000444000076400007640000000117711032114012014132 0ustar davedaveuse Test::More tests=> 14; BEGIN { use_ok 'Tie::Hash::Regex' }; my %hash : Regex; $hash{key} = 'value'; $hash{key2} = 'another value'; $hash{stuff} = 'something else'; my $x = 'f'; ok($hash{key} eq 'value'); ok($hash{'^s'} eq 'something else'); ok($hash{qr'^s'} eq 'something else'); ok(not defined $hash{blah}); ok($hash{$x} eq 'something else'); my @vals = tied(%hash)->FETCH('k'); ok(@vals == 2); delete $hash{stuff}; ok(keys %hash == 2); ok(exists $hash{key}); ok(exists $hash{k}); ok(exists $hash{qr'^k'}); ok(not exists $hash{zz}); delete $hash{2}; my @k = keys %hash; ok(@k == 1); delete $hash{qr/^k/}; ok(not keys %hash); Tie-Hash-Regex-1.02/t/pod.t0000444000076400007640000000020111032114012013720 0ustar davedaveuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Tie-Hash-Regex-1.02/Changes0000444000076400007640000000327511032114012014017 0ustar davedave2008-03-08 dave * [r23] MANIFEST: Added Build.PL to MANIFEST * [r22] MANIFEST: Moved Regex.pm in MANIFEST * [r21] lib/Tie/Hash/Regex.pm: Removed old CVS log. Switched references from dave.org.uk to mag-sol.com. Forced use of Perl >= 5.6. Used "our" instead of "use vars". Added "use warnings". Added LICENSE (sic) section. * [r20] t/pod.t, t/test.t: Switched to using Test::More. Removed old Test comments. Added t/pod.t. * [r19] MANIFEST: Removed COPYING from MANIFEST * [r18] COPYING: Removed COPYING * [r17] Regex.pm, lib, lib/Tie, lib/Tie/Hash, lib/Tie/Hash/Regex.pm: Moved Regex.pm to lib * [r16] Build.PL, Makefile.PL: Switch from Makefile.PL to Build.PL 2006-06-01 dave * [r15] Regex.pm: Raising to version 1.0 * [r14] MANIFEST, t/pod_coverage.t: Added t/pod_coverage.t 2004-10-23 dave * [r13] Regex.pm, t/test.t: Improve test coverage. 2004-05-22 dave * [r12] t/test.t: Added some new tests 2004-05-12 dave * [r11] COPYING, MANIFEST, Makefile.PL, README.xml: Added various files to cvs * [r10] t, t/test.t: Added test file to CVS 2002-09-23 dave * [r9] Regex.pm: Fixed to work with Perl 5.8.0. 2002-07-28 dave * [r8] Regex.pm: Applied "exists" hash from Steffen M�ller. 2002-07-12 dave * [r7] Regex.pm: Corrected Attribute::Handler dependencies 2001-12-09 dave * [r6] Regex.pm: Doc fixes. * [r5] Regex.pm: Added Attribute::Handlers interface. 2001-09-03 dave * [r4] Regex.pm: Minor fixes. 2001-09-02 dave * [r3] Regex.pm: Added ref to Tie::RegexpHash. 2001-06-03 dave * [r2] Regex.pm: Put into RCS. 2001-06-03 * [r1] .: New repository initialized by cvs2svn. Tie-Hash-Regex-1.02/MANIFEST0000444000076400007640000000026411032114012013650 0ustar davedaveChanges MANIFEST Build.PL Makefile.PL lib/Tie/Hash/Regex.pm t/test.t t/pod.t t/pod_coverage.t README META.yml Module meta-data (added by MakeMaker)