]> dxcluster.org Git - spider.git/commitdiff
1. Incorporated sh/st, (un)set/lockout, forward/opername from Iain G0RDI R_1_10
authordjk <djk>
Sun, 13 Dec 1998 00:47:32 +0000 (00:47 +0000)
committerdjk <djk>
Sun, 13 Dec 1998 00:47:32 +0000 (00:47 +0000)
2. Added group handling with (un)set/group, show/group. This allows arbitrary
groups to be formed (for ann/<group> for example) and is also used to 'filter'
spots, announces, wwvs etc into groups of cluster nodes (useful for creating
disjoint cluster networks)
3. **** CHANGE mylongtitude to mylongitude in DXVars.pm ****
4. Altered QRA locator routines so they work correctly!
5. Fixed all commands that had the wrong mylat(itude) and mylong(itude) names
in.

18 files changed:
Changes
cmd/forward/opername.pl [new file with mode: 0644]
cmd/reply.pl
cmd/set/lockout.pl [new file with mode: 0644]
cmd/show/heading.pl
cmd/show/qra.pl
cmd/show/station.pl
cmd/unset/lockout.pl [new file with mode: 0644]
perl/DXBearing.pm
perl/DXChannel.pm
perl/DXCluster.pm
perl/DXCommandmode.pm
perl/DXProt.pm
perl/DXUser.pm
perl/DXUtil.pm
perl/DXVars.pm
perl/Messages
perl/cluster.pl

diff --git a/Changes b/Changes
index 8b155a089358b9eb19ca90511425a6fe9c7a21e5..19c7570fc8efa0936981aaa3f4b7a981cdd1e294 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,13 @@
+12Dec98========================================================================
+1. Incorporated sh/st, (un)set/lockout, forward/opername from Iain G0RDI
+2. Added group handling with (un)set/group, show/group. This allows arbitrary
+groups to be formed (for ann/<group> for example) and is also used to 'filter' 
+spots, announces, wwvs etc into groups of cluster nodes (useful for creating 
+disjoint cluster networks)
+3. **** CHANGE mylongtitude to mylongitude in DXVars.pm ****
+4. Altered QRA locator routines so they work correctly!
+5. Fixed all commands that had the wrong mylat(itude) and mylong(itude) names
+in.
 07Dec98========================================================================
 1. Added set/name, set/qra, set/location, set/qth, set/homenode, set/bbs, 
 set/email
