fix RBN (and other) basecall issues

This fix allows the code to remove ssids from calls that may be
formatted like 2E1/G1TST/7-6-#. Basecall() will return the callsign
without the -6-#. It will also correctly deal with OH1H/7-2 et al.
returning OH1H/7

diff --git a/Changes b/Changes
index e85130a541329ae806ba19ed72c0f99b6c7c3bd9..091ca43a32dce903f013d648274f909ba9a31a61 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+04Jan22=======================================================================
+1. Fix issue in the RBN (and probably other places) with callsigns that
+   contain trailing / in callsigns like: OH0K/6, K2PO/7 etc.
 03Jan22=======================================================================
 1. Allow overrides (on modern versions of perl) with things in DXVars.pm, such
    $clusterport. This is really only of use for people trying to run more than

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 96f0cb83af1b1e9ae1c3345356bed26a9e0c104e..7067c359d54892bbf7c935fc6fa67ecd43f107de 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -599,16 +599,15 @@ sub parraydifft
 
 sub basecall
 {
-       my ($r) = $_[0] =~ m|^(?:[\w\d]+/)?([\w\d]+).*$|;
+       my ($r) = $_[0] =~ m{^((?:[\w\d]+/)?[\w\d]+(?:/[\w\d]+)?)(?:-\d+)?(?:-\#)?$};
        return $r;
 }
 
 sub normalise_call
 {
-       my ($c, $ssid) = $_[0] =~ m|^((?:[\w\d]+/)?[\d\w]+(?:/[\w\d]+)?)-?(\d+)?$|;
+       my ($c, $ssid) = $_[0] =~ m|^((?:[\w\d]+/)?[\d\w]+(?:/[\w\d]+)?)(?:-(\d+))?(?:-\#)?$|;
        my $ncall = $c;
        $ssid += 0;
        $ncall .= "-$ssid" if $ssid;
        return $ncall;
-       
 }

diff --git a/perl/RBN.pm b/perl/RBN.pm
index 0b3dfe5a937dc245c9b67958476212a9610d7664..8e981fc2f908690db5f6cb539c0fa06fe07b3c7f 100644 (file)
--- a/perl/RBN.pm
+++ b/perl/RBN.pm
@@ -253,6 +253,10 @@ sub normal
 
        # remove all extraneous crap from the origin - just leave the base callsign
        $origin = basecall($origin);
+       unless ($origin) {
+               dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
+               return;
+       }
 
        # is this callsign in badspotter list?
        if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
@@ -261,7 +265,7 @@ sub normal
        }
        
        # is the qrg valid
-       unless ($qrg =~ /^\d+\.\d{1,2}$/) {
+       unless ($qrg =~ /^\d+\.\d{1,3}$/) {
                dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
                return;
        }