From 211b54d504170a8c9dad2bf25b9ed686d5eeac11 Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 1 Nov 2000 21:27:39 +0000 Subject: [PATCH] added all the spots filter commands - you luckey people --- Changes | 33 ++++ cmd/accept/spots.pl | 31 ++++ cmd/clear/spots.pl | 35 ++++ cmd/reject/spots.pl | 31 ++++ cmd/show/filter.pl | 31 ++++ perl/DXChannel.pm | 8 +- perl/DXCommandmode.pm | 2 +- perl/DXProt.pm | 12 +- perl/Filter.pm | 381 +++++++++++++++++++++++++++++------------- perl/Messages | 7 +- perl/Spot.pm | 12 +- 11 files changed, 453 insertions(+), 130 deletions(-) create mode 100644 cmd/accept/spots.pl create mode 100644 cmd/clear/spots.pl create mode 100644 cmd/reject/spots.pl create mode 100644 cmd/show/filter.pl diff --git a/Changes b/Changes index 8807ce1a..baf50ccf 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,39 @@ 01Nov00======================================================================= 1. put PC11 field 2 check back to m for pc text. 2. improve 'simple' callsign checking +3. Added the first cut of the new user/sysop filtering code. This cut works +for spots and the syntax is:- + +accept/spots [] [input] [] things .. +reject/spots [] [input] [] things .. + +where things are: + freq 0/30000 | hf | hf/cw | 6m,4m,2m + call G,PA,HB9 + info iota + by G,PA,HB9 + call_dxcc 61,62 + call_itu 31 + call_zone 14,15,16 + by_dxcc 61,62 + by_itu 31 + by_zone 14,15,16 + origin GB7,MB7 + channel GB7DJK,GB7BAA + +You can simply string these together on one line one after the other and +there is an implied 'and', you can also string together with 'or' 'not' (or +'!') and '(' and ')' - in otherwords an arbitrary expression. + +You can see what you have done with: + +show/filter [] + +You can clear your work with: + +clear/spots [] [input] [|all] + +Have fun and someone please write the documentation. 31Oct00======================================================================= 1. add 0x8e to the list of characters we clobber (make xterm go into graphics mode). diff --git a/cmd/accept/spots.pl b/cmd/accept/spots.pl new file mode 100644 index 00000000..a76e3b34 --- /dev/null +++ b/cmd/accept/spots.pl @@ -0,0 +1,31 @@ +# +# accept/reject filter commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my $sort = 'accept'; + +my ($r, $filter, $fno, $user, $s) = $Spot::filterdef->parse($self, $line); +return (0, $filter) if $r; + +my $fn = "filter$fno"; + +$filter->{$fn} = {} unless exists $filter->{$fn}; +$filter->{$fn}->{$sort} = {} unless exists $filter->{$fn}->{$sort}; + +$filter->{$fn}->{$sort}->{user} = $user; +my $ref = eval $s; +return (0, $s, $@) if $@; + +$filter->{$fn}->{$sort}->{asc} = $s; +$r = $filter->write; +return (0, $r) if $r; + +$filter->{$fn}->{$sort}->{code} = $ref; +$filter->install; + +return (0, $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/clear/spots.pl b/cmd/clear/spots.pl new file mode 100644 index 00000000..bdce5c86 --- /dev/null +++ b/cmd/clear/spots.pl @@ -0,0 +1,35 @@ +# +# clear filters commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +my @f = split /\s+/, $line; +my @out; +my $dxchan = $self; +my $sort = 'spots'; +my $flag; +my $fno = 1; +my $call = $dxchan->call; + +my $f = lc shift @f if @f; +if ($self->priv >= 8) { + my $uref = DXUser->get(uc $f); + $call = $uref->call if $uref; + $f = undef; + $f = lc shift @f if @f; + if ($f && $f eq 'input') { + $flag = 'in'; + $f = undef; + $f = lc shift @f if @f; + } +} + +$fno = $f if $f; +my $filter = Filter::read_in($sort, $call, $flag); +Filter::delete($sort, $call, $flag, $fno); +$flag = $flag ? "input " : ""; +push @out, $self->msg('filter4', $flag, $sort, $fno, $call); +return (1, @out); diff --git a/cmd/reject/spots.pl b/cmd/reject/spots.pl new file mode 100644 index 00000000..0a3f77ec --- /dev/null +++ b/cmd/reject/spots.pl @@ -0,0 +1,31 @@ +# +# accept/reject filter commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my $sort = 'reject'; + +my ($r, $filter, $fno, $user, $s) = $Spot::filterdef->parse($self, $line); +return (0, $filter) if $r; + +my $fn = "filter$fno"; + +$filter->{$fn} = {} unless exists $filter->{$fn}; +$filter->{$fn}->{$sort} = {} unless exists $filter->{$fn}->{$sort}; + +$filter->{$fn}->{$sort}->{user} = $user; +my $ref = eval $s; +return (0, $s, $@) if $@; + +$filter->{$fn}->{$sort}->{asc} = $s; +$r = $filter->write; +return (0, $r) if $r; + +$filter->{$fn}->{$sort}->{code} = $ref; +$filter->install; + +return (0, $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/show/filter.pl b/cmd/show/filter.pl new file mode 100644 index 00000000..7289eed6 --- /dev/null +++ b/cmd/show/filter.pl @@ -0,0 +1,31 @@ +# +# show filter commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +my @f = split /\s+/, $line; +my @out; +my $dxchan = $self; +my $sort = ''; + +my $f = lc shift @f if @f; +if ($self->priv >= 8) { + my $d = DXChannel->get(uc $f); + $dxchan = $d if $d; + $f = lc shift @f if @f; +} + +$sort = $f if $f; +$sort .= 'filter'; + +my $key; +foreach $key (sort keys %$self) { + if ($key =~ /$sort$/) { + push @out, $self->{$key}->print if $self->{$key}; + } +} +push @out, $self->msg('filter3', $dxchan->call) unless @out; +return (1, @out); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index d566c177..140b7726 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -74,11 +74,11 @@ use vars qw(%channels %valid); annfilter => '5,Announce Filter', wwvfilter => '5,WWV Filter', wcyfilter => '5,WCY Filter', - spotfilter => '5,Spot Filter', + spotsfilter => '5,Spot Filter', inannfilter => '5,Input Ann Filter', inwwvfilter => '5,Input WWV Filter', inwcyfilter => '5,Input WCY Filter', - inspotfilter => '5,Input Spot Filter', + inspotsfilter => '5,Input Spot Filter', passwd => '9,Passwd List,parray', pingint => '5,Ping Interval ', nopings => '5,Ping Obs Count', @@ -102,10 +102,10 @@ sub DESTROY undef $self->{delayed}; undef $self->{annfilter}; undef $self->{wwvfilter}; - undef $self->{spotfilter}; + undef $self->{spotsfilter}; undef $self->{inannfilter}; undef $self->{inwwvfilter}; - undef $self->{inspotfilter}; + undef $self->{inspotsfilter}; undef $self->{passwd}; undef $self->{node}; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 5f626228..72d65cb3 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -82,7 +82,7 @@ sub start $self->{here} = 1; # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0); + $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0); $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0); $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0); $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index db342dfb..9c7064d2 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -70,7 +70,7 @@ $baddxfn = "$main::data/baddx.pl"; [ qw(c c n n) ], # pc25 [ qw(f m d t m c c bc) ], # pc26 [ qw(d n n n n m c c bc) ], # pc27 - [ qw(c c c c d t p m bp n p bp bc) ], # pc28 + [ qw(c c c m d t p m bp n p bp bc) ], # pc28 [ qw(c c n m) ], # pc29 [ qw(c c n) ], # pc30 [ qw(c c n) ], # pc31 @@ -212,14 +212,14 @@ sub start $self->{here} = 1; # get the output filters - $self->{spotfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0); + $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0); $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; # get the INPUT filters (these only pertain to Clusters) - $self->{inspotfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1); + $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1); $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); @@ -1138,8 +1138,8 @@ sub send_dx_spot my $routeit; my ($filter, $hops); - if ($dxchan->{spotfilter}) { - ($filter, $hops) = $dxchan->{spotfilter}->it(@_, $self->{call} ); + if ($dxchan->{spotsfilter}) { + ($filter, $hops) = $dxchan->{spotsfilter}->it(@_, $self->{call} ); next unless $filter; } @@ -1473,7 +1473,7 @@ sub broadcast_list if ($sort eq 'dx') { next unless $dxchan->{dx}; - ($filter) = $dxchan->{spotfilter}->it(@{$fref}) if ref $fref; + ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; next unless $filter; } next if $sort eq 'ann' && !$dxchan->{ann}; diff --git a/perl/Filter.pm b/perl/Filter.pm index 060f7ea8..6a0dad7a 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -51,13 +51,8 @@ sub new return bless {sort => $sort, name => "$flag$call.pl" }, $class; } -# this reads in a filter statement and returns it as a list -# -# The filter is stored in straight perl so that it can be parsed and read -# in with a 'do' statement. The 'do' statement reads the filter into -# @in which is a list of references -# -sub read_in +# standard filename generator +sub getfn { my ($sort, $call, $flag) = @_; @@ -71,9 +66,23 @@ sub read_in $call = lc $call; $fn = "$filterbasefn/$sort/$flag$call.pl"; } + $fn = undef unless -e $fn; + return $fn; +} + +# this reads in a filter statement and returns it as a list +# +# The filter is stored in straight perl so that it can be parsed and read +# in with a 'do' statement. The 'do' statement reads the filter into +# @in which is a list of references +# +sub read_in +{ + my ($sort, $call, $flag) = @_; + my $fn; # load it - if (-e $fn) { + if ($fn = getfn($sort, $call, $flag)) { $in = undef; my $s = readfilestr($fn); my $newin = eval $s; @@ -81,74 +90,87 @@ sub read_in if ($in) { $newin = new('Filter::Old', $sort, $call, $flag); $newin->{filter} = $in; + } else { + my $filter; + my $key; + foreach $key ($newin->getfilkeys) { + $filter = $newin->{$key}; + if ($filter->{reject} && exists $filter->{reject}->{asc}) { + $filter->{reject}->{code} = eval $filter->{reject}->{asc} ; + if ($@) { + my $sort = $newin->{sort}; + my $name = $newin->{name}; + dbg('err', "Error compiling reject $sort $key $name: $@"); + Log('err', "Error compiling reject $sort $key $name: $@"); + } + } + if ($filter->{accept} && exists $filter->{accept}->{asc}) { + $filter->{accept}->{code} = eval $filter->{accept}->{asc} ; + if ($@) { + my $sort = $newin->{sort}; + my $name = $newin->{name}; + dbg('err', "Error compiling accept $sort $key $name: $@"); + Log('err', "Error compiling accept $sort $key $name: $@"); + } + } + } } return $newin; } return undef; } +sub getfilters +{ + my $self = shift; + my @out; + my $key; + foreach $key (grep {/^filter/ } keys %$self) { + push @out, $self->{$key}; + } + return @out; +} + +sub getfilkeys +{ + my $self = shift; + return grep {/^filter/ } keys %$self; +} + # -# this routine accepts a composite filter with a reject component and then an accept -# the filter returns 0 if an entry is matched by any reject rule and also if any -# accept rule fails otherwise it returns 1 +# This routine accepts a composite filter with a reject rule and then an accept rule. # -# the either set of rules may be missing meaning an implicit 'ok' +# The filter returns 0 if an entry is matched by any reject rule and also if any +# accept rule fails otherwise it returns 1 # -# reject rules are implicitly 'or' logic (any reject rules which fires kicks it out) -# accept rules are implicitly 'and' logic (all accept rules must pass to indicate a match) +# Either set of rules may be missing meaning an implicit 'ok' # -# unlike the old system, this is kept as a hash of hashes so that you can +# Unlike the old system, this is kept as a hash of hashes so that you can # easily change them by program. # -# you can have a [any] number of 'filters', they are tried in random order until one matches -# -# an example in machine readable form:- -# bless ({ -# name => 'G7BRN.pl', -# sort => 'spots', -# filter1 => { -# user_rej => { -# by_dxcc => 'W,VE', -# }, -# reject => { -# by_dxcc => [6, 'n', 226,197], -# }, -# user_acc => { -# freq => '0/30000', -# }, -# accept => { -# freq => [0, 'r', 0, 30000], -# }, -# }, -# filter2 => { -# user_acc => { -# freq => 'vhf', -# by_zone => '14,15,16', -# }, -# accept => { -# freq => [0, 'r', 50000,52000,70000,70500,144000,148000], -# by_zone => [11, 'n', 14,15,16], -# } -# }, -# }, 'Filter'); -# -# in user commands:- -# -# clear/spots 1 2 -# accept/spots 1 freq 0/30000 -# reject/spots 1 by_dxcc W,VE -# accept/spots 2 freq vhf -# accept/spots 2 by_zone 14,15,16 +# You can have a [any] number of 'filters', they are tried in random order until +# one matches +# +# There is a parser that takes a Filter::Cmd object which describes all the possible +# things you can filter on and then converts that to a bit of perl which is compiled +# and stored as a function. +# +# The result of this is that in theory you can put together an arbritrarily complex +# expression involving the things you can filter on including 'and' 'or' 'not' and +# 'brackets'. +# +# eg:- +# +# accept/spots hf and by_zone 14,15,16 and not by pa,on +# +# accept/spots freq 0/30000 and by_zone 4,5 +# +# accept/spots 2 vhf and (by_zone 14,15,16 or call_dxcc 61) # # no filter no implies filter 1 # # The field nos are the same as for the 'Old' filters # -# The user_* fields are there so that the structure can be listed easily -# in human readable form when required. They are not used in the filtering -# process itself. -# -# This defines an HF filter and a VHF filter (as it happens) # sub it @@ -156,54 +178,26 @@ sub it my $self = shift; my $hops = undef; - my $filter; - my $r; + my $r = 1; - my ($key, $ref, $field, $fieldsort, $comp); - L1: foreach $key (grep {/^filter/ } keys %$self) { - my $filter = $self->{$key}; - $r = 0; - if ($filter->{reject}) { - foreach $ref (values %{$filter->{reject}}) { - ($field, $fieldsort) = @$ref[0,1]; - my $val = $_[$field]; - if ($fieldsort eq 'n') { - next L1 if grep $_ == $val, @{$ref}[2..$#$ref]; - } elsif ($fieldsort eq 'r') { - my $i; - for ($i = 2; $i < @$ref; $i += 2) { - next L1 if $val >= $ref->[$i] && $val <= $ref->[$i+1]; - } - } elsif ($fieldsort eq 'a') { - next L1 if grep $val =~ m{$_}, @$ref[2..$#$ref]; - } - } - } - if ($filter->{accept}) { - foreach $ref (values %{$filter->{accept}}) { - ($field, $fieldsort) = @$ref[0,1]; - my $val = $_[$field]; - if ($fieldsort eq 'n') { - next L1 unless grep $_ == $val, @{$ref}[2..$#$ref]; - } elsif ($fieldsort eq 'r') { - my $i; - for ($i = 2; $i < @$ref; $i += 2) { - next L1 unless $val >= $ref->[$i] && $val <= $ref->[$i+1]; - } - } elsif ($fieldsort eq 'a') { - next L1 unless grep $val =~ m{$_}, @{$ref}[2..$#$ref]; - } - } - } - $r = 1; - last; + my $filter; + foreach $filter ($self->getfilters) { + $r = 0; + if ($filter->{reject} && exists $filter->{reject}->{code}) { + next if &{$filter->{reject}->{code}}(\@_); + } + if ($filter->{accept} && exists $filter->{accept}->{code}) { + next unless &{$filter->{accept}->{code}}(\@_); + } + $r = 1; + last; } # hops are done differently if ($self->{hops}) { - my $h; + my ($comp, $ref); while (($comp, $ref) = each %{$self->{hops}}) { - ($field, $h) = @$ref; + my ($field, $h) = @$ref; if ($_[$field] =~ m{$comp}) { $hops = $h; last; @@ -222,7 +216,7 @@ sub write my $name = $self->{name}; my $dir = "$filterbasefn/$sort"; my $fn = "$dir/$name"; - + mkdir $dir, 0775 unless -e $dir; rename $fn, "$fn.o" if -e $fn; my $fh = new IO::File ">$fn"; @@ -243,7 +237,67 @@ sub write sub print { my $self = shift; - return $self->{name}; + my @out; + my $name = $self->{name}; + $name =~ s/.pl$//; + + push @out, join(' ', $name , ':', $self->{sort}); + my $filter; + my $key; + foreach $key (sort $self->getfilkeys) { + my $filter = $self->{$key}; + if ($filter->{reject} && exists $filter->{reject}->{user}) { + push @out, ' ' . join(' ', $key, 'reject', $filter->{reject}->{user}); + } + if ($filter->{accept} && exists $filter->{accept}->{user}) { + push @out, ' ' . join(' ', $key, 'accept', $filter->{accept}->{user}); + } + } + return @out; +} + +sub install +{ + my $self = shift; + my $remove = shift; + my $name = uc $self->{name}; + my $sort = $self->{sort}; + my ($in) = $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); + } +} + +sub delete +{ + my ($sort, $call, $flag, $fno) = @_; + + # look for the file + my $fn = getfn($sort, $call, $flag); + my $filter = read_in($sort, $call, $flag); + if ($filter) { + if ($fno eq 'all') { + my $key; + foreach $key ($filter->getfilkeys) { + delete $filter->{$key}; + } + } elsif (exists $filter->{"filter$fno"}) { + delete $filter->{"filter$fno"}; + } + + # get rid + if ($filter->{hops} || $filter->getfilkeys) { + $filter->install; + } else { + $filter->install(1); + unlink $fn; + } + } } package Filter::Cmd; @@ -254,21 +308,30 @@ use vars qw(@ISA); # the general purpose command processor # this is called as a subroutine not as a method -sub process_cmd +sub parse { my ($self, $dxchan, $line) = @_; my $ntoken = 0; my $fno = 1; my $filter; my ($flag, $call); - + my $s; + 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,_\*\/\(\)]/; - while (my @f = split /\s+/, $line) { + # add some spaces for ease of parsing + $line =~ s/([\(\)])/ $1 /g; + $line = lc $line; + + my @f = split /\s+/, $line; + my $conj = ' && '; + my $not = ""; + while (@f) { if ($ntoken == 0) { - if (@f && $dxchan->priv >= 9 && DXUser->get($f[0])) { + if (@f && $dxchan->priv >= 8 && (DXUser->get($f[0]) || $f[0] =~ /(?:node|user)_default/)) { $call = shift @f; if ($f[0] eq 'input') { shift @f; @@ -278,11 +341,12 @@ sub process_cmd $call = $dxchan->call; } - if (@f && $f[0] =~ /^\d+$/) { + if (@f && $f[0] =~ /^\d$/) { $fno = shift @f; } - $filter = Filter::read_in('spots', $call, $flag) or new Filter ('spots', $call, $flag); + $filter = Filter::read_in('spots', $call, $flag); + $filter = Filter->new('spots', $call, $flag) unless $filter; $ntoken++; next; @@ -291,23 +355,112 @@ sub process_cmd # do the rest of the filter tokens if (@f) { my $tok = shift @f; + if ($tok eq '(') { + if ($s) { + $s .= $conj; + $user .= $conj; + $conj = ""; + } + if ($not) { + $s .= $not; + $user .= $not; + $not = ""; + } + $s .= $tok; + $user .= $tok; + next; + } elsif ($tok eq ')') { + $conj = ' && '; + $not =""; + $s .= $tok; + $user .= $tok; + next; + } elsif ($tok eq 'or') { + $conj = ' || ' if $conj ne ' || '; + next; + } elsif ($tok eq 'and') { + $conj = ' && ' if $conj ne ' && '; + next; + } elsif ($tok eq 'not' || $tok eq '!') { + $not = '!'; + next; + } if (@f) { my $val = shift @f; - + my @val = split /,/, $val; + + if ($s) { + $s .= $conj ; + $s .= $not; + $user .= $conj; + $user .= $not; + $conj = ' && '; + $not = ""; + } + $user .= "$tok $val"; + my $fref; + my $found; foreach $fref (@$self) { + if ($fref->[0] eq $tok) { - + if ($fref->[4]) { + my @nval; + for (@val) { + push @nval, split(',', &{$fref->[4]}($dxchan, $_)); + } + @val = @nval; + } + if ($fref->[1] eq 'a') { + my @t; + for (@val) { + s/\*//g; + push @t, "\$r->[$fref->[2]]=~/$_/i"; + } + $s .= "(" . join(' || ', @t) . ")"; + } elsif ($fref->[1] eq 'c') { + my @t; + for (@val) { + s/\*//g; + push @t, "\$r->[$fref->[2]]=~/^\U$_/"; + } + $s .= "(" . join(' || ', @t) . ")"; + } elsif ($fref->[1] eq 'n') { + my @t; + for (@val) { + return ('num', $dxchan->msg('e21', $_)) unless /^\d+$/; + push @t, "\$r->[$fref->[2]]==$_"; + } + $s .= "(" . join(' || ', @t) . ")"; + } elsif ($fref->[1] eq 'r') { + my @t; + for (@val) { + return ('range', $dxchan->msg('e23', $_)) unless /^(\d+)\/(\d+)$/; + push @t, "(\$r->[$fref->[2]]>=$1 && \$r->[$fref->[2]]<=$2)"; + } + $s .= "(" . join(' || ', @t) . ")"; + } else { + confess("invalid letter $fref->[1]"); + } + ++$found; + last; } } + return ('unknown', $dxchan->msg('e20', $tok)) unless $found; } else { return ('no', $dxchan->msg('filter2', $tok)); } } } - $flag = $flag ? "in_" : ""; - return (0, $dxchan->msg('filter1', $fno, "$flag$call")); + + # tidy up the user string + $user =~ s/\&\&/ and /g; + $user =~ s/\|\|/ or /g; + $user =~ s/\!/ not /g; + $user =~ s/\s+/ /g; + + return (0, $filter, $fno, $user, "sub { my \$r = shift; return $s }"); } package Filter::Old; diff --git a/perl/Messages b/perl/Messages index 2b2ef763..e20e0d29 100644 --- a/perl/Messages +++ b/perl/Messages @@ -63,6 +63,9 @@ package DXM; e18 => 'Cannot connect to $_[0] ($!)', e19 => 'Invalid character in line', e20 => 'token $_[0] not recognised', + e21 => '$_[0] not numeric', + e22 => '$_[0] not a callsign', + e23 => '$_[0] not a range (eg 0/30000)', echoon => 'Echoing enabled', echooff => 'Echoing disabled', @@ -73,8 +76,10 @@ package DXM; export1 => 'usage: export ', export2 => '$_[3] has error exporting msg $_[0] to $_[1] ($_[2])', export3 => '$_[2 ] exported msg $_[0] to $_[1]', - filter1 => 'Filter $_[0] updated $_[1]', + filter1 => 'Filter $_[0] updated for $_[1]', filter2 => 'Need a value for $_[0]', + filter3 => 'No filters defined for $_[0]', + filter4 => '$_[0]$_[1] Filter $_[2] deleted for $_[3]', grids => 'DX Grid flag set on $_[0]', gridu => 'DX Grid flag unset on $_[0]', helpe1 => 'Help system unavailable, tell sysop', diff --git a/perl/Spot.pm b/perl/Spot.pm index c9178ddb..4c7ab06e 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -53,14 +53,18 @@ sub decodefreq my $f; foreach $f (@f) { - my ($a, $b) = $f =~ m{^(\d+)/(\d+)$}; - if ($a && $b) { - push @out, $a, $b; + my ($a, $b); + if (m{^\d+/\d+$}) { + push @out, $f; } elsif (($a, $b) = $f =~ m{^(\w+)(?:/(\w+))?$}) { $b = lc $b if $b; my @fr = Bands::get_freq(lc $a, $b); if (@fr) { - push @out, @fr; # add these to the list + while (@fr) { + $a = shift @fr; + $b = shift @fr; + push @out, "$a/$b"; # add them as ranges + } } else { return ('dfreq', $dxchan->msg('dfreq1', $f)); } -- 2.34.1