diff --git a/cmd/forward/opername.pl b/cmd/forward/opername.pl
new file mode 100644 (file)
index 0000000..c8db656
--- /dev/null
@@ -0,0 +1,33 @@
+#
+# Cause node to send PC41 info frames
+#
+# Copyright (c) 1998 - Iain Philipps G0RDI
+#
+# Mods by Dirk Koopman G1TLH 12Dec98
+#
+
+my ($self, $line) = @_;
+my @f = split /\s+/, uc $line;
+my @out;
+my $call;
+
+if (@f == 0) {
+       return (1, $self->('e6')) if ($self->priv < 5); 
+} else {
+       foreach $call (@f) {
+               my $ref = DXUser->get_current($call);
+               if ($ref) {
+                       my $name = $ref->name;  
+                       my $qth = $ref->qth;
+                       my $lat = $ref->lat;
+                       my $long = $ref->long;
+                       my $node = $ref->homenode;
+                       my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
+                       DXProt::broadcast_ak1a(DXProt::pc41($call, 1, $name), $DXProt::me) if $name;
+                       DXProt::broadcast_ak1a(DXProt::pc41($call, 2, $qth), $DXProt::me) if $qth;
+                       DXProt::broadcast_ak1a(DXProt::pc41($call, 3, $latlong), $DXProt::me) if $latlong;
+                       DXProt::broadcast_ak1a(DXProt::pc41($call, 4, $node), $DXProt::me) if $node;
+               }
+       }
+}
+return (1, @out);
index ce9d6916259055df7a8312e89e27cc20c4a16bd3..c5ceaddf9a26c08bd746ff44f4428ebfe42fe54f 100644 (file)
@@ -23,60 +23,64 @@ my $loc;
 #$DB::single = 1;
 
 if ($self->state eq "prompt") {
-
-  my @f = split /\s+/, $line;
-  
-  # now deal with real message inputs 
-  # parse out send line for various possibilities
-  $loc = $self->{loc} = {};
-  
-  my $i = 0;
-  $f[0] = uc $f[0];
-  $loc->{private} = '1';
-  if ($f[0] eq 'B' || $f[0] =~ /^NOP/oi) {
-    $loc->{private} = '0';
-       $i += 1;
-  } elsif ($f[0] eq 'P' || $f[0] =~ /^PRI/oi) {
-    $i += 1;
-  }
-  
-  $loc->{rrreq} = '0';
-  if (uc $f[$i] eq 'RR') {
-    $loc->{rrreq} = '1';
-       $i++;
-  }
-  
-  my $oref; 
-  
-  # check we have a reply number
-  if ($i  >  @f) {
-    if (!($oref = DXMsg::get($self->lastread))) {
-      delete $self->{loc};
-      #return (0, $self->msg('esend2'));
-      return (0, "need a message number");
+       
+       my @f = split /\s+/, $line if $line;
+       
+       # now deal with real message inputs 
+       # parse out send line for various possibilities
+       $loc = $self->{loc} = {};
+       
+       my $i = 0;
+       $loc->{private} = '1';
+       if ($i < @f) {
+               if ($f[0] =~ /^(B|NOP)/oi) {
+                       $loc->{private} = '0';
+                       $i += 1;
+               } elsif ($f[0] =~ /^P/oi) {
+                       $i += 1;
+               }
        }
-  } else {
-    $oref = DXMsg::get($f[$i]);
-       if (!$oref) {
-         delete $self->{loc};
-         return (0, "can't access message $i");
+       
+       if ($i < @f) {
+               $loc->{rrreq} = '0';
+               if (uc $f[$i] eq 'RR') {
+                       $loc->{rrreq} = '1';
+                       $i++;
+               }
        }
-  }
-  
-  # now save all the 'to' callsigns for later
-  my $to = $oref->from;
-  $loc->{to} = [ $to ];       # to is an array
-  $loc->{subject} = $oref->subject;
-  $loc->{subject} = "Re: " . $loc->{subject} if !($loc->{subject} =~ /^Re:.\s/io); 
-
-  # find me and set the state and the function on my state variable to
-  # keep calling me for every line until I relinquish control
-  $self->func("DXMsg::do_send_stuff");
-  $self->state('sendbody');
-  #push @out, $self->msg('sendsubj');
-  push @out, "Reply to: $to";
-  push @out, "Subject : $loc->{subject}";
-  push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit";
+       my $oref; 
+       
+       # check we have a reply number
+       #  $DB::single = 1;
+       
+       if ($i < @f) {
+               $oref = DXMsg::get($f[$i]);
+               if (!$oref) {
+                       delete $self->{loc};
+                       return (0, "can't access message $i");
+               }
+       } else {
+               if (!($oref = DXMsg::get($self->lastread))) {
+                       delete $self->{loc};
+                       #return (0, $self->msg('esend2'));
+                       return (0, "need a message number");
+               }
+       }
+       
+       # now save all the 'to' callsigns for later
+       my $to = $oref->from;
+       $loc->{to} = [ $to ];       # to is an array
+       $loc->{subject} = $oref->subject;
+       $loc->{subject} = "Re: " . $loc->{subject} if !($loc->{subject} =~ /^Re:\s/io); 
+       
+       # find me and set the state and the function on my state variable to
+       # keep calling me for every line until I relinquish control
+       $self->func("DXMsg::do_send_stuff");
+       $self->state('sendbody');
+       #push @out, $self->msg('sendsubj');
+       push @out, "Reply to: $to";
+       push @out, "Subject : $loc->{subject}";
+       push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit";
 }
 
 return (1, @out);
diff --git a/cmd/set/lockout.pl b/cmd/set/lockout.pl
new file mode 100644 (file)
index 0000000..a1e83c3
--- /dev/null
@@ -0,0 +1,28 @@
+#
+# lock a user out
+#
+# Copyright (c) 1998 Iain Phillips G0RDI
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+# my $priv = shift @args;
+my @out;
+my $user;
+my $ref;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+       $call = uc $call;
+       if ($ref = DXUser->get_current($call)) {
+               $ref->lockout(1);
+               $ref->put();
+               push @out, $self->msg("lockout", $call);
+       } else {
+               push @out, $self->msg('e3', 'set/lockout', $call);
+       }
+}
+return (1, @out);
index b7dd05c935aea474b665e89794784fdcffbd97c8..aa7bb2f83e8bfdaa3e602958070dd0df2be6f961 100644 (file)
@@ -13,8 +13,8 @@ my $lat = $self->user->lat;
 my $long = $self->user->long;
 if (!$long && !$lat) {
        push @out, $self->msg('heade1');
-       $lat = $main::mylat;
-       $long = $main::mylong;
+       $lat = $main::mylatitude;
+       $long = $main::mylongitude;
 }
 
 foreach $l (@list) {
index 8e91cf5fcda534a3c6855aac2eb326ea442f05f3..fe3f08abc59d555918a2dcf826816bb17aa9ac95 100644 (file)
@@ -1,5 +1,7 @@
 #
-# show the distance and bearing each QRA locator
+# show the distance and bearing to a  QRA locator
+#
+# you can enter two qra locators and it will calc the distance between them
 #
 # $Id$
 #
@@ -13,21 +15,37 @@ my $lat = $self->user->lat;
 my $long = $self->user->long;
 if (!$long && !$lat) {
        push @out, $self->msg('heade1');
-       $lat = $main::mylat;
-       $long = $main::mylong;
+       $lat = $main::mylatitude;
+       $long = $main::mylongitude;
 }
 
-foreach $l (@list) {
-       # locators --->
-       if (DXBearing::is_qra($l) || $l =~ /^[A-Za-z][A-Za-z]\d\d$/) {
-               my $qra = uc $l;
-               $qra .= 'MM' if $l =~ /^[A-Za-z][A-Za-z]\d\d$/;
-               
-               my ($qlat, $qlong) = DXBearing::qratoll($qra);
-               my ($b, $dx) = DXBearing::bdist($lat, $long, $qlat, $qlong);
-               my ($r, $rdx) = DXBearing::bdist($qlat, $qlong, $lat, $long);
-               push @out, sprintf "%-9s Bearing: %.0f Recip: %.0f %.0fKm %.0fMi", $qra, $b, $r, $dx, $dx * 0.62133785;
-       }
+return (1, $self->msg('qrashe1')) unless @list > 0;
+return (1, $self->msg('qrae2')) unless (DXBearing::is_qra($list[0]) || $list[0] =~ /^[A-Za-z][A-Za-z]\d\d$/);
+
+#print "$lat $long\n";
+
+my $l = uc $list[0];
+my $f;
+
+if (@list > 1) {
+       $f = $l;
+       $f .= 'MM' if $f =~ /^[A-Z][A-Z]\d\d$/;
+       ($lat, $long) = DXBearing::qratoll($f);
+    #print "$lat $long\n";
+       
+       return (1, $self->msg('qrae2')) unless (DXBearing::is_qra($list[1]) || $list[1] =~ /^[A-Za-z][A-Za-z]\d\d$/);
+       $l = uc $list[1];
 }
 
+$l .= 'MM' if $l =~ /^[A-Z][A-Z]\d\d$/;
+               
+my ($qlat, $qlong) = DXBearing::qratoll($l);
+#print "$qlat $qlong\n";
+my ($b, $dx) = DXBearing::bdist($lat, $long, $qlat, $qlong);
+my ($r, $rdx) = DXBearing::bdist($qlat, $qlong, $lat, $long);
+my $to = " -> $list[1]" if $f;
+my $from = $list[0];
+
+push @out, sprintf "$list[0]$to Bearing: %.0f Deg. Recip: %.0f Deg. %.0fMi. %.0fKm.", $b, $r, $dx * 0.62133785, $dx;
+
 return (1, @out);
index 0f2140337ec95939b9f64308004da491d127ec84..d3a70865911d65ddfcc2b00e6cdcc77b5ade8d0b 100644 (file)
@@ -3,40 +3,73 @@
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
-# $Id$
+# Modifications by Iain Philipps G0RDI, 07-Dec-1998
 #
 
 my ($self, $line) = @_;
 my @f = split /\s+/, uc $line;
 my @out;
 my $call;
+my $seek;
 
 if (@f == 0) {
-  return (1, "*** no station specified ***") if ($self->priv < 5); 
-  my @calls = DXUser::get_all_calls();
-  foreach $call (@calls) {
-    my $ref = DXUser->get_current($call);
-       next if !$ref;
-       my $sort = $ref->sort;
-       my $qth = $ref->qth;
-       my $home = $ref->node;
-    push @out, "$call $sort $qth $home";
-  }
+       return (1, $self->msg('e6')) if ($self->priv < 5); 
+       my @calls = DXUser::get_all_calls();
+       foreach $call (@calls) {
+               my $ref = DXUser->get_current($call);
+               next if !$ref;
+               my $lat = $ref->lat;
+               my $long = $ref->long;
+               my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
+               push @out, sprintf "%-9s %s %-12.12s %-27.27s %-9s %s %s", $call, $ref->sort, $ref->name, $ref->qth, $ref->homenode, $latlong, $ref->qra;
+       }
 } else {
-  foreach $call (@f) {
-    my $ref = DXUser->get_current($call);
-       if ($ref) {
-         my $name = $ref->name;  
-      my $qth = $ref->qth;
-         my $lat = $ref->lat;
-         my $long = $ref->long;
-         my $node = $ref->node;
-#        my $homenode = $ref->homenode;
-         push @out, "$call $qth $lat $long $node";
-       } else {
-         push @out, "$call not known";
+       foreach $call (@f) {
+               my $ref = DXUser->get_current($call);
+               if ($ref) {
+                       my $name = $ref->name;  
+                       my $qth = $ref->qth;
+                       my $lat = $ref->lat;
+                       my $long = $ref->long;
+                       my $node = $ref->node;
+                       my $homenode = $ref->homenode;
+                       my $lastin = $ref->lastin;
+                       my $latlong = DXBearing::lltos($lat, $long) if $lat || $long;
+                       my $last = DXUtil::cldatetime($lastin) if $ref->lastin;
+                       my $qra = $ref->qra;
+                       $qra = DXBearing::lltoqra($lat, $long) if !$qra && ($lat || $long);
+                       my $from;
+                       my ($dx, $bearing, $miles);
+                       if ($latlong) {
+                               my ($hlat, $hlong) = ($self->user->lat, $self->user->long);
+                               ($hlat, $hlong) = DXBearing::qratoll($self->user->qra) if $self->user->qra && !$hlat && !$hlong;
+                               if (!$hlat && !$hlong) {
+                                       $from = "From $main::mycall";
+                                       $hlat = $main::mylatitude;
+                                       $hlong = $main::mylongitude;
+                               }
+                               ($bearing, $dx) = DXBearing::bdist($hlat, $hlong, $lat, $long);
+                               $miles = $dx * 0.62133785;
+                       }
+                       
+                       my $cref = DXCluster->get($call);
+                       my $seek = $cref->mynode->call if $cref;
+
+                       if ($seek) {
+                               push @out, "User         :   $call (at $seek)";
+                       } else {
+                               push @out, "User         :   $call";
+                       }
+                       push @out, "Name         :   $name" if $name;
+                       push @out, "Last Connect :   $last" if $last;
+                       push @out, "QTH          :   $qth" if $qth;
+                       push @out, "Location     :   $latlong ($qra)" if $latlong || $qra ;
+                       push @out, sprintf("Heading      :   %.0f Deg %.0f Mi. %.0f Km. $from", $bearing, $miles, $dx) if $latlong;
+                       push @out, "Home Node    :   $homenode" if $homenode;
+               } else {
+                       push @out, $self->msg('usernf', $call);
+               }
        }
-  }
 }
 
 return (1, @out);
diff --git a/cmd/unset/lockout.pl b/cmd/unset/lockout.pl
new file mode 100644 (file)
index 0000000..71641c6
--- /dev/null
@@ -0,0 +1,28 @@
+#
+# unlock a locked out user 
+#
+# Copyright (c) 1998 Iain Phillips G0RDI
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+# my $priv = shift @args;
+my @out;
+my $user;
+my $ref;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+       $call = uc $call;
+       if ($ref = DXUser->get_current($call)) {
+               $ref->lockout(0);
+               $ref->put();
+               push @out, $self->msg("lockoutun", $call);
+       } else {
+               push @out, $self->msg('e3', 'unset/lockout', $call);
+       }
+}
+return (1, @out);
index 4c8c3eea2a9ce22abbd89b96536dcd4c68bf8c3e..a2eaeba59f9828b8babbda95fb44475d94a36f43 100644 (file)
 package DXBearing;
 
 use POSIX;
+use DXUtil;
 
 use strict;
 use vars qw($pi);
 
 $pi = 3.14159265358979;
 
-# half a qra to lat long translation
-sub _half_qratoll
-{
-       my ($l, $n, $m) = @_;
-       my $lat = ord($l) - ord('A');
-       $lat = $lat * 10 + (ord($n) - ord('0'));
-       $lat = $lat * 24 + (ord($m) - ord('A'));
-       $lat -= (2160 + 0.5);
-       $lat = $lat * ($pi/4320);
-       
-} 
 # convert a qra locator into lat/long in DEGREES
 sub qratoll
 {
        my $qra = uc shift;
-       my $long = _half_qratoll((unpack 'AAAAAA', $qra)[0,2,4]) * 2;
-       my $lat = _half_qratoll((unpack 'AAAAAA', $qra)[1,3,5]);
-       return (rd($lat), rd($long));
-}
-
-sub _part_lltoqra
-{
-       my ($t, $f, $n, $e) = @_;
-       $n = $f * ($n - int($n));
-       $e = $f * ($e - int($e));
-       my $q = chr($t+$e) . chr($t+$n);
-       return ($q, $n, $e);
+       my ($p1, $p2, $p3, $p4, $p5, $p6) = unpack 'AAAAAA', $qra;
+       ($p1, $p2, $p3, $p4, $p5, $p6) = (ord($p1)-ord('A'), ord($p2)-ord('A'), ord($p3)-ord('0'), ord($p4)-ord('0'), ord($p5)-ord('A'), ord($p6)-ord('A') );
+       
+       my $long = ($p1*20) + ($p3*2) + (($p5+0.5)/12) - 180;
+    my $lat = ($p2*10) + $p4 + (($p6+0.5)/24) - 90;
+       return ($lat, $long);
 }
 
 # convert a lat, long in DEGREES to a qra locator 
 sub lltoqra
 {
-       my $lat = dr(shift);
-       my $long = dr(shift);
-       my $t = 1/6.283185;
+       my $lat = shift;
+       my $long = shift;
 
-       $long = $long * $t +.5 ;
-       $lat = $lat * $t * 2 + .5 ;
+       my $v;
+       my ($p1, $p2, $p3, $p4, $p5, $p6);
+       
+       $lat += 90;
+       $long += 180;
+       $v = int($long / 20); 
+       $long -= ($v * 20);
+       $p1 = chr(ord('A') + $v);
+       $v = int($lat / 10);                       
+       $lat -= ($v * 10);
+       $p2 = chr(ord('A') + $v);
+       $p3 = int($long/2);
+       $p4 = int($lat);
+       $long -= $p3*2;
+       $lat -= $p4;
+       $p3 = chr(ord('0')+$p3);
+       $p4 = chr(ord('0')+$p4);
+       $p5 = int((12 * $long) );
+       $p6 = int((24 * $lat) );
+       $p5 = chr(ord('A')+$p5);
+       $p6 = chr(ord('A')+$p6);
 
-       my $q;
-       my $qq;
-       ($q, $lat, $long) = _part_lltoqra(ord('A'), 18, $lat, $long);
-       $qq = $q;
-       ($q, $lat, $long) = _part_lltoqra(ord('0'), 10, $lat, $long);
-       $qq .= $q;
-       ($q, $lat, $long) = _part_lltoqra(ord('A'), 24, $lat, $long);
-       $qq .= $q;
-       return $qq;
+       return "$p1$p2$p3$p4$p5$p6";
 }
 
 # radians to degrees
@@ -100,6 +94,7 @@ sub bdist
        my $he = dr(shift);
        my $n = dr(shift);
        my $e = dr(shift);
+       return (0, 0) if $hn == $n && $he == $e;
        my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
        my $ca = atan(abs(sqrt(1-$co*$co)/$co));
        $ca = $pi-$ca if $co < 0;
@@ -129,19 +124,8 @@ sub stoll
 sub lltos
 {
        my ($lat, $long) = @_;
-       my ($latd, $latm, $longd, $longm);
-       my $latl = $lat > 0 ? 'N' : 'S';
-       my $longl = $long > 0 ? 'E' : 'W';
-       
-       $lat = abs $lat;
-       $latd = int $lat;
-       $lat -= $latd;
-       $latm = int (60 * $lat);
-       
-       $long = abs $long;
-       $longd = int $long;
-       $long -= $longd;
-       $longm = int (60 * $long);
-       return "$latd $latm $latl $longd $longm $longl";
+       my $slat = slat($lat);
+       my $slong = slong($long);
+       return "$slat $slong";
 }
 1;
index 692bf98bf29150cebcaeff9c14cd5ba3c8356908..640bc4e5345bbf1800a4ee4590cac543666bc462 100644 (file)
@@ -66,6 +66,7 @@ use vars qw(%channels %valid);
   remotecmd => '9,doing rcmd,yesno',
   pagelth => '0,Page Length',
   pagedata => '9,Page Data Store',
+  group => '0,Access Group,parray',               # used to create a group of users/nodes for some purpose or other
 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
@@ -83,6 +84,8 @@ sub alloc
   $self->{oldstate} = 0;
   $self->{lang} = $user->{lang} if defined $user;
   $self->{lang} = $main::lang if !$self->{lang};
+  $user->new_group() if !$user->group;
+  $self->{group} = $user->group;
   bless $self, $pkg; 
   return $channels{$call} = $self;
 }
@@ -117,6 +120,7 @@ sub get_by_cnum
 sub del
 {
   my $self = shift;
+  $self->{group} = undef;      # belt and braces
   delete $channels{$self->{call}};
 }
 
index 09001b2070c10a613aa5c68886457b9def4c6a86..0eb98a4bbbe46575c2e5ae76cb1a3971030dc918 100644 (file)
@@ -224,6 +224,7 @@ sub new
   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
   $self->{pcversion} = $pcversion;
   $self->{list} = { } ;
+  $self->{mynode} = $self;   # for sh/station
   $nodes++;
   dbg('cluster', "allocating node $call to cluster\n");
   return $self;
index a6e5e2f7d18bce1123844ed5aff208f280f6ca1b..91d268b0fc33398f9a4721c2f85daf131c15c6eb 100644 (file)
@@ -86,7 +86,7 @@ sub start
        $self->send($self->msg('qthe1')) if !$user->qth;
        $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
        $self->send($self->msg('hnodee1')) if !$user->qth;
-       
+
        
        $self->send($self->msg('pr', $call));
 }
index 35aae2e5ed6a4b6114c7aa7c10eeefca2e57501d..4fce82985ecb0a57c656f63ccf6c9b86e7adb757 100644 (file)
@@ -80,6 +80,7 @@ sub start
        }
        $self->state('init');
        $self->pc50_t(time);
