fix mem_lookup with values which include characters which can be interpreted as regexes

[webpac] / filter / mem_lookup.pm

diff --git a/filter/mem_lookup.pm b/filter/mem_lookup.pm
index 0c9c44f..f29e12c 100644 (file)
--- a/filter/mem_lookup.pm
+++ b/filter/mem_lookup.pm
@@ -23,13 +23,16 @@
 #   indexer, so it's save to leave type="" undefiend
 # - lookup will (of course) return one or more values
 
+use warnings;
+use strict;
+
 sub mem_lookup {
        my @out;
        foreach (@_) {
                if (/^(.+)\s=>\s(.+)$/) {
                        my ($k,$v) = ($1,$2);
                        # store in array if it doesn't exist
-                       if (! grep(/^$v$/, @{$main::cache->{mem_lookup}->{$k}})) {
+                       if (! grep(/^\Q$v\E$/, @{$main::cache->{mem_lookup}->{$k}})) {
                                push @{$main::cache->{mem_lookup}->{$k}}, $v;
 #print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n";
                        }
@@ -58,7 +61,7 @@ sub mem_lookup {
                        my ($pre,$k,$post) = ($1,$2,$3);
                        if ($main::cache->{mem_lookup}->{$k}) {
 #print STDERR "## mem_lookup fetch $k == ".join("|",@{$main::cache->{mem_lookup}->{$k}})."\n";
-                               foreach my $v (@{$main::cache->{mem_lookup}->{$k2}}) {
+                               foreach my $v (@{$main::cache->{mem_lookup}->{$k}}) {
                                        push @out,$pre.$v.$post;
                                }
                        }
@@ -71,7 +74,7 @@ sub mem_lookup {
        }
 #print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n";
 #print STDERR "out: ".Dumper(@out)."\n" if (@out);
-       return @out;
+       return wantarray ? @out : shift @out;
 }
 
 1;