]> dxcluster.org Git - spider.git/commitdiff
1. Sort out PC41 handling to include type 5 records for QRA locators and also
authorminima <minima>
Fri, 17 Aug 2001 15:31:07 +0000 (15:31 +0000)
committerminima <minima>
Fri, 17 Aug 2001 15:31:07 +0000 (15:31 +0000)
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.

12 files changed:
Changes
cmd/Commands_en.hlp
cmd/forward/opername.pl
cmd/set/location.pl
cmd/set/qra.pl
cmd/set/sys_qra.pl
cmd/show/qra.pl
cmd/show/station.pl
perl/DXBearing.pm
perl/DXProt.pm
perl/DXUtil.pm
perl/watchdbg

diff --git a/Changes b/Changes
index 1f6342c3d728349903f1c756127728a329315896..f7826e105a7cf3f2de34804d2a9ed264f4a9424a 100644 (file)
--- 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).
index 9f30cd7f54189d7070fdad43f47fe119361c6e13..2ffdbe068d030d8928ecba1171edfe20cd06baf7 100644 (file)
@@ -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
index a80d0ec9e64329273efde7b434ac5467645cc93b..1daaa1c3291b69cafc2b47cd6f650b787985749e 100644 (file)
@@ -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) ;
+               }
        }
 }
 
index 25db6ba609259c4c3f2f803f4edfe7decd4ca4a4..f4ee0358a496c0654937cc67d5482fb56b841db3 100644 (file)
@@ -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();
index 484666ca953efa3e638fdd077417f459823676b5..60c6dc1603fcad5b40463f86e559e6041e844d03 100644 (file)
@@ -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();
index 0deb1b20c83fc4cdd24eecf861a553610e1c5a43..43260d1cf9ec62dbb64b519ba5340c0db2fa3234 100644 (file)
@@ -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"));
index 48bd249f2e83b61348e5e1ed1f7c6e20f7c9342c..bea5504769ccc8525ccef81a228dba8c435bc54e 100644 (file)
@@ -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
index b5b0f6c5a77986897fceea50a997c10dcab9483b..a79e93a8901572369718f984b370f8b6fb8972cf 100644 (file)
@@ -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);
index a2eaeba59f9828b8babbda95fb44475d94a36f43..acf90fa3323dfee9666dbf1a47f237d67541e99c 100644 (file)
@@ -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'; 
index ae5bae041188bff4859c797a0b789892b69def54..e41951da26b4f932be9b8103bb52e75e21adcfcd 100644 (file)
@@ -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;
index b635e9816360f1dab46605eea7ed0b0d34c1c017..56e36d4220ba05bc43a6bd3195c4efa672a19b81 100644 (file)
@@ -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
 {
index 720904bfca013ec9d54224e26a637cef38bb7d1a..92765ab4132f0ee913e0e32c8b4ae442be8dafc0 100755 (executable)
@@ -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;