+
        Log('DXProt', "$call connected");
 }
 
@@ -219,6 +220,7 @@ sub normal
                                my $user = DXUser->get_current($call);
                                $user = DXUser->new($call) if !$user;
                                $user->node($node->call);
+                               $user->lastin($main::systime);
                                $user->homenode($node->call) if !$user->homenode;
                                $user->put;
                        }
@@ -269,6 +271,7 @@ sub normal
                                        $user->sort('A');
                                        $user->node($call);
                                        $user->homenode($call);
+                                       $user->lastin($main::systime);
                                        $user->put;
                                }
                        }
@@ -528,6 +531,7 @@ sub finish
        
        # now broadcast to all other ak1a nodes that I have gone
        broadcast_ak1a(pc21($call, 'Gone.'), $self);
+       
        Log('DXProt', $call . " Disconnected");
        $ref->del() if $ref;
 }
index 0af77f04df235d0da9e136dc5e7df3eb4f8856fa..65948d59913ebf2e38251e6b2f06b18bad372ffe 100644 (file)
@@ -47,6 +47,7 @@ $filename = undef;
   reg => '0,Registered?,yesno',            # is this user registered?
   lang => '0,Language',
   hmsgno => '0,Highest Msgno',
+  group => '0,Access Group,parray',               # used to create a group of users/nodes for some purpose or other
 );
 
 no strict;
