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

Diff of /trunk/filter/mem_lookup.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 382 by dpavlin, Tue Jun 15 22:14:41 2004 UTC revision 383 by dpavlin, Wed Jul 7 20:51:37 2004 UTC
# Line 23  Line 23 
23  #   indexer, so it's save to leave type="" undefiend  #   indexer, so it's save to leave type="" undefiend
24  # - lookup will (of course) return one or more values  # - lookup will (of course) return one or more values
25    
26    use warnings;
27    use strict;
28    
29  sub mem_lookup {  sub mem_lookup {
30          my @out;          my @out;
31          foreach (@_) {          foreach (@_) {
# Line 33  sub mem_lookup { Line 36  sub mem_lookup {
36                                  push @{$main::cache->{mem_lookup}->{$k}}, $v;                                  push @{$main::cache->{mem_lookup}->{$k}}, $v;
37  #print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n";  #print STDERR "## mem_lookup store: $k => $v [",join("|",@{$main::cache->{mem_lookup}->{$k}}),"]\n";
38                          }                          }
39                  } elsif (/\[[^\[\]]+\]/) {                  } elsif (/^(.*)\[([^\[]*)\[([^\[\]]+)\]([^\]]*)\](.*)$/) {
40                          # lookup [key] recursivly                          # indirect lookup [prefix[key]suffix]
41                          my @in = ( $_ );                          my ($pre,$prek,$k,$postk,$post) = ($1,$2,$3,$4,$5);
42  #print STDERR "mem_lookup: $_\n";                          if ($main::cache->{mem_lookup}->{$k}) {
43                          while (my $f = shift @in) {                                  my @keys = @{$main::cache->{mem_lookup}->{$k}};
44                                  if ($f =~ /\[([^\[\]]+)\]/) {  #print STDERR "## mem_lookup fetch keys $pre|$prek|$k|$postk|$post == [".join("|",@keys)."]\n";
45                                          my $k = $1;                                  foreach my $k2 (@keys) {
46                                          if ($main::cache->{mem_lookup}->{$k}) {                                          my $full_k = $prek.$k2.$postk;
47  #print STDERR "mem_lookup key: $k = ";                                          if ($main::cache->{mem_lookup}->{$full_k}) {
48                                                  foreach my $nv (@{$main::cache->{mem_lookup}->{$k}}) {                                                  foreach my $v (@{$main::cache->{mem_lookup}->{$full_k}}) {
49  #print STDERR "\t$nv\n";                                                          my ($pret,$postt) = ($pre,$post);
50                                                          my $tmp = $f;                                                          $pret=~s/\[$k\]/$k2/g;
51                                                          $tmp =~ s/\[$k\]/$nv/g;                                                          $postt=~s/\[$k\]/$k2/g;
52                                                          push @in, $tmp;                                                          push @out,$pret.$v.$postt;
53                                                  }                                                  }
                                         } else {  
                                                 undef $f;  
54                                          }                                          }
55                                  } elsif ($f) {                                  }
56                                          push @out, $f;  #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 {                  } else {
71                          # value is undef                          # value is undef
72                          #warn "mem_lookup: invalid filter specification: '$_'";                          #warn "mem_lookup: invalid filter specification: '$_'";
# Line 62  sub mem_lookup { Line 74  sub mem_lookup {
74          }          }
75  #print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n";  #print STDERR "mem_lookup dump: ",Dumper($main::cache->{mem_lookup}),"\n";
76  #print STDERR "out: ".Dumper(@out)."\n" if (@out);  #print STDERR "out: ".Dumper(@out)."\n" if (@out);
77          return @out;          return wantarray ? @out : shift @out;
78  }  }
79    
80  1;  1;
Legend:
Removed from v.382  
changed lines
  Added in v.383
  ViewVC Help
Powered by ViewVC 1.1.26