r28985 - in /branches/upstream/libtie-hash-regex-perl: ./ current/ current/lib/ current/lib/Tie/ current/lib/Tie/Hash/ current/t/
ceros-guest at users.alioth.debian.org
ceros-guest at users.alioth.debian.org
Wed Dec 31 20:06:33 UTC 2008
Author: ceros-guest
Date: Wed Dec 31 20:06:24 2008
New Revision: 28985
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28985
Log:
[svn-inject] Installing original source of libtie-hash-regex-perl
Added:
branches/upstream/libtie-hash-regex-perl/
branches/upstream/libtie-hash-regex-perl/current/
branches/upstream/libtie-hash-regex-perl/current/Build.PL
branches/upstream/libtie-hash-regex-perl/current/Changes
branches/upstream/libtie-hash-regex-perl/current/MANIFEST
branches/upstream/libtie-hash-regex-perl/current/META.yml
branches/upstream/libtie-hash-regex-perl/current/Makefile.PL
branches/upstream/libtie-hash-regex-perl/current/README
branches/upstream/libtie-hash-regex-perl/current/lib/
branches/upstream/libtie-hash-regex-perl/current/lib/Tie/
branches/upstream/libtie-hash-regex-perl/current/lib/Tie/Hash/
branches/upstream/libtie-hash-regex-perl/current/lib/Tie/Hash/Regex.pm
branches/upstream/libtie-hash-regex-perl/current/t/
branches/upstream/libtie-hash-regex-perl/current/t/pod.t
branches/upstream/libtie-hash-regex-perl/current/t/pod_coverage.t
branches/upstream/libtie-hash-regex-perl/current/t/test.t
Added: branches/upstream/libtie-hash-regex-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/Build.PL?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/Build.PL (added)
+++ branches/upstream/libtie-hash-regex-perl/current/Build.PL Wed Dec 31 20:06:24 2008
@@ -1,0 +1,21 @@
+use 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;
Added: branches/upstream/libtie-hash-regex-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/Changes?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/Changes (added)
+++ branches/upstream/libtie-hash-regex-perl/current/Changes Wed Dec 31 20:06:24 2008
@@ -1,0 +1,93 @@
+2008-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.
+
Added: branches/upstream/libtie-hash-regex-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/MANIFEST?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/MANIFEST (added)
+++ branches/upstream/libtie-hash-regex-perl/current/MANIFEST Wed Dec 31 20:06:24 2008
@@ -1,0 +1,10 @@
+Changes
+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)
Added: branches/upstream/libtie-hash-regex-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/META.yml?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/META.yml (added)
+++ branches/upstream/libtie-hash-regex-perl/current/META.yml Wed Dec 31 20:06:24 2008
@@ -1,0 +1,23 @@
+---
+name: Tie-Hash-Regex
+version: 1.02
+author:
+ - 'Dave Cross <dave at mag-sol.com>'
+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
Added: branches/upstream/libtie-hash-regex-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/Makefile.PL?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/Makefile.PL (added)
+++ branches/upstream/libtie-hash-regex-perl/current/Makefile.PL Wed Dec 31 20:06:24 2008
@@ -1,0 +1,17 @@
+# 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
+ }
+ )
+;
Added: branches/upstream/libtie-hash-regex-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/README?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/README (added)
+++ branches/upstream/libtie-hash-regex-perl/current/README Wed Dec 31 20:06:24 2008
@@ -1,0 +1,65 @@
+
+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 <dave at mag-sol.com>
+
Added: branches/upstream/libtie-hash-regex-perl/current/lib/Tie/Hash/Regex.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/lib/Tie/Hash/Regex.pm?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/lib/Tie/Hash/Regex.pm (added)
+++ branches/upstream/libtie-hash-regex-perl/current/lib/Tie/Hash/Regex.pm Wed Dec 31 20:06:24 2008
@@ -1,0 +1,188 @@
+# $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<exists> and C<delete> also do regex matching. In the case of C<delete>
+I<all> 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<all> 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<FETCH> 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__ };
+
+ at ISA = qw(Exporter Tie::StdHash);
+ at EXPORT = qw();
+ at 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 <dave at mag-sol.com>
+
+Thanks to the Perlmonks <http://www.perlmonks.org> 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
Added: branches/upstream/libtie-hash-regex-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/t/pod.t?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/t/pod.t (added)
+++ branches/upstream/libtie-hash-regex-perl/current/t/pod.t Wed Dec 31 20:06:24 2008
@@ -1,0 +1,4 @@
+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();
Added: branches/upstream/libtie-hash-regex-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/t/pod_coverage.t?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libtie-hash-regex-perl/current/t/pod_coverage.t Wed Dec 31 20:06:24 2008
@@ -1,0 +1,4 @@
+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();
Added: branches/upstream/libtie-hash-regex-perl/current/t/test.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-hash-regex-perl/current/t/test.t?rev=28985&op=file
==============================================================================
--- branches/upstream/libtie-hash-regex-perl/current/t/test.t (added)
+++ branches/upstream/libtie-hash-regex-perl/current/t/test.t Wed Dec 31 20:06:24 2008
@@ -1,0 +1,34 @@
+use 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);
+
More information about the Pkg-perl-cvs-commits
mailing list