From: minima <minima>
Date: Fri, 17 Aug 2001 15:31:07 +0000 (+0000)
Subject: 1. Sort out PC41 handling to include type 5 records for QRA locators and also
X-Git-Tag: R_1_48~96
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=78cf2dcb9be8128af7f8dc5ae37540c9c53c6057;p=spider.git

1. Sort out PC41 handling to include type 5 records for QRA locators and also
remove all filtering (but retain ephemeral dup checking).
2. Improve format checking in latlong and qra locators.
3. Sort sh/st so that sh/st by itself displays only the local call not the
whole lot (all 17000+ users records in my case). SH/ST ALL does this.
---

diff --git a/Changes b/Changes
index 1f6342c3..f7826e10 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+17Aug01=======================================================================
+1. Sort out PC41 handling to include type 5 records for QRA locators and also
+remove all filtering (but retain ephemeral dup checking).
+2. Improve format checking in latlong and qra locators.
+3. Sort sh/st so that sh/st by itself displays only the local call not the
+whole lot (all 17000+ users records in my case). SH/ST ALL does this.
 16Aug01=======================================================================
 1. send a forward/opernam for a logged in user once a month (when they next
 login).
diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp
index 9f30cd7f..2ffdbe06 100644
--- a/cmd/Commands_en.hlp
+++ b/cmd/Commands_en.hlp
@@ -1527,6 +1527,15 @@ So for example:-
 SH/SAT AO-10 
 SH/SAT FENGYUN1 12 2
 
+=== 6^SHOW/STATION ALL [<regex>]^Show list of users in the system
+=== 0^SHOW/STATION [<callsign> ..]^Show information about a callsign
+Show the information known about a callsign and whether (and where)
+that callsign is connected to the cluster.
+
+  SH/ST G1TLH
+
+If no callsign is given then show the information for yourself.
+
 === 0^SHOW/SUN [<prefix>|<callsign>]^Show sun rise and set times
 Show the sun rise and set times for a (list of) prefixes or callsigns, 
 together with the azimuth and elevation of the sun currently at those
diff --git a/cmd/forward/opername.pl b/cmd/forward/opername.pl
index a80d0ec9..1daaa1c3 100644
--- a/cmd/forward/opername.pl
+++ b/cmd/forward/opername.pl
@@ -29,6 +29,7 @@ foreach $call (@f) {
 		my $lat = $ref->lat;
 		my $long = $ref->long;
 		my $node = $ref->homenode;
+		my $qra = $ref->qra;
 		my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
 		if ($name) {
 			my $l = DXProt::pc41($DXProt::me, $call, 1, $name);
@@ -50,6 +51,11 @@ foreach $call (@f) {
 			DXProt::eph_dup($l);
 			DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
 		}
+		if ($qra) {
+			my $l = DXProt::pc41($call, 5, $qra);
+			DXProt::eph_dup($l);
+			DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+		}
 	}
 }
 
diff --git a/cmd/set/location.pl b/cmd/set/location.pl
index 25db6ba6..f4ee0358 100644
--- a/cmd/set/location.pl
+++ b/cmd/set/location.pl
@@ -15,21 +15,30 @@ $line =~ s/^\s+//;
 $line =~ s/\s+$//;
 
 return (1, $self->msg('loce1')) if !$line;
