Tie-Hash-Regex-1.12000755001750001750 013245204723 13132 5ustar00davedave000000000000Tie-Hash-Regex-1.12/Build.PL000444001750001750 65013245204723 14544 0ustar00davedave000000000000use Module::Build; my $build = Module::Build->new( module_name => 'Tie::Hash::Regex', 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.12/Changes000444001750001750 605713245204723 14572 0ustar00davedave0000000000002018-02-23 Dave Cross * Build.PL: Missed a version number. * README, README.xml, lib/Tie/Hash/Regex.pm: Replace README.xml with plain text README. Bump version. * .travis.yml: Added more Perl versions to .travis.yml. 2016-10-04 Dave Cross * t/slices.t: Skip the skip_all * t/slices.t: More tests that won't compile * t/slices.t: Comment out TODO blocks As they still need to compile on older versions of Perl. 2016-05-18 Dave Cross * t/slices.t: Skip slice tests if hash slices are unsupported. * t/test.t: Use 'is' instead of 'ok' when appropriate. * t/slices.t: Better tests (and mark some as TODO) * lib/Tie/Hash/Regex.pm: Fix some typos that have been there for a very long time 2015-08-17 Theodorus Van Hoesel * t/slices.t: added test for 5.20 where regex should return more than one 2015-07-18 Dave Cross * .travis.yml: Added .travis.yml 2015-07-17 Dave Cross * .gitignore: Added .gitignore * MANIFEST: Added META.json to MANIFEST 2009-02-21 Dave Cross * lib/Tie/Hash/Regex.pm: Changed versioning system. 2008-06-30 Dave Cross * README.xml: Typo 2008-03-14 Dave Cross * README.xml: Fixed broken XML 2008-03-08 Dave Cross * MANIFEST: Added Build.PL to MANIFEST * MANIFEST: Moved Regex.pm in MANIFEST * 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. * t/pod.t, t/test.t: Switched to using Test::More. Removed old Test comments. Added t/pod.t. * MANIFEST: Removed COPYING from MANIFEST * COPYING: Removed COPYING * Regex.pm => lib/Tie/Hash/Regex.pm: Moved Regex.pm to lib * Build.PL, Makefile.PL: Switch from Makefile.PL to Build.PL 2006-06-01 Dave Cross * Regex.pm: Raising to version 1.0 * MANIFEST, t/pod_coverage.t: Added t/pod_coverage.t 2004-10-23 Dave Cross * Regex.pm, t/test.t: Improve test coverage. 2004-05-22 Dave Cross * t/test.t: Added some new tests 2004-05-12 Dave Cross * COPYING, MANIFEST, Makefile.PL, README.xml: Added various files to cvs * t/test.t: Added test file to CVS 2002-09-23 Dave Cross * Regex.pm: Fixed to work with Perl 5.8.0. 2002-07-28 Dave Cross * Regex.pm: Applied "exists" hash from Steffen M�ller. 2002-07-12 Dave Cross * Regex.pm: Corrected Attribute::Handler dependencies 2001-12-09 Dave Cross * Regex.pm: Doc fixes. * Regex.pm: Added Attribute::Handlers interface. 2001-09-03 Dave Cross * Regex.pm: Minor fixes. 2001-09-02 Dave Cross * Regex.pm: Added ref to Tie::RegexpHash. 2001-06-03 Dave Cross * Regex.pm: Put into RCS. Tie-Hash-Regex-1.12/MANIFEST000444001750001750 27613245204723 14405 0ustar00davedave000000000000Changes 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) META.json Tie-Hash-Regex-1.12/META.json000444001750001750 211413245204723 14706 0ustar00davedave000000000000{ "abstract" : "Match hash keys using Regular Expressions", "author" : [ "Dave Cross " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4224", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Tie-Hash-Regex", "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } }, "runtime" : { "requires" : { "Attribute::Handlers" : "0", "Tie::Hash" : "0", "perl" : "v5.6.0" } } }, "provides" : { "Tie::Hash::Regex" : { "file" : "lib/Tie/Hash/Regex.pm", "version" : "1.12" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "1.12", "x_serialization_backend" : "JSON::PP version 2.94" } Tie-Hash-Regex-1.12/META.yml000444001750001750 125613245204723 14544 0ustar00davedave000000000000--- abstract: 'Match hash keys using Regular Expressions' author: - 'Dave Cross ' build_requires: Test::More: '0' configure_requires: Module::Build: '0.42' dynamic_config: 1 generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Tie-Hash-Regex provides: Tie::Hash::Regex: file: lib/Tie/Hash/Regex.pm version: '1.12' requires: Attribute::Handlers: '0' Tie::Hash: '0' perl: v5.6.0 resources: license: http://dev.perl.org/licenses/ version: '1.12' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Tie-Hash-Regex-1.12/Makefile.PL000444001750001750 67413245204723 15230 0ustar00davedave000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4224 require 5.006000; use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Tie::Hash::Regex', 'VERSION_FROM' => 'lib/Tie/Hash/Regex.pm', 'PREREQ_PM' => { 'Attribute::Handlers' => 0, 'Test::More' => 0, 'Tie::Hash' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Tie-Hash-Regex-1.12/README000444001750001750 276613245204723 14162 0ustar00davedave000000000000 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.12/lib000755001750001750 013245204723 13700 5ustar00davedave000000000000Tie-Hash-Regex-1.12/lib/Tie000755001750001750 013245204723 14421 5ustar00davedave000000000000Tie-Hash-Regex-1.12/lib/Tie/Hash000755001750001750 013245204723 15304 5ustar00davedave000000000000Tie-Hash-Regex-1.12/lib/Tie/Hash/Regex.pm000444001750001750 747713245204723 17070 0ustar00davedave000000000000 =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 values 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 = 1.12; =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 L 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.12/t000755001750001750 013245204723 13375 5ustar00davedave000000000000Tie-Hash-Regex-1.12/t/pod.t000444001750001750 20113245204723 14452 0ustar00davedave000000000000use 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.12/t/pod_coverage.t000444001750001750 24113245204723 16331 0ustar00davedave000000000000use 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.12/t/test.t000444001750001750 116113245204723 14675 0ustar00davedave000000000000use 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'; is($hash{key}, 'value'); is($hash{'^s'}, 'something else'); is($hash{qr'^s'}, 'something else'); ok(not defined $hash{blah}); is($hash{$x}, 'something else'); my @vals = tied(%hash)->FETCH('k'); is(@vals, 2); delete $hash{stuff}; is(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; is(@k, 1); delete $hash{qr/^k/}; ok(not keys %hash);