@@ -195,6 +196,67 @@ sub fields
   return keys(%valid);
 }
 
+#
+# group handling
+#
+
+# add one or more groups
+sub add_group
+{
+       my $self = shift;
+       my $ref = $self->{group} || [ 'local' ];
+       $self->{group} = $ref if !$self->{group};
+       push @$ref, @_ if @_;
+}
+
+# remove one or more groups
+sub del_group
+{
+       my $self = shift;
+       my $ref = $self->{group} || [ 'local' ];
+       my @in = @_;
+       
+       $self->{group} = $ref if !$self->{group};
+       
+       @$ref = map { my $a = $_; return (grep { $_ eq $a } @in) ? () : $a } @$ref;
+}
+
+# does this thing contain all the groups listed?
+sub union
+{
+       my $self = shift;
+       my $ref = $self->{group};
+       my $n;
+       
+       return 0 if !$ref || @_ == 0;
+       return 1 if @$ref == 0 && @_ == 0;
+       for ($n = 0; $n < @_; ) {
+               for (@$ref) {
+                       my $a = $_;
+                       $n++ if grep $_ eq $a, @_; 
+               }
+       }
+       return $n >= @_;
+}
+
+# simplified group test just for one group
+sub in_group
+{
+       my $self = shift;
+       my $s = shift;
+       my $ref = $self->{group};
+       
+       return 0 if !$ref;
+       return grep $_ eq $s, $ref;
+}
+
+# set up a default group (only happens for them's that connect direct)
+sub new_group
+{
+       my $self = shift;
+       $self->{group} = [ 'local' ];
+}
+
 #
 # return a prompt for a field
 #
