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 840ee0e21bb49d25a6fc30209e028beaef5d80a5..244688d99efea04bbac4ee37b8ad654d5f96c872 100644 (file)
--- 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 b513c614495ac40a13dc00854903da5e4a8194e0..a219c387b178556cd413ef2cbe19469f3b2b3295 100644 (file)
--- 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 b71ee95a5b81833acb4a1fc566592b832071529f..c53f9641433f0cf81b6210014019222cb838694c 100644 (file)
--- 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 afd40e9c31c1d7a65e5fddf8af2ac21a1e4d9e2f..f7878eb1fc0a5c7afce1dd6ca26c313107298547 100644 (file)
--- 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 9019bb5b92dbfb6f8a0f0729de336d769918f999..b7344702ddf1ce174b31db920fedfc225cb97fd1 100644 (file)
--- 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');