back-ported unlimited recursive mem_lookup from webpac v2.

Now you can say something like [[[900]]] and it will produce
tripple lookup (as opposed to double which was maximum in old
version).

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

diff --git a/filter/mem_lookup.pm b/filter/mem_lookup.pm
index 0c9c44f..e349c0a 100644 (file)
--- a/filter/mem_lookup.pm
+++ b/filter/mem_lookup.pm
@@ -33,37 +33,28 @@ 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 (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) {
-                       # 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;
+               } 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;
                                                }
+                                       } else {
+                                               undef $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}->{$k2}}) {
-                                       push @out,$pre.$v.$post;
-                               }
+                               } elsif ($f) {
+                                       push @out, $f;
+                               }       
                        }
-#print STDERR "## mem_lookup return values $k == ".join("|",@out)."\n";
-
                } else {
                        # value is undef
                        #warn "mem_lookup: invalid filter specification: '$_'";