From 78cf2dcb9be8128af7f8dc5ae37540c9c53c6057 Mon Sep 17 00:00:00 2001 From: minima Date: Fri, 17 Aug 2001 15:31:07 +0000 Subject: [PATCH] 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. --- Changes | 6 ++++++ cmd/Commands_en.hlp | 9 +++++++++ cmd/forward/opername.pl | 6 ++++++ cmd/set/location.pl | 27 ++++++++++++++++++--------- cmd/set/qra.pl | 26 +++++++++++++++++--------- cmd/set/sys_qra.pl | 29 +---------------------------- cmd/show/qra.pl | 7 +++---- cmd/show/station.pl | 5 +++-- perl/DXBearing.pm | 9 +-------- perl/DXProt.pm | 29 ++++++++++++++++++++++------- perl/DXUtil.pm | 18 +++++++++++++++--- perl/watchdbg | 3 ++- 12 files changed, 103 insertions(+), 71 deletions(-) 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 []^Show list of users in the system +=== 0^SHOW/STATION [ ..]^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 [|]^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; -- 2.34.1