From 0bd7ac4e24ce9e81232545b69ce8b98db605984b Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 1 Jun 2020 15:28:45 +0100 Subject: [PATCH] final(!) issued version of sh/dx --- Changes | 6 ++++++ cmd/show/dx.pl | 38 +++++++++++++++++++++----------------- perl/Filter.pm | 27 +++++++++++++++++---------- 3 files changed, 44 insertions(+), 27 deletions(-) diff --git a/Changes b/Changes index 71bf512a..9b412288 100644 --- 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 07dbed15..c9d85c4b 100644 --- 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 fd911182..898b004a 100644 --- 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; } -- 2.43.0