git.rot13.org Git - webpac/blob - filter/mem_lookup.pm

   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 use warnings;
  27 use strict;
  28
  29 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                         if (! grep(/^$v$/, @{$main::cache->{mem_lookup}->{$k}})) {
  36                                 push @{$main::cache->{mem_lookup}->{$k}}, $v;
  37 #print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n";
  38                         }
  39                 } 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                                                 }
  54                                         }
  55                                 }
  56 #print STDERR "## mem_lookup return values $pre\[$prek\[$k\]$postk\]$post == [".join("|",@out)."]\n";
  57
  58                         }
  59                 } 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                 } 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 #print STDERR "out: ".Dumper(@out)."\n" if (@out);
  77         return wantarray ? @out : shift @out;
  78 }
  79
  80 1;