23 |
# indexer, so it's save to leave type="" undefiend |
# indexer, so it's save to leave type="" undefiend |
24 |
# - lookup will (of course) return one or more values |
# - lookup will (of course) return one or more values |
25 |
|
|
26 |
|
use warnings; |
27 |
|
use strict; |
28 |
|
|
29 |
sub mem_lookup { |
sub mem_lookup { |
30 |
my @out; |
my @out; |
31 |
foreach (@_) { |
foreach (@_) { |
34 |
# store in array if it doesn't exist |
# store in array if it doesn't exist |
35 |
if (! grep(/^$v$/, @{$main::cache->{mem_lookup}->{$k}})) { |
if (! grep(/^$v$/, @{$main::cache->{mem_lookup}->{$k}})) { |
36 |
push @{$main::cache->{mem_lookup}->{$k}}, $v; |
push @{$main::cache->{mem_lookup}->{$k}}, $v; |
37 |
#print STDERR "## mem_lookup store: $k => $v\n"; |
#print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n"; |
38 |
} |
} |
39 |
} elsif (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) { |
} elsif (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) { |
40 |
# indirect lookup [prefix[key]suffix] |
# indirect lookup [prefix[key]suffix] |
41 |
my ($pre,$prek,$k,$postk,$post) = ($1,$2,$3,$4,$5); |
my ($pre,$prek,$k,$postk,$post) = ($1,$2,$3,$4,$5); |
42 |
if ($main::cache->{mem_lookup}->{$k}) { |
if ($main::cache->{mem_lookup}->{$k}) { |
43 |
my @keys = @{$main::cache->{mem_lookup}->{$k}}; |
my @keys = @{$main::cache->{mem_lookup}->{$k}}; |
44 |
#print STDERR "## mem_lookup fetch keys $k == ".join("|",@keys)."\n"; |
#print STDERR "## mem_lookup fetch keys $pre|$prek|$k|$postk|$post == [".join("|",@keys)."]\n"; |
45 |
foreach my $k2 (@keys) { |
foreach my $k2 (@keys) { |
46 |
if ($main::cache->{mem_lookup}->{$prek.$k2.$postk}) { |
my $full_k = $prek.$k2.$postk; |
47 |
foreach my $v (@{$main::cache->{mem_lookup}->{$prek.$k2.$postk}}) { |
if ($main::cache->{mem_lookup}->{$full_k}) { |
48 |
push @out,$pre.$v.$post; |
foreach my $v (@{$main::cache->{mem_lookup}->{$full_k}}) { |
49 |
|
my ($pret,$postt) = ($pre,$post); |
50 |
|
$pret=~s/\[$k\]/$k2/g; |
51 |
|
$postt=~s/\[$k\]/$k2/g; |
52 |
|
push @out,$pret.$v.$postt; |
53 |
} |
} |
54 |
} |
} |
55 |
} |
} |
56 |
#print STDERR "## mem_lookup return values $k == ".join("|",@out)."\n"; |
#print STDERR "## mem_lookup return values $pre\[$prek\[$k\]$postk\]$post == [".join("|",@out)."]\n"; |
57 |
|
|
58 |
} |
} |
59 |
} elsif (/^(.*)\[([^\[\]]+)\](.*)$/) { |
} elsif (/^(.*)\[([^\[\]]+)\](.*)$/) { |
61 |
my ($pre,$k,$post) = ($1,$2,$3); |
my ($pre,$k,$post) = ($1,$2,$3); |
62 |
if ($main::cache->{mem_lookup}->{$k}) { |
if ($main::cache->{mem_lookup}->{$k}) { |
63 |
#print STDERR "## mem_lookup fetch $k == ".join("|",@{$main::cache->{mem_lookup}->{$k}})."\n"; |
#print STDERR "## mem_lookup fetch $k == ".join("|",@{$main::cache->{mem_lookup}->{$k}})."\n"; |
64 |
foreach my $v (@{$main::cache->{mem_lookup}->{$k2}}) { |
foreach my $v (@{$main::cache->{mem_lookup}->{$k}}) { |
65 |
push @out,$pre.$v.$post; |
push @out,$pre.$v.$post; |
66 |
} |
} |
67 |
} |
} |
73 |
} |
} |
74 |
} |
} |
75 |
#print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n"; |
#print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n"; |
76 |
return @out; |
#print STDERR "out: ".Dumper(@out)."\n" if (@out); |
77 |
|
return wantarray ? @out : shift @out; |
78 |
} |
} |
79 |
|
|
80 |
1; |
1; |