trunk/filter/mem_lookup.pm

# this filter is used to find narrower terms in thesaurus which has
# only broader terms defined
#
# it's general purpose memory lookup filter actually with following
# sintax:
#
# prefix syntax before key value is arbitrary. I use here "d" to denote
# display value and "a" to denote array (although they are stored the
# same: as array with one or more elements)
# 
# store operations:
# key: d900, val: 250 (what to display)
# <isis filter="mem_lookup">d900 => 250</isis>
# key: a4611, val: 900 (parent fields has childs)
# <isis filter="mem_lookup">a4611 => 900</isis>
# 
# lookup:
# key: a900 (lookup array, delimited by delimiters in one line)
# <isis filter="mem_lookup" type="display">[a900]</isis>
# 
# - each key can have more than one value
# - storing something into lookup WON'T return any value to
#   indexer, so it's save to leave type="" undefiend
# - lookup will (of course) return one or more values

sub mem_lookup {
        my @out;
        foreach (@_) {
                if (/^(.+)\s=>\s(.+)$/) {
                        my ($k,$v) = ($1,$2);
                        # store in array if it doesn't exist
                        if (! grep(/^$v$/, @{$main::cache->{mem_lookup}->{$k}})) {
                                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;
                                                }
                                        } else {
                                                undef $f;
                                        }
                                } elsif ($f) {
                                        push @out, $f;
                                }       
                        }
                } else {
                        # value is undef
                        #warn "mem_lookup: invalid filter specification: '$_'";
                }
        }
#print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n";
#print STDERR "out: ".Dumper(@out)."\n" if (@out);
        return @out;
}

1;
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;