+
+package Filter::Cmd;
+
+use strict;
+use DXVars;
+use DXUtil;
+use DXDebug;
+use vars qw(@ISA);
+@ISA = qw(Filter);
+
+sub encode_regex
+{
+ my $s = shift;
+ $s =~ s/\{(.*?)\}/'{'. unpack('H*', $1) . '}'/eg if $s;
+ return $s;
+}
+
+sub decode_regex
+{
+ my $r = shift;
+ my ($v) = $r =~ /^\{(.*?)}$/;
+ return pack('H*', $v);
+}
+
+
+# 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');
+ my @ch = $line =~ m|([^\s\w,_\.:\/\-\*\(\)\$!])|g;
+ return ('ill', $dxchan->msg('e19', join(' ', @ch))) if $line !~ /{.*}/ && @ch;
+
+ $line = lc $line;
+
+ # disguise regexes
+
+ dbg("Filter parse line after regex check: '$line'") if isdbg('filter');
+ $line = encode_regex($line);
+
+ # add some spaces for ease of parsing
+ $line =~ s/([\(\!\)])/ $1 /g;
+
+ my @f = split /\s+/, $line;
+ dbg("filter parse: tokens '" . join("' '", @f) . "'") if isdbg('filter');
+
+ 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;
+
+ dbg("filter::parse: tok '$tok'") if isdbg('filter');
+
+ if ($tok eq 'all') {
+ $s .= '1';
+ $user .= $tok;
+ last;
+ } elsif (grep $tok eq $_, qw{and or not ( )}) {
+ $s .= ' && ' if $tok eq 'and';
+ $s .= ' || ' if $tok eq 'or';
+ $s .= ' !' if $tok eq 'not';
+ $s .= $tok if $tok eq '(' or $tok eq ')';
+ $user .= " $tok ";
+ next;
+ } elsif ($tok eq '') {
+ next;
+ }
+
+ if (@f) {
+ my $val = shift @f;
+ my @val = split /,/, $val;
+
+ dbg("filter::parse: tok '$tok' val '$val'") if isdbg('filter');
+ $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 = decode_regex($v);
+ 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";
+ $v = "{$r}"; # put it back together again for humans
+ } else {
+ push @t, "\$r->[$fref->[2]]=~m{$v}i";
+ }
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ dbg("filter parse: s '$s'") if isdbg('filter');
+ } elsif ($fref->[1] eq 'c') {
+ my @t;
+ for (@val) {
+ s/\*//g;
+ push @t, "\$r->[$fref->[2]]=~m{^\U$_}";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ dbg("filter parse: s '$s'") if isdbg('filter');
+ } elsif ($fref->[1] eq 'n') {
+ my @t;
+ for (@val) {
+ return ('num', $dxchan->msg('e21', $_)) unless /^\d+$/;
+ push @t, "\$r->[$fref->[2]]==$_";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ dbg("filter parse: s '$s'") if isdbg('filter');
+ } 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) . ")";
+ dbg("filter parse: s '$s'") if isdbg('filter');
+ } 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) . "))";
+ dbg("filter parse: s '$s'") if isdbg('filter');
+ } 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) . ")";
+ dbg("filter parse: s '$s'") if isdbg('filter');
+ } else {
+ confess("invalid filter function $fref->[1]");
+ }
+ ++$found;
+ last;
+ }
+ }
+ return (1, $dxchan->msg('e20', $tok)) unless $found;
+ } else {
+ $s = $tok =~ /^{.*}$/ ? '{' . decode_regex($tok) . '}' : $tok;
+ return (1, $dxchan->msg('filter2', $s));
+ }
+ $lasttok = $tok;