X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FFilter.pm;h=a37ea0d2d647cc95a45cdb6cdd969f8f25102e3b;hb=58234eafde7d75028574ae6aa519d2197120c558;hp=8acce7f383bdca5b235433509f94e1e4e98fcc7f;hpb=b85ee0ca2b03ee2c5be20bd430cfa00757b7ebdb;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index 8acce7f3..a37ea0d2 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -184,15 +184,18 @@ sub it { my $self = shift; - my $hops = undef; - my $filter; my @keys = sort $self->getfilkeys; my $key; + my $type = 'Dunno'; + my $asc = '?'; + my $r = @keys > 0 ? 0 : 1; foreach $key (@keys) { $filter = $self->{$key}; if ($filter->{reject} && exists $filter->{reject}->{code}) { + $type = 'reject'; + $asc = $filter->{reject}->{user}; if (&{$filter->{reject}->{code}}(\@_)) { $r = 0; last; @@ -201,6 +204,8 @@ sub it } } if ($filter->{accept} && exists $filter->{accept}->{code}) { + $type = 'accept'; + $asc = $filter->{accept}->{user}; if (&{$filter->{accept}->{code}}(\@_)) { $r = 1; last; @@ -210,16 +215,15 @@ sub it } } - # hops are done differently - if ($self->{hops}) { - my ($comp, $ref); - while (($comp, $ref) = each %{$self->{hops}}) { - my ($field, $h) = @$ref; - if ($_[$field] =~ m{$comp}) { - $hops = $h; - last; - } - } + # hops are done differently (simply) + my $hops = $self->{hops} if exists $self->{hops}; + + if (isdbg('filter')) { + my $args = join '\',\'', @_; + my $true = $r ? "OK" : "REJ"; + my $sort = $self->{sort}; + $hops ||= "none"; + dbg('filter', "Filter: $type/$sort with $asc on '$args': $true hops: $hops"); } return ($r, $hops); } @@ -281,12 +285,12 @@ sub install my $remove = shift; my $name = uc $self->{name}; my $sort = $self->{sort}; - my ($in) = $name =~ s/^IN_//; + my $in = ""; + $in = "in" if $name =~ s/^IN_//; $name =~ s/.PL$//; my $dxchan = DXChannel->get($name); if ($dxchan) { - $in = lc $in if $in; my $n = "$in$sort" . "filter"; $dxchan->$n($remove ? undef : $self); } @@ -369,7 +373,7 @@ sub parse } $filter = Filter::read_in($sort, $call, $flag); - $filter = Filter->new($sort, $call, $flag) unless $filter; + $filter = Filter->new($sort, $call, $flag) if !$filter || $filter->isa('Filter::Old'); $ntoken++; next; @@ -466,6 +470,13 @@ sub parse push @t, "(\$r->[$fref->[2]]>=$1 && \$r->[$fref->[2]]<=$2)"; } $s .= "(" . join(' || ', @t) . ")"; + } elsif ($fref->[1] eq 't') { + my @t; + for (@val) { + s/\*//g; + push @t, "\$r->[$fref->[2]]=~/$_/i"; + } + $s .= "(" . join(' || ', @t) . ")"; } else { confess("invalid letter $fref->[1]"); }