X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=bf7ff65c18a24c82df8eb4c45e7c7e7695b2e04d;hb=refs%2Ftags%2FR_1_50;hp=abdcaba7363d8dbb2c8e682ed52a23cf644bfbeb;hpb=47597a3f8635c4d4de89419c0c808ddcda59b9d5;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index abdcaba7..bf7ff65c 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -30,12 +30,13 @@ use DXVars; use DXUtil; use DXDebug; use Data::Dumper; +use Prefix; use strict; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; @@ -225,7 +226,7 @@ sub it my $hops = $self->{hops} if exists $self->{hops}; if (isdbg('filter')) { - my $args = join '\',\'', @_; + my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} @_; my $true = $r ? "OK " : "REJ"; my $sort = $self->{sort}; my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT"; @@ -297,10 +298,23 @@ sub install $in = "in" if $name =~ s/^IN_//; $name =~ s/.PL$//; - my $dxchan = DXChannel->get($name); - if ($dxchan) { + my $dxchan; + my @dxchan; + if ($name eq 'NODE_DEFAULT') { + @dxchan = DXChannel::get_all_nodes(); + } elsif ($name eq 'USER_DEFAULT') { + @dxchan = DXChannel::get_all_users(); + } else { + $dxchan = DXChannel->get($name); + push @dxchan, $dxchan if $dxchan; + } + foreach $dxchan (@dxchan) { my $n = "$in$sort" . "filter"; - $dxchan->$n($remove ? undef : $self); + my $i = $in ? 'IN_' : ''; + my $ref = $dxchan->$n(); + if (!$ref || ($ref && uc $ref->{name} eq "$i$name.PL")) { + $dxchan->$n($remove ? undef : $self); + } } } @@ -354,7 +368,7 @@ sub parse my $user; # check the line for non legal characters - return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\-\*\/\(\)]/; + return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\-\*\/\(\)!]/; # add some spaces for ease of parsing $line =~ s/([\(\)])/ $1 /g; @@ -430,12 +444,16 @@ sub parse if ($s) { $s .= $conj ; - $s .= $not; $user .= $conj; - $user .= $not; $conj = ' && '; - $not = ""; } + + if ($not) { + $s .= $not; + $user .= $not; + $not = ''; + } + $user .= "$tok $val"; my $fref; @@ -471,6 +489,25 @@ sub parse push @t, "\$r->[$fref->[2]]==$_"; } $s .= "(" . join(' || ', @t) . ")"; + } elsif ($fref->[1] =~ /^n[ciz]$/ ) { # for DXCC, ITU, CQ Zone + my @n; + my $cmd = $fref->[1]; + foreach my $v (@val) { + if ($v =~ /^\d+$/) { + push @n, $v unless grep $_ eq $v, @n; + } else { + my @pre = Prefix::extract($v); + return ('numpre', $dxchan->msg('e27', $_)) unless @pre; + shift @pre; + foreach my $p (@pre) { + my $n = $p->dxcc if $cmd eq 'nc' ; + $n = $p->itu if $cmd eq 'ni' ; + $n = $p->cq if $cmd eq 'nz' ; + push @n, $n unless grep $_ eq $n, @n; + } + } + } + $s .= "(" . join(' || ', map {"\$r->[$fref->[2]]==$_"} @n) . ")"; } elsif ($fref->[1] eq 'r') { my @t; for (@val) {