+}
+
+package Filter::Cmd;
+
+use strict;
+use DXVars;
+use DXUtil;
+use DXDebug;
+use vars qw(@ISA);
+@ISA = qw(Filter);
+
+# the general purpose command processor
+# this is called as a subroutine not as a method
+sub parse
+{
+ my ($self, $dxchan, $sort, $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 $dxchan->priv < 8 and $line =~ /{.*}/;
+ return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\-\*\/\(\)!]/;
+
+ # 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 >= 8 && ((is_callsign(uc $f[0]) && DXUser::get(uc $f[0])) || $f[0] =~ /(?:node|user)_default/)) {
+ $call = shift @f;
+ if ($f[0] eq 'input') {
+ shift @f;
+ $flag++;
+ }
+ } else {
+ $call = $dxchan->call;
+ }
+
+ if (@f && $f[0] =~ /^\d$/) {
+ $fno = shift @f;
+ }
+
+ $filter = Filter::read_in($sort, $call, $flag);
+ $filter = Filter->new($sort, $call, $flag) if !$filter || $filter->isa('Filter::Old');
+
+ $ntoken++;
+ next;
+ }
+
+ # 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 'all') {
+ $s .= '1';
+ $user .= $tok;
+ last;
+ } 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 ;
+ $user .= $conj;
+ $conj = ' && ';
+ }
+
+ if ($not) {
+ $s .= $not;
+ $user .= $not;
+ $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' || $fref->[1] eq 't') {
+ my @t;
+ for (@val) {
+ s/\*//g; # remove any trailing *
+ if (/^\{.*\}$/) { # we have a regex
+ s/^\{//;
+ s/\}$//;
+ return ('regex', $dxchan->msg('e38', $_)) unless (qr{$_})
+ }
+ push @t, "\$r->[$fref->[2]]=~m{$_}i";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ } elsif ($fref->[1] eq 'c') {
+ my @t;
+ for (@val) {
+ s/\*//g;
+ push @t, "\$r->[$fref->[2]]=~m{^\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] =~ /^n[ciz]$/ ) { # for DXCC, ITU, CQ Zone
+ my $cmd = $fref->[1];
+ my @pre = Prefix::to_ciz($cmd, @val);
+ return ('numpre', $dxchan->msg('e27', $_)) unless @pre;
+ $s .= "(" . join(' || ', map {"\$r->[$fref->[2]]==$_"} @pre) . ")";
+ } elsif ($fref->[1] =~ /^ns$/ ) { # for DXCC, ITU, CQ Zone
+ my $cmd = $fref->[1];
+ my @pre = Prefix::to_ciz($cmd, @val);
+ return ('numpre', $dxchan->msg('e27', $_)) unless @pre;
+ $s .= "(" . "!\$USDB::present || grep \$r->[$fref->[2]] eq \$_, qw(" . join(' ' ,map {uc} @pre) . "))";
+ } 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));
+ }
+ }
+
+ }
+
+ # 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, "$s");
+}
+
+# a filter accept/reject command
+sub cmd
+{
+ my ($self, $dxchan, $sort, $type, $line) = @_;
+
+ return $dxchan->msg('filter5') unless $line;
+
+ my ($r, $filter, $fno, $user, $s) = $self->parse($dxchan, $sort, $line);
+ my $u = DXUser::get_current($user);
+ return (1, $dxchan->msg('isow', $user)) if $u && $u->isolate;
+ return (1, $filter) if $r;
+
+ my $fn = "filter$fno";
+
+ $filter->{$fn} = {} unless exists $filter->{$fn};
+ $filter->{$fn}->{$type} = {} unless exists $filter->{$fn}->{$type};
+
+ $filter->{$fn}->{$type}->{user} = $user;
+ $filter->{$fn}->{$type}->{asc} = $s;
+ $r = $filter->compile($fn, $type);
+ return (1,$r) if $r;
+
+ $r = $filter->write;
+ return (1,$r) if $r;
+
+ $filter->install;
+
+ return (0, $filter, $fno);
+}
+
+package Filter::Old;
+
+use strict;
+use DXVars;
+use DXUtil;
+use DXDebug;
+use vars qw(@ISA);
+@ISA = qw(Filter);