-return (1, $self->msg('loce3', uc $line)) if DXBearing::is_qra($line);
-return (1, $self->msg('loce2', $line)) unless $line =~ /\d+ \d+ [NnSs] \d+ \d+ [EeWw]/o;
+return (1, $self->msg('loce3', uc $line)) if is_qra($line);
+return (1, $self->msg('loce2', $line)) unless is_latlong($line);
 
 $user = DXUser->get_current($call);
 if ($user) {
 	$line = uc $line;
 	my ($lat, $long) = DXBearing::stoll($line);
-	$user->lat($lat);
-	$user->long($long);
-	my $s = DXProt::pc41($call, 3, $line);
-	DXProt::eph_dup($s);
-	DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
-	unless ($user->qra && DXBearing::is_qra($user->qra) ) {
-		my $qra = DXBearing::lltoqra($lat, $long);
+	my $oldlat = $user->lat || 0;
+	my $oldlong = $user->long || 0;
+	if ($oldlat != $lat || $oldlong != $long) {
+		$user->lat($lat);
+		$user->long($long);
+		my $l = DXBearing::lltos($lat, $long);
+		my $s = DXProt::pc41($call, 3, $l);
+		DXProt::eph_dup($s);
+		DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+	}
+	my $qra = DXBearing::lltoqra($lat, $long);
+	my $oldqra = $user->qra || "";
+	if ($oldqra ne $qra) {
 		$user->qra($qra);
+		my $s = DXProt::pc41($call, 5, $qra);
+		DXProt::eph_dup($s);
+		DXProt::broadcast_all_ak1a($s, $DXProt::me);
 	}
 	
 	$user->put();
diff --git a/cmd/set/qra.pl b/cmd/set/qra.pl
index 484666ca..60c6dc16 100644
--- a/cmd/set/qra.pl
+++ b/cmd/set/qra.pl
@@ -15,20 +15,28 @@ $line =~ s/^\s+//;
 $line =~ s/\s+$//;
 
 return (1, $self->msg('qrae1')) if !$line;
-return (1, $self->msg('qrae2', $line)) unless DXBearing::is_qra($line);
+return (1, $self->msg('qrae2', $line)) unless is_qra($line);
 
 $user = DXUser->get_current($call);
 if ($user) {
-	$line = uc $line;
-	$user->qra($line);
-	if (!$user->lat && !$user->long) {
-		my ($lat, $long) = DXBearing::qratoll($line);
+	my $qra = uc $line;
+	my $oldqra = $user->qra || "";
+	if ($oldqra ne $qra) {
+		$user->qra($qra);
+		my $s = DXProt::pc41($call, 5, $qra);
+		DXProt::eph_dup($s);
+		DXProt::broadcast_all_ak1a($s, $DXProt::me);
+	}
+	my ($lat, $long) = DXBearing::qratoll($qra);
+	my $oldlat = $user->lat || 0;
+	my $oldlong = $user->long || 0;
+	if ($oldlat != $lat || $oldlong != $long) {
 		$user->lat($lat);
 		$user->long($long);
-		my $s = DXBearing::lltos($lat, $long);
-		my $l = DXProt::pc41($call, 3, $s);
-		DXProt::eph_dup($l);
-		DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+		my $l = DXBearing::lltos($lat, $long);
+		my $s = DXProt::pc41($call, 3, $l);
+		DXProt::eph_dup($s);
+		DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
 	}
 	
 	$user->put();
diff --git a/cmd/set/sys_qra.pl b/cmd/set/sys_qra.pl
index 0deb1b20..43260d1c 100644
--- a/cmd/set/sys_qra.pl
+++ b/cmd/set/sys_qra.pl
@@ -8,31 +8,4 @@
 
 my ($self, $line) = @_;
 return (1, $self->msg('e5')) if $self->priv < 9;
-
-my $call = $main::mycall;
-my $user;
-
-# remove leading and trailing spaces
-$line =~ s/^\s+//;
-$line =~ s/\s+$//;
-
-return (1, $self->msg('qrae1')) if !$line;
-return (1, $self->msg('qrae2', $line)) unless DXBearing::is_qra($line);
-
-$user = DXUser->get_current($call);
-if ($user) {
-	$line = uc $line;
-	$user->qra($line);
-	if (!$user->lat && !$user->long) {
-		my ($lat, $long) = DXBearing::qratoll($line);
-		$user->lat($lat);
-		$user->long($long);
-		my $s = DXBearing::lltos($lat, $long);
-		DXProt::broadcast_all_ak1a(DXProt::pc41($call, 3, $s), $DXProt::me);
-	}
-	
-	$user->put();
-	return (1, $self->msg('sqra', $line));
-} else {
-	return (1, $self->msg('namee2', $call));
-}
+return (1, run_cmd("set/qra $main::mycall"));
diff --git a/cmd/show/qra.pl b/cmd/show/qra.pl
index 48bd249f..bea55047 100644
--- a/cmd/show/qra.pl
+++ b/cmd/show/qra.pl
@@ -16,8 +16,7 @@ my @out;
 $line = uc $line;
 
 # convert a lat/long into a qra locator if we see a pattern looking like a lat/long
-if ($line =~ /^\d+\s+\d+\s*[NS]\s+\d+\s+\d+\s*[EW]/) {
-	$line =~ s/(\d)([NSEW])/$1 $2/g;
+if (is_latlong($line)) {
 	my ($llat, $llong) = DXBearing::stoll(uc $line);
 	return (1, "QRA $line = " . DXBearing::lltoqra($llat, $llong)); 
 }
@@ -37,13 +36,13 @@ unshift @list, DXBearing::lltoqra($lat, $long) unless @list > 1;
 # check from qra
 my $f = uc $list[0];
 $f .= 'MM' if $f =~ /^[A-Z][A-Z]\d\d$/;
-return (1, $self->msg('qrae2', $f)) unless DXBearing::is_qra($f);
+return (1, $self->msg('qrae2', $f)) unless is_qra($f);
 ($lat, $long) = DXBearing::qratoll($f);
 
 # check to qra
 my $l = uc $list[1];
 $l .= 'MM' if $l =~ /^[A-Z][A-Z]\d\d$/;
-return (1, $self->msg('qrae2', $l)) unless DXBearing::is_qra($l);
+return (1, $self->msg('qrae2', $l)) unless is_qra($l);
 my ($qlat, $qlong) = DXBearing::qratoll($l);
 
 # generate alpha lat/long
diff --git a/cmd/show/station.pl b/cmd/show/station.pl
index b5b0f6c5..a79e93a8 100644
--- a/cmd/show/station.pl
+++ b/cmd/show/station.pl
@@ -11,9 +11,10 @@ my @f = split /\s+/, uc $line;
 my @out;
 my $call;
 my $seek;
+push @f, $self->call unless @f;
 
-if (@f == 0) {
-	return (1, $self->msg('e6')) if ($self->priv < 5); 
+if (@f == 1 && uc $f[0] eq 'ALL') {
+	return (1, $self->msg('e6')) if ($self->priv < 6); 
 	my @calls = DXUser::get_all_calls();
 	foreach $call (@calls) {
 		my $ref = DXUser->get_current($call);
diff --git a/perl/DXBearing.pm b/perl/DXBearing.pm
index a2eaeba5..acf90fa3 100644
--- a/perl/DXBearing.pm
+++ b/perl/DXBearing.pm
@@ -78,13 +78,6 @@ sub dr
 	return ($n / 180) * $pi;
 }
 
-# does it look like a qra locator?
-sub is_qra
-{
-	my $qra = shift;
-	return $qra =~ /^[A-Za-z][A-Za-z]\d\d[A-Za-z][A-Za-z]$/o;
-}
-
 # calc bearing and distance, with arguments in DEGREES
 # home lat/long -> lat/long
 # returns bearing (in DEGREES) & distance in KM
@@ -111,7 +104,7 @@ sub bdist
 # turn a lat long string into floating point lat and long
 sub stoll
 {
-	my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, shift;
+	my ($latd, $latm, $latl, $longd, $longm, $longl) = $_[0] =~ /(\d{1,2})\s+(\d{1,2})\s*([NnSs])\s+(\d{1,2})\s+(\d{1,2})\s*([EeWw])/;
 	
 	$longd += ($longm/60);
 	$longd = 0-$longd if (uc $longl) eq 'W'; 
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ae5bae04..e41951da 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -406,7 +406,7 @@ sub normal
 			my $user = DXUser->get_current($spot[4]);
 			if ($user) {
 				my $qra = $user->qra;
-				unless ($qra && DXBearing::is_qra($qra)) {
+				unless ($qra && is_qra($qra)) {
 					my $lat = $user->lat;
 					my $long = $user->long;
 					if (defined $lat && defined $long) {
@@ -884,8 +884,8 @@ sub normal
 			my $call = $field[1];
 
 			# input filter if required
-			my $ref = Route::get($call) || Route->new($call);
-			return unless $self->in_filter_route($ref);
+#			my $ref = Route::get($call) || Route->new($call);
+#			return unless $self->in_filter_route($ref);
 
 			# add this station to the user database, if required
 			my $user = DXUser->get_current($call);
@@ -896,12 +896,27 @@ sub normal
 			} elsif ($field[2] == 2) {
 				$user->qth($field[3]);
 			} elsif ($field[2] == 3) {
-				my ($lat, $long) = DXBearing::stoll($field[3]);
-				$user->lat($lat);
-				$user->long($long);
-				$user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra && DXBearing::is_qra($user->qra);
+				if (is_latlong($field[3])) {
+					my ($lat, $long) = DXBearing::stoll($field[3]);
+					$user->lat($lat);
+					$user->long($long);
+					$user->qra(DXBearing::lltoqra($lat, $long));
+				} else {
+					dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
+					return;
+				}
 			} elsif ($field[2] == 4) {
 				$user->homenode($field[3]);
+			} elsif ($field[2] == 5) {
+				if (is_qra($field[3])) {
+					my ($lat, $long) = DXBearing::qratoll($field[3]);
+					$user->lat($lat);
+					$user->long($long);
+					$user->qra($field[3]);
+				} else {
+					dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
+					return;
+				}
 			}
 			$user->lastoper($main::systime);   # to cut down on excessive for/opers being generated
 			$user->put;
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index b635e981..56e36d42 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -16,8 +16,8 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf 
 			 parray parraypairs phex shellregex readfilestr writefilestr
-             print_all_fields cltounix unpad is_callsign
-			 is_freq is_digits is_pctext is_pcflag insertitem deleteitem
+             print_all_fields cltounix unpad is_callsign is_latlong
+			 is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
             );
 
 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@@ -312,7 +312,7 @@ sub unpad
 # check that a field only has callsign characters in it
 sub is_callsign
 {
-	return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z0-9\/\-]+$/;
+	return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]+(?:-\d{1,2}|\/[A-Z0-9]+)?$/;
 }
 
 # check that a PC protocol field is valid text
@@ -339,6 +339,18 @@ sub is_digits
 	return $_[0] =~ /^[\d]+$/;
 }
 
+# does it look like a qra locator?
+sub is_qra
+{
+	return $_[0] =~ /^[A-Za-z][A-Za-z]\d\d[A-Za-z][A-Za-z]$/o;
+}
+
+# does it look like a valid lat/long
+sub is_latlong
+{
+	return $_[0] =~ /^\s*\d{1,2}\s+\d{1,2}\s*[NnSs]\s+\d{1,2}\s+\d{1,2}\s*[EeWw]\s*$/;
+}
+
 # insert an item into a list if it isn't already there returns 1 if there 0 if not
 sub insertitem
 {
diff --git a/perl/watchdbg b/perl/watchdbg
index 720904bf..92765ab4 100755
--- a/perl/watchdbg
+++ b/perl/watchdbg
@@ -33,7 +33,8 @@ my $fp = DXLog::new('debug', 'dat', 'd');
 my @today = Julian::unixtoj(time()); 
 my $fh = $fp->open(@today) or die $!; 
 my $nolines = 1;
-$nolines = shift if $ARGV[0] =~ /^\d+$/;
+$nolines = shift if $ARGV[0] =~ /^-?\d+$/;
+$nolines = abs $nolines if $nolines < 0;  
 my $exp = join '|', @ARGV;
 my @prev;