+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, $forcenew) = @_;
+ my $ntoken = 0;
+ my $fno = 1;
+ my $filter;
+ my ($flag, $call);
+ my $s;
+ my $user;
+
+ # check the line for non legal characters
+ dbg("Filter::parse line: '$line'") if isdbg('filter');
+ return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\-\*\/\(\)\$!]/;
+
+ $line = lc $line;
+
+ # disguise regexes
+ $line =~ s/\{(.*)\}/'{'. unpack('H*', $1) . '}'/eg;
+ dbg("Filter parse line after regex check: '$line'") if isdbg('filter');
+
+ # add some spaces for ease of parsing
+ $line =~ s/([\(\!\)])/ $1 /g;
+
+ my @f = split /\s+/, $line;
+
+ my $conj = ' && ';
+ my $not = "";
+ my $lasttok = '';
+ while (@f) {
+ if ($ntoken == 0) {
+
+ if (!$forcenew && @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) unless $forcenew;
+ $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) {
+ unless ($lasttok eq '(') {
+ $s .= $conj ;
+ $user .= $conj;
+ }
+ $conj = "";
+ $lasttok = $tok;
+ }
+ if ($not) {
+ $s .= $not;
+ $user .= $not;
+ $not = "";
+ }
+ $s .= $tok;
+ $user .= $tok;
+ $lasttok = $tok;
+ next;
+ } elsif ($tok eq ')') {
+ $conj = ' && ';
+ $not ="";
+ $s .= $tok;
+ $user .= $tok;
+ $lasttok = $tok;
+ next;
+ } elsif ($tok eq 'all') {
+ $s .= '1';
+ $user .= $tok;
+ last;
+ } elsif ($tok eq 'or') {
+ $conj = ' || ' if $conj ne ' || ';
+ $lasttok = $tok;
+ next;
+ } elsif ($tok eq 'and') {
+ $conj = ' && ' if $conj ne ' && ';
+ next;
+ } elsif ($tok eq 'not' || $tok eq '!') {
+ $not = '! ';
+ $lasttok = $tok;
+ next;
+ }
+ if (@f) {
+ my $val = shift @f;
+ my @val = split /,/, $val;
+
+ if ($s) {
+ unless ($lasttok eq '(') {
+ $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;
+ foreach my $v (@val) {
+ $v =~ s/\*//g; # remove any trailing *
+ if (my ($r) = $v =~ /^\{(.*)\}$/) { # we have a regex
+ dbg("Filter::parse regex b: '\{$r\}'") if isdbg('filter');
+ $v = pack('H*', $r);
+ dbg("Filter::parse regex a: '$v'") if isdbg('filter');
+ return ('regex', $dxchan->msg('e38', $v)) unless (qr{$v});
+ }
+ push @t, "\$r->[$fref->[2]]=~m{$v}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 filter function $fref->[1]");
+ }
+ ++$found;
+ last;
+ }
+ }
+ return (1, $dxchan->msg('e20', $tok)) unless $found;
+ } else {
+ return (1, $dxchan->msg('filter2', $tok));
+ }
+ $lasttok = $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);
+ return (1, $filter) if $r;
+
+ my $u = DXUser::get_current($user);
+ return (1, $dxchan->msg('isow', $user)) if $u && $u->isolate;
+
+ 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(1); # 'delete'
+ $filter->install;
+
+ return (0, $filter, $fno);
+}
+
+package Filter::Old;
+
+use strict;
+use DXVars;
+use DXUtil;
+use DXDebug;
+use vars qw(@ISA);
+@ISA = qw(Filter);
+
+# the OLD instructions!
+#
+# Each filter file has the same structure:-
+#
+# <some comment>
+# @in = (
+# [ action, fieldno, fieldsort, comparison, action data ],
+# ...
+# );
+#
+# The action is usually 1 or 0 but could be any numeric value
+#
+# The fieldno is the field no in the list of fields that is presented
+# to 'Filter::it'
+#
+# The fieldsort is the type of field that we are dealing with which
+# currently can be 'a', 'n', 'r' or 'd'.
+# 'a' is alphanumeric
+# 'n' is# numeric
+# 'r' is ranges of pairs of numeric values
+# 'd' is default (effectively, don't filter)
+#
+# Filter::it basically goes thru the list of comparisons from top to
+# bottom and when one matches it will return the action and the action data as a list.
+# The fields
+# are the element nos of the list that is presented to Filter::it. Element
+# 0 is the first field of the list.