@@ -205,40 +267,6 @@ sub field_prompt
   return $valid{$ele};
 }
 
-#
-# enter an element from input, returns 1 for success
-#
-
-sub enter
-{
-  my ($self, $ele, $value) = @_;
-  return 0 if (!defined $valid{$ele});
-  chomp $value;
-  return 0 if $value eq "";
-  if ($ele eq 'long') {
-    my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
-       return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
-       $longd += ($longm/60);
-       $longd = 0-$longd if (uc $longl) eq 'W'; 
-       $self->{'long'} = $longd;
-       return 1;
-  } elsif ($ele eq 'lat') {
-    my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
-       return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
-       $latd += ($latm/60);
-       $latd = 0-$latd if (uc $latl) eq 'S';
-       $self->{'lat'} = $latd;
-       return 1;
-  } elsif ($ele eq 'qra') {
-    $self->{'qra'} = UC $value;
-       return 1;
-  } else {
-    $self->{$ele} = $value;               # default action
-       return 1;
-  }
-  return 0;
-}
-
 # some variable accessors
 sub sort
 {
index 667194afb52ceeaf35010e3e9100f8b2bca005f8..9f63c8908234eea858730c314d99493d1d69364a 100644 (file)
@@ -77,7 +77,7 @@ sub slat
   $let = $n >= 0 ? 'N' : 'S';
   $n = abs $n;
   $deg = int $n;
-  $min = int (($n - $deg) * 60);
+  $min = int ((($n - $deg) * 60) + 0.5);
   return "$deg $min $let";
 }
 
