/[webpac]/trunk/filter/mem_lookup.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/filter/mem_lookup.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 205 - (show annotations)
Sun Jan 18 21:11:39 2004 UTC (20 years, 2 months ago) by dpavlin
File size: 2442 byte(s)
support for unrolling thesaurus entries which have data only about parent
term, so that we can display child terms for each entry

1 # 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 #print STDERR "## mem_lookup store: $k => $v\n";
35 }
36 } elsif (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) {
37 # indirect lookup [prefix[key]suffix]
38 my ($pre,$prek,$k,$postk,$post) = ($1,$2,$3,$4,$5);
39 if ($main::cache->{mem_lookup}->{$k}) {
40 my @keys = @{$main::cache->{mem_lookup}->{$k}};
41 #print STDERR "## mem_lookup fetch keys $k == ".join("|",@keys)."\n";
42 foreach my $k2 (@keys) {
43 if ($main::cache->{mem_lookup}->{$prek.$k2.$postk}) {
44 foreach my $v (@{$main::cache->{mem_lookup}->{$prek.$k2.$postk}}) {
45 push @out,$pre.$v.$post;
46 }
47 }
48 }
49 #print STDERR "## mem_lookup return values $k == ".join("|",@out)."\n";
50
51 }
52 } elsif (/^(.*)\[([^\[\]]+)\](.*)$/) {
53 # direct lookup [key]
54 my ($pre,$k,$post) = ($1,$2,$3);
55 if ($main::cache->{mem_lookup}->{$k}) {
56 #print STDERR "## mem_lookup fetch $k == ".join("|",@{$main::cache->{mem_lookup}->{$k}})."\n";
57 foreach my $v (@{$main::cache->{mem_lookup}->{$k2}}) {
58 push @out,$pre.$v.$post;
59 }
60 }
61 #print STDERR "## mem_lookup return values $k == ".join("|",@out)."\n";
62
63 } else {
64 # value is undef
65 #warn "mem_lookup: invalid filter specification: '$_'";
66 }
67 }
68 #print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n";
69 return @out;
70 }
71
72 1;

Properties

Name Value
cvs2svn:cvs-rev 1.1

  ViewVC Help
Powered by ViewVC 1.1.26