final(!) issued version of sh/dx

diff --git a/Changes b/Changes
index 71bf512ac1b9490efca24232f33ed5e201adf544..9b4122885d48a46846ce92fc5d1215a7952ccd09 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+01Jun20=======================================================================
+1. Fix sh/dx iota and qra. This completes the conversion of sh/dx's limited
+   "old style" parsing to using Filter style parsing with something that 
+   allows expressions include brackets ( and ) as well as the 'not' keyword.
+   NOTE: the precedence rules are the same as perl's '!', '||' and '&&' 
+         operators.  
 31May20=======================================================================
 1. Improve links command layout slightly.
 2. Issue an *accurate* UPGRADE.mojo with all the new packages included! 

diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
index 07dbed15b26db32959794a04ce2375fc1e56c303..c9d85c4bef562da88c0de932a8dc5136b56cf712 100644 (file)
--- a/cmd/show/dx.pl
+++ b/cmd/show/dx.pl
@@ -71,21 +71,21 @@ sub handle
                }
                if (lc $f eq 'iota') {
                        my $doiota;
-                       if (@list && $list[0] && (($a, $b) = $list[0] =~ /(AF|AN|NA|SA|EU|AS|OC)-?(\d?\d\d)/oi)) {
+                       if (@list && $list[0] && (($a, $b) = $list[0] =~ /(AF|AN|NA|SA|EU|AS|OC)[-\s]?(\d\d?\d?)/i)) {
                                $a = uc $a;
                                $doiota = "\\b$a\[\-\ \]\?$b\\b";
                                shift @list;
                        }
-                       $doiota = '\b(IOTA|(AF|AN|NA|SA|EU|AS|OC)[- ]?\d?\d\d)\b' unless $doiota;
-                       push @flist, "info {$doiota}";
-                       dbg("sh/dx iota") if isdbg('sh/dx');
+                       $doiota = '\b(IOTA|(AF|AN|NA|SA|EU|AS|OC)[-\s]?\d?\d\d)\b' unless $doiota;
+                       push @flist, 'info', "{$doiota}";
+                       dbg("sh/dx iota info {$doiota}") if isdbg('sh/dx');
                        next;
                }
                if (lc $f eq 'qra') {
-                       my $doqra = uc shift @list if @list && $list[0] =~ /[A-Z][A-Z]\d\d/oi;
+                       my $doqra = uc shift @list if @list && $list[0] =~ /[A-Z][A-Z]\d\d/i;
                        $doqra = '\b([A-Z][A-Z]\d\d|[A-Z][A-Z]\d\d[A-Z][A-Z])\b' unless $doqra;
-                       push @flist, "info {$doqra}";
-                       dbg("sh/dx qra") if isdbg('sh/dx');
+                       push @flist, 'info',  "{$doqra}";
+                       dbg("sh/dx qra info {$doqra}") if isdbg('sh/dx');
                        next;
                }
                if (grep {lc $f eq $_} qw { ( or and not ) }) {
@@ -93,7 +93,7 @@ sub handle
                        dbg("sh/dx operator $f") if isdbg('sh/dx');
                        next;
                }
-               if (grep {lc $f eq $_} qw(zone byzone by_zone itu byitu by_itu state bystate by_state info on spotter by) ) {
+               if (grep {lc $f eq $_} qw(on freq call info spotter by call_dxcc by_dxcc bydxcc origin call_itu itu call_zone zone  byitu by_itu by_zone byzone call_state state bystate by_state ip) ) {
                        $f =~ s/^by(\w)/by_$1/;
                        push @flist, $f;
                        push @flist, shift @list if @list;
@@ -109,17 +109,21 @@ sub handle
 
        
        if ($pre) {
-               $pre .= '*' unless $pre =~ /[\*\?\[]$/o;
-               $pre = shellregex($pre);
-               if ($usesql) {
-                       $pre =~ s/\.\*/%/g;
+               # someone (probably me) has forgotten the 'info' keyword
+               if ($pre =~ /^{.*}$/) {
+                       push @flist, 'info', $pre;
                } else {
-                       $pre =~ s/\.\*\$$//;
+                       $pre .= '*' unless $pre =~ /[\*\?\[]$/o;
+                       $pre = shellregex($pre);
+                       if ($usesql) {
+                               $pre =~ s/\.\*/%/g;
+                       } else {
+                               $pre =~ s/\.\*\$$//;
+                       }
+                       $pre .= '$' if $exact;
+                       $pre =~ s/\^//;
+                       push @flist, 'call', $pre;
                }
-               $pre .= '$' if $exact;
-               $pre =~ s/\^//;
-               
-               push @flist, 'call', $pre;
        }
        
     my $newline = join(' ', @flist);

diff --git a/perl/Filter.pm b/perl/Filter.pm
index fd9111826d209c25c1557b191cc1edd4f2048e08..898b004a71c2cc664373f68d3665d02b03032922 100644 (file)
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -375,12 +375,18 @@ sub parse
        # 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;
-       $line = lc $line;
        
        my @f = split /\s+/, $line;
+
        my $conj = ' && ';
        my $not = "";
        my $lasttok = '';
@@ -485,14 +491,15 @@ sub parse
                                                }
                                                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{$_})
+                                                       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{$_}i";
+                                                               push @t, "\$r->[$fref->[2]]=~m{$v}i";
                                                        }
                                                        $s .= "(" . join(' || ', @t) . ")";
                                                } elsif ($fref->[1] eq 'c') {
@@ -533,9 +540,9 @@ sub parse
                                                last;
                                        }
                                }
-                               return ('unknown', $dxchan->msg('e20', $tok)) unless $found;
+                               return (0, $dxchan->msg('e20', $tok)) unless $found;
                        } else {
-                               return ('no', $dxchan->msg('filter2', $tok));
+                               return (0, $dxchan->msg('filter2', $tok));
                        }
                        $lasttok = $tok;
                }