@@ -89,7 +89,7 @@ sub slong
   $let = $n >= 0 ? 'E' : 'W';
   $n = abs $n;
   $deg = int $n;
-  $min = int (($n - $deg) * 60);
+  $min = int ((($n - $deg) * 60) + 0.5);
   return "$deg $min $let";
 }
 
@@ -118,7 +118,8 @@ sub promptf
 # take an arg as an array list and print it
 sub parray
 {
-  return join(', ', @{shift});
+       my $ref = shift;
+       return join(', ', @{$ref});
 }
 
 # take the arg as an array reference and print as a list of pairs
index b35689bcbda100f9f21460debf19f42f963bc611..91f4370727fd504f3e7dea55b82a2bf9c24ed00b 100644 (file)
@@ -35,7 +35,7 @@ $myalias = "G1TLH";
 $mylatitude = +52.68584579;
 
 # Your Longtitude (+)ve = East, (-)ve = West in degrees and decimal degrees
-$mylongtitude = +0.94518260;
+$mylongitude = +0.94518260;
 
 # Your locator (yes I know I can calculate it - eventually)
 $mylocator = "JO02LQ";
index 1dee13e387364ec145123add75047f2bf6c9d2d1..16ad509edcd0af3700030e76206ee6cfac161ce9 100644 (file)
@@ -34,7 +34,7 @@ package DXM;
                                e3 => '$_[0]: $_[1] not found',
                                e4 => 'Need at least a prefix or callsign',
                                e5 => 'Not Allowed',
