http://qs321.pair.com?node_id=79683
Category: Tied Variables
Author/Contact Info davorg <dave@dave.org.uk>
Description:

A tied hash that does regex matching on keys if an exact match isn't found.

You'd 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'

[download]

The last is, of course, of limited use as it just matches the first key it finds in the hash.

 
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;
Replies are listed 'Best First'.
Re: Tie::Hash::Regex
by japhy (Canon) on May 11, 2001 at 18:07 UTC
    I'd automatically qr the "key" if it's not already in the hash. 
    sub FETCH {
  my ($self, $key) = @_;
  my $is_re = (ref($key) eq 'Regexp');

  return $self->{$key} if !$is_re and exists $self->{$key};
  $key = qr/$key/ if !$is_re;

  if (wantarray) {
    return @{$self}{ grep /$key/, keys %$self };
  }
  else {
    /$key/ and return $self->{$_} for keys %$self;
  }
}

    [download]


    japhy -- Perl and Regex Hacker
[reply]
[d/l]

      Thanks for your excellent suggestions. I can see this making it on to CPAN by the end of the weekend :)

      --
      <http://www.dave.org.uk>

      "Perl makes the fun jobs fun
      and the boring jobs bearable" - me

[reply]
[reply]
Re: Tie::Hash::Regex
by Masem (Monsignor) on May 11, 2001 at 17:22 UTC
    My knowledge of ties is somewhat lacking, and I don't know how possible it would be, but could this be modified or adapted such that instead of just the first value who's key matched the regex, could not all values whose keys match the regex be returned in some fashion. I know this wouldn't make sense programmatically for $hash{/./} (the $ implied scalar, but you could return a list ref, but this can easily get messy), but I dunno if it's possible to use something like @hash{/./} to do this. Sure, this is just simply doing the same as @array = map { $hash{$_} if /./ } keys %hash;, but it would seem to compliment the above well.

    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
[reply]
[d/l]
[select]

      I was just having a very similar conversation with someone in the office about those possibilities. Didn't manage to come to any firm conclusions tho' :(

      One thing we did think of - you could implement the delete function in such a way that it deleted every key that matched the regex (still some problems there tho' - what if the exact key of one element is also part of another key and would therefore match the regex?)

      --
      <http://www.dave.org.uk>

      "Perl makes the fun jobs fun
      and the boring jobs bearable" - me

[reply]
        Another idea similar to your deleting but without modifying the hash would be to make the fetch function store the current position of where it is in the keys, then subsequent calls would start from that last position. Of course, you'd then need a secondary hash in the tie to keep track of this, and there would be no easy way to reset this short of a function call to trick it. Additionally, modification of the hash between subsequent calls would pose a problem.

        Just tossing out ideas here in case something triggers insight....

        Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
[reply]

Back to Code Catacombs