1 |
dpavlin |
205 |
# this filter is used to find narrower terms in thesaurus which has |
2 |
|
|
# only broader terms defined |
3 |
|
|
# |
4 |
|
|
# it's general purpose memory lookup filter actually with following |
5 |
|
|
# sintax: |
6 |
|
|
# |
7 |
|
|
# prefix syntax before key value is arbitrary. I use here "d" to denote |
8 |
|
|
# display value and "a" to denote array (although they are stored the |
9 |
|
|
# same: as array with one or more elements) |
10 |
|
|
# |
11 |
|
|
# store operations: |
12 |
|
|
# key: d900, val: 250 (what to display) |
13 |
|
|
# <isis filter="mem_lookup">d900 => 250</isis> |
14 |
|
|
# key: a4611, val: 900 (parent fields has childs) |
15 |
|
|
# <isis filter="mem_lookup">a4611 => 900</isis> |
16 |
|
|
# |
17 |
|
|
# lookup: |
18 |
|
|
# key: a900 (lookup array, delimited by delimiters in one line) |
19 |
|
|
# <isis filter="mem_lookup" type="display">[a900]</isis> |
20 |
|
|
# |
21 |
|
|
# - each key can have more than one value |
22 |
|
|
# - storing something into lookup WON'T return any value to |
23 |
|
|
# indexer, so it's save to leave type="" undefiend |
24 |
|
|
# - lookup will (of course) return one or more values |
25 |
|
|
|
26 |
|
|
sub mem_lookup { |
27 |
|
|
my @out; |
28 |
|
|
foreach (@_) { |
29 |
|
|
if (/^(.+)\s=>\s(.+)$/) { |
30 |
|
|
my ($k,$v) = ($1,$2); |
31 |
|
|
# store in array if it doesn't exist |
32 |
|
|
if (! grep(/^$v$/, @{$main::cache->{mem_lookup}->{$k}})) { |
33 |
|
|
push @{$main::cache->{mem_lookup}->{$k}}, $v; |
34 |
dpavlin |
207 |
#print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n"; |
35 |
dpavlin |
205 |
} |
36 |
dpavlin |
351 |
} elsif (/\[[^\[\]]+\]/) { |
37 |
|
|
# lookup [key] recursivly |
38 |
|
|
my @in = ( $_ ); |
39 |
|
|
#print STDERR "mem_lookup: $_\n"; |
40 |
|
|
while (my $f = shift @in) { |
41 |
|
|
if ($f =~ /\[([^\[\]]+)\]/) { |
42 |
|
|
my $k = $1; |
43 |
|
|
if ($main::cache->{mem_lookup}->{$k}) { |
44 |
|
|
#print STDERR "mem_lookup key: $k = "; |
45 |
|
|
foreach my $nv (@{$main::cache->{mem_lookup}->{$k}}) { |
46 |
|
|
#print STDERR "\t$nv\n"; |
47 |
|
|
my $tmp = $f; |
48 |
|
|
$tmp =~ s/\[$k\]/$nv/g; |
49 |
|
|
push @in, $tmp; |
50 |
dpavlin |
205 |
} |
51 |
dpavlin |
351 |
} else { |
52 |
|
|
undef $f; |
53 |
dpavlin |
205 |
} |
54 |
dpavlin |
351 |
} elsif ($f) { |
55 |
|
|
push @out, $f; |
56 |
|
|
} |
57 |
dpavlin |
205 |
} |
58 |
|
|
} else { |
59 |
|
|
# value is undef |
60 |
|
|
#warn "mem_lookup: invalid filter specification: '$_'"; |
61 |
|
|
} |
62 |
|
|
} |
63 |
|
|
#print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n"; |
64 |
dpavlin |
207 |
#print STDERR "out: ".Dumper(@out)."\n" if (@out); |
65 |
dpavlin |
205 |
return @out; |
66 |
|
|
} |
67 |
|
|
|
68 |
|
|
1; |