Tie-Hash-Regex-1.14000755001750001750 014003515124 13125 5ustar00davedave000000000000Tie-Hash-Regex-1.14/Build.PL000444001750001750 174514003515124 14565 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', meta_merge => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'git://github.com/davorg/tie-hash-regex.git', web => 'https://github.com/davorg/tie-hash-regex', }, bugtracker => { web => 'https://github.com/davorg/tie-hash-regex/issues', }, }, }, ); $build->create_build_script; Tie-Hash-Regex-1.14/Changes000444001750001750 637514003515124 14570 0ustar00davedave0000000000002021-01-25 Dave Cross * Version 1.14 * Added bugtracker to metadata * Added GitHub CI 2020-11-04 Dave Cross * Version 1.13 * Added repo details 2018-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.14/MANIFEST000444001750001750 27614003515124 14400 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.14/META.json000444001750001750 254314003515124 14707 0ustar00davedave000000000000{ "abstract" : "Match hash keys using Regular Expressions", "author" : [ "Dave Cross " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4231", "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.14" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/davorg/tie-hash-regex/issues" }, "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/davorg/tie-hash-regex.git", "web" : "https://github.com/davorg/tie-hash-regex" } }, "version" : "1.14", "x_serialization_backend" : "JSON::PP version 4.04" } Tie-Hash-Regex-1.14/META.yml000444001750001750 144514003515124 14537 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.4231, 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.14' requires: Attribute::Handlers: '0' Tie::Hash: '0' perl: v5.6.0 resources: bugtracker: https://github.com/davorg/tie-hash-regex/issues license: http://dev.perl.org/licenses/ repository: git://github.com/davorg/tie-hash-regex.git version: '1.14' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Tie-Hash-Regex-1.14/Makefile.PL000444001750001750 67414003515124 15223 0ustar00davedave000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4231 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.14/README000444001750001750 321514003515124 14143 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 Build.PL Build Build 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. Since this has been published to CPAN, cpanm Tie::Hash::Regex will also install it for you along whatever dependency is not yet installed. 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.14/lib000755001750001750 014003515124 13673 5ustar00davedave000000000000Tie-Hash-Regex-1.14/lib/Tie000755001750001750 014003515124 14414 5ustar00davedave000000000000Tie-Hash-Regex-1.14/lib/Tie/Hash000755001750001750 014003515124 15277 5ustar00davedave000000000000Tie-Hash-Regex-1.14/lib/Tie/Hash/Regex.pm000444001750001750 761414003515124 17054 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. Simply declare your hash using the attribute syntax: my %hash :Regex; =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.14; =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.14/t000755001750001750 014003515124 13370 5ustar00davedave000000000000Tie-Hash-Regex-1.14/t/pod.t000444001750001750 23414003515124 14453 0ustar00davedave000000000000use strict; use warnings; use 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.14/t/pod_coverage.t000444001750001750 27414003515124 16332 0ustar00davedave000000000000use strict; use warnings; use 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.14/t/test.t000444001750001750 122114003515124 14665 0ustar00davedave000000000000use strict; use warnings; use Test::More; 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); done_testing();