-                               e6 => 'Need a callsign',
+                               e6 => '*** No station specified ***',
                                e7 => 'callsign $_[0] not visible on the cluster',
                                e8 => 'Need a callsign and some text',
                                e9 => 'Need at least some text',
@@ -56,6 +56,8 @@ package DXM;
                                loce1 => 'Please enter your location,, set/location <latitude longitude>',
                                loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)',
                                loc => 'Your Lat/Long is now \"$_[0]\"',
+                               lockout => '$_[0] Locked out',
+                               lockoutun => '$_[0] Unlocked',
                                m2 => '$_[0] Information: $_[1]',
                                namee1 => 'Please enter your name, set/name <your name>',
                                namee2 => 'Can\'t find user $_[0]!',
@@ -74,7 +76,8 @@ package DXM;
                                qll => 'Please enter your location with set/location or set/qra',
                                qthe1 => 'Please enter your QTH, set/qth <your qth>',
                                qth => 'Your QTH is now \"$_[0]\"',
-                               qrae1 => 'Please enter your QRA locator, set/qra <qra locator>',
+                               qrae1 => 'Please enter your QRA locator, set/qra <qra locator> (eg set/qra JO02LQ)',
+                               qrashe1 => 'Please enter a QRA locator, eg sh/qra JO02LQ or sh/qra JO02LQ IO93NS',
                                qrae2 => 'Don\'t recognise \"$_[0]\" as a QRA locator (eg JO02LQ)',
                                qra => 'Your QRA Locator is now \"$_[0]\"',
                                rcmdo => 'RCMD \"$_[0]\" sent to $_[1]',
@@ -84,6 +87,7 @@ package DXM;
                                shutting => '$main::mycall shutting down...',
                                talks => 'Talk flag set on $_[0]',
                                talku => 'Talk flag unset on $_[0]',
+                               usernf => '*** User record for $_[0] not found ***',
                                wwvs => 'WWV flag set on $_[0]',
                                wwvu => 'WWV flag unset on $_[0]',
                },
index 1eb8207806716033fbb16e9014b7e4fa9fd68d21..e343cc0b4175ad56f83be0abc41acc975f54056b 100755 (executable)
@@ -48,7 +48,7 @@ package main;
 
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
-$version = 1.9;                                        # the version no of the software
+$version = "1.10";                             # the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
  
 # handle disconnections
@@ -108,7 +108,13 @@ sub rec
                        $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
                }
                
-               
+               # is he locked out ?
+               if ($user->lockout) {
+                       Log('DXCommand', "$call is locked out, disconnected");
+                       $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
+                       return;
+               }
+
                # create the channel
                $dxchan = DXCommandmode->new($call, $conn, $user) if ($user->sort eq 'U');
                $dxchan = DXProt->new($call, $conn, $user) if ($user->sort eq 'A');