--- trunk/filter/mem_lookup.pm 2004/06/15 22:14:41 351 +++ trunk/filter/mem_lookup.pm 2004/07/07 20:51:37 383 @@ -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 @@ 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 @@ } #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;