Sorry to drag us back on topic, but I thought you might like to tsee this
which I just knocked up for someone on perlmonks.
package Tie::Hash::Regex;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
require Tie::Hash;
@ISA = qw(Exporter Tie::StdHash);
@EXPORT = qw();
@EXPORT_OK =();
$VERSION = '0.01';
sub FETCH {
my $self = shift;
my $key = shift;
return $self->{$key} if exists $self->{$key};
foreach (keys %$self) {
return $self->{$_} if /$key/;
}
return;
}
1;
You use it like this:
use Tie::Hash::Regex
my %hash;
tie %hash, 'Tie::Hash::Regex';
$hash{key} = 'one';
$hash{stuff} = 'two';
print "$hash{key}\n"; # prints 'one'
print "$hash{'^s'}\n"; # prints 'two'
print "$hash{'y'}\n"; # prints 'one'
print "$hash{'.*'}\n"; # prints 'two'
The last is, of course, of limited use as it just matches the first key it
finds in the hash.
Share and Enjoy,
Dave...
The information contained in this communication is
confidential, is intended only for the use of the recipient
named above, and may be legally privileged. If the reader
of this message is not the intended recipient, you are
hereby notified that any dissemination, distribution or
copying of this communication is strictly prohibited.
If you have received this communication in error, please
re-send this communication to the sender and delete the
original message or any copy of it from your computer
system.
