fixed direct memory lookup, workaround for strange

bug when requested output is scalar; it will ignore
first element which works but is not totally correct

git-svn-id: file:///home/dpavlin/private/svn/webpac/trunk@383 13eb9ef6-21d5-0310-b721-a9d68796d827

diff --git a/filter/mem_lookup.pm b/filter/mem_lookup.pm
index e349c0a..d193356 100644 (file)
--- a/filter/mem_lookup.pm
+++ b/filter/mem_lookup.pm
@@ -23,6 +23,9 @@
 #   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 (@_) {
@@ -33,28 +36,37 @@ sub mem_lookup {
                                push @{$main::cache->{mem_lookup}->{$k}}, $v;
 #print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n";
                        }
-               } elsif (/\[[^\[\]]+\]/) {
-                       # lookup [key] recursivly
-                       my @in = ( $_ );
-#print STDERR "mem_lookup: $_\n";
-                       while (my $f = shift @in) {
-                               if ($f =~ /\[([^\[\]]+)\]/) {
-                                       my $k = $1;
-                                       if ($main::cache->{mem_lookup}->{$k}) {
-#print STDERR "mem_lookup key: $k = ";
-                                               foreach my $nv (@{$main::cache->{mem_lookup}->{$k}}) {
-#print STDERR "\t$nv\n";
-                                                       my $tmp = $f;
-                                                       $tmp =~ s/\[$k\]/$nv/g;
-                                                       push @in, $tmp;
+               } elsif (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) {
+                       # indirect lookup [prefix[key]suffix]
+                       my ($pre,$prek,$k,$postk,$post) = ($1,$2,$3,$4,$5);
+                       if ($main::cache->{mem_lookup}->{$k}) {
+                               my @keys = @{$main::cache->{mem_lookup}->{$k}};
+#print STDERR "## mem_lookup fetch keys $pre|$prek|$k|$postk|$post == [".join("|",@keys)."]\n";
+                               foreach my $k2 (@keys) {
+                                       my $full_k = $prek.$k2.$postk;
+                                       if ($main::cache->{mem_lookup}->{$full_k}) {
+                                               foreach my $v (@{$main::cache->{mem_lookup}->{$full_k}}) {
+                                                       my ($pret,$postt) = ($pre,$post);
+                                                       $pret=~s/\[$k\]/$k2/g;
+                                                       $postt=~s/\[$k\]/$k2/g;
+                                                       push @out,$pret.$v.$postt;
                                                }
-                                       } else {
-                                               undef $f;
                                        }
-                               } elsif ($f) {
-                                       push @out, $f;
-                               }       
+                               }
+#print STDERR "## mem_lookup return values $pre\[$prek\[$k\]$postk\]$post == [".join("|",@out)."]\n";
+
                        }
+               } elsif (/^(.*)\[([^\[\]]+)\](.*)$/) {
+                       # direct lookup [key]
+                       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}->{$k}}) {
+                                       push @out,$pre.$v.$post;
+                               }
+                       }
+#print STDERR "## mem_lookup return values $k == ".join("|",@out)."\n";
+
                } else {
                        # value is undef
                        #warn "mem_lookup: invalid filter specification: '$_'";
@@ -62,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;