/[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

Annotation of /trunk/filter/mem_lookup.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 742 - (hide annotations)
Wed May 24 19:05:25 2006 UTC (17 years, 9 months ago) by dpavlin
File size: 2778 byte(s)
fix mem_lookup with values which include characters which can be interpreted as regexes

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 dpavlin 383 use warnings;
27     use strict;
28    
29 dpavlin 205 sub mem_lookup {
30     my @out;
31     foreach (@_) {
32     if (/^(.+)\s=>\s(.+)$/) {
33     my ($k,$v) = ($1,$2);
34     # store in array if it doesn't exist
35 dpavlin 742 if (! grep(/^\Q$v\E$/, @{$main::cache->{mem_lookup}->{$k}})) {
36 dpavlin 205 push @{$main::cache->{mem_lookup}->{$k}}, $v;
37 dpavlin 207 #print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n";
38 dpavlin 205 }
39 dpavlin 383 } elsif (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) {
40     # indirect lookup [prefix[key]suffix]
41     my ($pre,$prek,$k,$postk,$post) = ($1,$2,$3,$4,$5);
42     if ($main::cache->{mem_lookup}->{$k}) {
43     my @keys = @{$main::cache->{mem_lookup}->{$k}};
44     #print STDERR "## mem_lookup fetch keys $pre|$prek|$k|$postk|$post == [".join("|",@keys)."]\n";
45     foreach my $k2 (@keys) {
46     my $full_k = $prek.$k2.$postk;
47     if ($main::cache->{mem_lookup}->{$full_k}) {
48     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 dpavlin 205 }
54     }
55 dpavlin 383 }
56     #print STDERR "## mem_lookup return values $pre\[$prek\[$k\]$postk\]$post == [".join("|",@out)."]\n";
57    
58 dpavlin 205 }
59 dpavlin 383 } elsif (/^(.*)\[([^\[\]]+)\](.*)$/) {
60     # direct lookup [key]
61     my ($pre,$k,$post) = ($1,$2,$3);
62     if ($main::cache->{mem_lookup}->{$k}) {
63     #print STDERR "## mem_lookup fetch $k == ".join("|",@{$main::cache->{mem_lookup}->{$k}})."\n";
64     foreach my $v (@{$main::cache->{mem_lookup}->{$k}}) {
65     push @out,$pre.$v.$post;
66     }
67     }
68     #print STDERR "## mem_lookup return values $k == ".join("|",@out)."\n";
69    
70 dpavlin 205 } else {
71     # value is undef
72     #warn "mem_lookup: invalid filter specification: '$_'";
73     }
74     }
75     #print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n";
76 dpavlin 207 #print STDERR "out: ".Dumper(@out)."\n" if (@out);
77 dpavlin 383 return wantarray ? @out : shift @out;
78 dpavlin 205 }
79    
80     1;

Properties

Name Value
cvs2svn:cvs-rev 1.2

  ViewVC Help
Powered by ViewVC 1.1.26