From 043ec29d2c3f7d807f02660417696f0e93e20880 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 6 Apr 2020 21:05:28 +0100 Subject: [PATCH] add sh/dx origin and ip and regexes See help show/ddx for more information A regex for alpha fields for filters, Regexes are indicated by surrounding the pattern required with { and } e.g {\d+\s*db\s+\d+\s*wpm(?:\s+cq)?} But, in this case, the 'set/badword' mechanism is probably more robust. This is an experimental feature that may well not work... --- cmd/Commands_en.hlp | 8 ++++++++ cmd/show/dx.pl | 42 +++++++++++++++++++++++++++++++++++++++--- perl/Filter.pm | 33 +++++++++++++++++---------------- perl/Messages | 1 + perl/Spot.pm | 10 ++++++---- 5 files changed, 71 insertions(+), 23 deletions(-) diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 840ee0e2..244688d9 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -2160,6 +2160,12 @@ any order to the basic SHOW/DX command, they are:- by_state - look for spots spotted by people in the US state specified. + + origin - the node from which this spot originated (must be an + exact callsign with SSID e.g. gb7tlh-4) + + ip - the IP address of the spotter (either in IPV4 or IPV6) + format. These addresses can be partial. e.g. @@ -2177,6 +2183,8 @@ any order to the basic SHOW/DX command, they are:- SH/DX state in,oh SH/DX by_state in,oh SH/DX hb2008g exact + SH/DX origin gb7tlh-4 + SH/DX ip 82.65.128.4 (or SH/DX ip 2a00:1450:4009:800::200e) === 0^SHOW/DXCC ^Interrogate the spot database by country This command takes the (which can be a full or partial diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index 192d252f..371a3983 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -31,6 +31,8 @@ my $itu; my $byitu; my $fromdxcc = 0; my $exact; +my $origin; +my $ip; my ($doqsl, $doiota, $doqra, $dofilter); my $usesql = $main::dbh && $Spot::use_db_for_search; @@ -87,6 +89,17 @@ while ($f = shift @list) { # next field dbg "got info $info" if isdbg('shdx'); next; } + if (lc $f eq 'origin' && $list[0]) { + $origin = uc shift @list; + dbg "got origin $origin" if isdbg('shdx'); + next; + } + if (lc $f eq 'ip' && $list[0]) { + $ip = shift @list; + dbg "got ip $ip" if isdbg('shdx'); + next; + } + if ((lc $f eq 'spotter' || lc $f eq 'by') && $list[0]) { $spotter = uc shift @list; if ($list[0] && lc $list[0] eq 'dxcc') { @@ -152,7 +165,24 @@ while ($f = shift @list) { # next field #$DB::single = 1; -# first deal with the prefix +# check origin +if ($origin) { + $expr .= ' && ' if $expr; + $expr .= "\$f7 eq '$origin'"; + $hint .= ' && ' if $hint; + $hint .= "m{$origin}"; +} + +# check (any) ip address +if ($ip) { + $expr .= ' && ' if $expr; + $expr .= "\$f14 && \$f14 =~ m{^$ip}"; + $hint .= ' && ' if $hint; + $ip =~ s/\./\\./g; # IPV4 + $hint .= "m{$ip}"; +} + +# deal with the prefix if ($pre) { my @ans; @@ -220,7 +250,7 @@ if (@freq) { # any info if ($info) { $expr .= ' && ' if $expr; - $info =~ s{(.)}{"\Q$1"}ge; +# $info =~ s{(.)}{"\Q$1"}ge; $expr .= "\$f3 =~ m{$info}i"; $hint .= ' && ' if $hint; $hint .= "m{$info}i"; @@ -384,7 +414,13 @@ if ($doqra) { $hint .= "m{$doqra}io"; } -dbg "expr: $expr from: $from to: $to fromday: $fromday today: $today" if isdbg('shdx'); + +$from ||= ''; +$to ||= ''; +$fromday ||= ''; +$today ||= ''; + +dbg "expr: $expr from: $from to: $to fromday: $fromday today: $today" if isdbg('sh/dx'); # now do the search diff --git a/perl/Filter.pm b/perl/Filter.pm index bcf081e6..6b5cad94 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -373,7 +373,7 @@ sub parse my $user; # check the line for non legal characters - return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\-\*\/\(\)!]/; + return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\-\*\/\(\)!]/; # add some spaces for ease of parsing $line =~ s/([\(\)])/ $1 /g; @@ -473,18 +473,23 @@ sub parse } @val = @nval; } - if ($fref->[1] eq 'a') { + if ($fref->[1] eq 'a' || $fref->[1] eq 't') { my @t; for (@val) { - s/\*//g; - push @t, "\$r->[$fref->[2]]=~/$_/i"; + 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]]=~/^\U$_/"; + push @t, "\$r->[$fref->[2]]=~m{^\U$_}"; } $s .= "(" . join(' || ', @t) . ")"; } elsif ($fref->[1] eq 'n') { @@ -511,13 +516,6 @@ sub parse push @t, "(\$r->[$fref->[2]]>=$1 && \$r->[$fref->[2]]<=$2)"; } $s .= "(" . join(' || ', @t) . ")"; - } elsif ($fref->[1] eq 't') { - my @t; - for (@val) { - s/\*//g; - push @t, "\$r->[$fref->[2]]=~/$_/i"; - } - $s .= "(" . join(' || ', @t) . ")"; } else { confess("invalid filter function $fref->[1]"); } @@ -597,8 +595,11 @@ use vars qw(@ISA); # 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 and 'd' is default. +# 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. @@ -637,9 +638,9 @@ sub it return ($action, $actiondata) if $val >= $range[$i] && $val <= $range[$i+1]; } } elsif ($fieldsort eq 'a') { - return ($action, $actiondata) if $_[$field] =~ m{$comp}; + return ($action, $actiondata) if $_[$field] =~ m{$comp}i; } else { - return ($action, $actiondata); # the default action + return ($action, $actiondata); # the default action (just pass through) } } } diff --git a/perl/Messages b/perl/Messages index ef4a7c9a..8d64f796 100644 --- a/perl/Messages +++ b/perl/Messages @@ -110,6 +110,7 @@ package DXM; e35 => 'You are not a member of $_[0], join $_[0]', e36 => 'You can only do this in normal user prompt state', e37 => 'Need at least a callsign', + e38 => 'This is not a valid regex', echoon => 'Echoing enabled', echooff => 'Echoing disabled', diff --git a/perl/Spot.pm b/perl/Spot.pm index b3eff00c..f29ecef8 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -49,9 +49,10 @@ $filterdef = bless ([ ['by_zone', 'nz', 11], ['call_state', 'ns', 12], ['by_state', 'ns', 13], - ['channel', 'c', 14], - ['rbn', 'a', 4, 0, \&filterrbnspot], - ], 'Filter::Cmd'); + ['ip', 'c', 14], +# ['channel', 'c', 15], +# ['rbn', 'a', 4, 0, \&filterrbnspot], + ], 'Filter::Cmd'); $totalspots = $hfspots = $vhfspots = 0; $use_db_for_search = 0; @@ -231,7 +232,7 @@ sub add # $f5 = spotted dxcc country # $f6 = spotter dxcc country # $f7 = origin -# +# $f8 = ip address # # In addition you can specify a range of days, this means that it will start searching # from days less than today to days less than today @@ -311,6 +312,7 @@ sub search } } ); + dbg("Spot eval: $eval") if isdbg('searcheval'); -- 2.43.0