From: Dirk Koopman <djk@tobit.co.uk>
Date: Mon, 6 Apr 2020 20:05:28 +0000 (+0100)
Subject: add sh/dx origin and ip and regexes
X-Git-Url: http://dxspider.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=fc8ec20708a70b6297d3c8b8c35b1086c6018cbb;p=spider.git
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...
---
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 <list> - 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 <prefix>^Interrogate the spot database by country
This command takes the <prefix> (which can be a full or partial
diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
index b513c614..a219c387 100644
--- a/cmd/show/dx.pl
+++ b/cmd/show/dx.pl
@@ -29,6 +29,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;
@@ -85,6 +87,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') {
@@ -150,7 +163,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;
@@ -218,7 +248,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";
@@ -382,6 +412,11 @@ if ($doqra) {
$hint .= "m{$doqra}io";
}
+$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 b71ee95a..c53f9641 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 letter $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 afd40e9c..f7878eb1 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 9019bb5b..b7344702 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -50,6 +50,7 @@ $filterdef = bless ([
['call_state', 'ns', 12],
['by_state', 'ns', 13],
['channel', 'c', 14],
+ ['ip', 'c', 15],
], 'Filter::Cmd');
$totalspots = $hfspots = $vhfspots = 0;
@@ -222,7 +223,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 <n> days less than today to <m> days less than today
@@ -302,6 +303,7 @@ sub search
}
}
);
+
dbg("Spot eval: $eval") if isdbg('searcheval');