From: djk Date: Mon, 7 Dec 1998 00:59:04 +0000 (+0000) Subject: 1. Added set/name, set/qra, set/location, set/qth, set/homenode, set/bbs, X-Git-Tag: R_1_9~2 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=b4826d1f4125788e14fed3adbb99e66242904e74 1. Added set/name, set/qra, set/location, set/qth, set/homenode, set/bbs, set/email 2. changed the Msg socket close to a shutdown (hopefully more reliable), this should stop clients hanging on exit. 3. Added Alias support for help 4. Added lltos and stoll routines to DXBearing --- diff --git a/Changes b/Changes index 9d1930af..982e9dd6 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +07Dec98======================================================================== +1. Added set/name, set/qra, set/location, set/qth, set/homenode +2. changed the Msg socket close to a shutdown (hopefully more reliable), this +should stop clients hanging on exit. +3. Added Alias support for help 06Dec98======================================================================== 1. Fixed DXBearing::is_qra so that it correctly detects full QRA locators 2. Added sh/qra for doing locator distances and bearings diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 74f73f7a..aee33924 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -167,6 +167,9 @@ You can have multiple qualifiers so that you can have for example:- which should send a copy of message 123 to G1TLH and G0RDI and you will receive a read receipt when they have read the message. + +SB is an alias for SEND NOPRIVATE +SP is an alias for SEND PRIVATE === 0^SHOW/DXCC ^Interrogate the spot database by country This command takes the (which can be a full or partial diff --git a/cmd/help.pl b/cmd/help.pl index c74fad16..6f60c05f 100644 --- a/cmd/help.pl +++ b/cmd/help.pl @@ -43,6 +43,12 @@ my $in; $line =~ s/![\w\/]//og; $line =~ s/\//\.\*\//og; +$line =~ s/^\s+//og; +$line =~ s/\s+$//og; + +# sort out aliases +my $alias = CmdAlias::get_hlp($line); +$line = $alias if $alias; my $include; foreach $in (<$h>) { diff --git a/cmd/set/email.pl b/cmd/set/email.pl index e69de29b..8748df1f 100644 --- a/cmd/set/email.pl +++ b/cmd/set/email.pl @@ -0,0 +1,27 @@ +# +# set the email address of the user +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my $call = $self->call; +my $user; + +# remove leading and trailing spaces +$line =~ s/^\s+//; +$line =~ s/\s+$//; + +return (1, $self->msg('emaile1')) if !$line; + +$user = DXUser->get_current($call); +if ($user) { + $user->email($line); + $user->put(); + return (1, $self->msg('emaila', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} + diff --git a/cmd/set/homebbs.pl b/cmd/set/homebbs.pl index e69de29b..3ab08f25 100644 --- a/cmd/set/homebbs.pl +++ b/cmd/set/homebbs.pl @@ -0,0 +1,28 @@ +# +# set the home mail bbs of the user +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my $call = $self->call; +my $user; + +# remove leading and trailing spaces +$line =~ s/^\s+//; +$line =~ s/\s+$//; + +return (1, $self->msg('bbse1')) if !$line; + +$user = DXUser->get_current($call); +if ($user) { + $line = uc $line; + $user->bbs($line); + $user->put(); + return (1, $self->msg('bbs', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} + diff --git a/cmd/set/homenode.pl b/cmd/set/homenode.pl index 2c7c6c9f..d85c8932 100644 --- a/cmd/set/homenode.pl +++ b/cmd/set/homenode.pl @@ -5,3 +5,25 @@ # # $Id$ # + +my ($self, $line) = @_; +my $call = $self->call; +my $user; + +# remove leading and trailing spaces +$line =~ s/^\s+//; +$line =~ s/\s+$//; + +return (1, $self->msg('hnodee1')) if !$line; + +$user = DXUser->get_current($call); +if ($user) { + $line = uc $line; + $user->homenode($line); + $user->put(); + DXProt::broadcast_ak1a(DXProt::pc41($call, 4, $line), $DXProt::me); + return (1, $self->msg('hnode', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} + diff --git a/cmd/set/location.pl b/cmd/set/location.pl index e69de29b..a1df5ede 100644 --- a/cmd/set/location.pl +++ b/cmd/set/location.pl @@ -0,0 +1,37 @@ +# +# set the latitude and longtitude field +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my $call = $self->call; +my $user; + +# remove leading and trailing spaces +$line =~ s/^\s+//; +$line =~ s/\s+$//; + +return (1, $self->msg('loce1')) if !$line; +return (1, $self->msg('loce2', $line)) unless $line =~ /\d+ \d+ [NnSs] \d+ \d+ [EeWw]/o; + +$user = DXUser->get_current($call); +if ($user) { + $line = uc $line; + $user->qra($line); + my ($lat, $long) = DXBearing::stoll($line); + $user->lat($lat); + $user->long($long); + DXProt::broadcast_ak1a(DXProt::pc41($call, 3, $line), $DXProt::me); + if (!$user->qra) { + my $qra = DXBearing::lltos($lat, $long); + $user->qra($qra); + } + + $user->put(); + return (1, $self->msg('loc', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} diff --git a/cmd/set/name.pl b/cmd/set/name.pl index e69de29b..30b1dc71 100644 --- a/cmd/set/name.pl +++ b/cmd/set/name.pl @@ -0,0 +1,28 @@ +# +# set the name of the user +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my $call = $self->call; +my $user; + +# remove leading and trailing spaces +$line =~ s/^\s+//; +$line =~ s/\s+$//; + +return (1, $self->msg('namee1')) if !$line; + +$user = DXUser->get_current($call); +if ($user) { + $user->name($line); + $user->put(); + DXProt::broadcast_ak1a(DXProt::pc41($call, 1, $line), $DXProt::me); + return (1, $self->msg('name', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} + diff --git a/cmd/set/qra.pl b/cmd/set/qra.pl index 0b13524e..a60415c3 100644 --- a/cmd/set/qra.pl +++ b/cmd/set/qra.pl @@ -1,8 +1,37 @@ # # set the qra locator field # +# Copyright (c) 1998 - Dirk Koopman +# # $Id$ # -my ($self, $args) = @_; -my $user = $self->user; -return (1, "qra locator is now ", $user->qra($args)); + +my ($self, $line) = @_; +my $call = $self->call; +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_ak1a(DXProt::pc41($call, 3, $s), $DXProt::me); + } + + $user->put(); + return (1, $self->msg('qra', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} + diff --git a/cmd/set/qth.pl b/cmd/set/qth.pl index 93407a2a..90d784e1 100644 --- a/cmd/set/qth.pl +++ b/cmd/set/qth.pl @@ -1,8 +1,28 @@ # -# set the qth field +# set the name of the user +# +# Copyright (c) 1998 - Dirk Koopman # # $Id$ # -my ($self, $args) = @_; -my $user = $self->user; -return (1, "qth is now ", $user->qth($args)); + +my ($self, $line) = @_; +my $call = $self->call; +my $user; + +# remove leading and trailing spaces +$line =~ s/^\s+//; +$line =~ s/\s+$//; + +return (1, $self->msg('qthe1')) if !$line; + +$user = DXUser->get_current($call); +if ($user) { + $user->qth($line); + $user->put(); + DXProt::broadcast_ak1a(DXProt::pc41($call, 2, $line), $DXProt::me); + return (1, $self->msg('qth', $line)); +} else { + return (1, $self->msg('namee2', $call)); +} + diff --git a/perl/CmdAlias.pm b/perl/CmdAlias.pm index 8e7f8834..a424f8e8 100644 --- a/perl/CmdAlias.pm +++ b/perl/CmdAlias.pm @@ -85,7 +85,7 @@ sub get_cmd $n = @{$ref}; for ($i = 0; $i < $n; $i += 3) { if ($s =~ /$ref->[$i]/i) { - my $ri = qq{\$ro = "$ref->[$i+1]"}; + my $ri = qq{\$ro = "$ref->[$i+1]"}; my $ro; eval $ri; return $ro; @@ -105,16 +105,16 @@ sub get_hlp $let = lc $let; - checkfiles(); - $ref = $alias{$let}; return undef if !$ref; $n = @{$ref}; for ($i = 0; $i < $n; $i += 3) { if ($s =~ /$ref->[$i]/i) { - my $ri = qq{$ref->[$i+2]}; - return $ri; + my $ri = qq{\$ro = "$ref->[$i+2]"}; + my $ro; + eval $ri; + return $ro; } } return undef; diff --git a/perl/DXBearing.pm b/perl/DXBearing.pm index ea17c2a4..4c8c3eea 100644 --- a/perl/DXBearing.pm +++ b/perl/DXBearing.pm @@ -112,4 +112,36 @@ sub bdist $az = $az+2*$pi if $az < 0; return (rd($az), $dx); } + +# turn a lat long string into floating point lat and long +sub stoll +{ + my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, shift; + + $longd += ($longm/60); + $longd = 0-$longd if (uc $longl) eq 'W'; + $latd += ($latm/60); + $latd = 0-$latd if (uc $latl) eq 'S'; + return ($latd, $longd); +} + +# turn a lat and long into a string +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"; +} 1; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 5fb68418..35aae2e5 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -388,13 +388,9 @@ sub normal } elsif ($field[2] == 2) { $user->qth($field[3]); } elsif ($field[2] == 3) { - my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, $field[3]; - $longd += ($longm/60); - $longd = 0-$longd if (uc $longl) eq 'W'; - $user->long($longd); - $latd += ($latm/60); - $latd = 0-$latd if (uc $latl) eq 'S'; - $user->lat($latd); + my ($lat, $long) = DXBearing::stoll($field[3]); + $user->lat($lat); + $user->long($long); } elsif ($field[2] == 4) { $user->homenode($field[3]); } diff --git a/perl/Messages b/perl/Messages index 74bf3943..6cd9bcd7 100644 --- a/perl/Messages +++ b/perl/Messages @@ -14,6 +14,8 @@ package DXM; already => '$_[0] already connnected', anns => 'Announce flag set on $_[0]', annu => 'Announce flag unset on $_[0]', + bbse1 => 'Please try again, set/bbs ', + bbs => 'Your BBS Address is now \"$_[0]\"', beepoff => 'Beeps are now off', beepon => 'Beeps are now on', conother => 'Sorry $_[0] you are connected on another port', @@ -37,6 +39,8 @@ package DXM; e8 => 'Need a callsign and some text', e9 => 'Need at least some text', e10 => '$_[0] not connected locally', + emaile1 => 'Please try again, set/email ', + emaila => 'Your E-Mail Address is now \"$_[0]\"', email => 'E-mail address set to: $_[0]', helpe1 => 'Help system unavailable, tell sysop', helpe2 => 'No help available on $_[0]', @@ -45,9 +49,17 @@ package DXM; hereu => 'Here unset on $_[0]', homebbs => 'Home BBS set to: $_[0]', homenode => 'Home Node set to: $_[0]', + hnodee1 => 'Please try again, set/homenode ', + hnode => 'Your Homenode is now \"$_[0]\"', l1 => 'Sorry $_[0], you are already logged on on another channel', l2 => 'Hello $_[0], this is $main::mycall in $main::myqth running DXSpider V$main::version', + loce1 => 'Please try again, set/location ', + loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)', + loc => 'Your Lat/Long is now \"$_[0]\"', m2 => '$_[0] Information: $_[1]', + namee1 => 'Please try again, set/name ', + namee2 => 'Can\'t find user $_[0]!', + name => 'Your name is now \"$_[0]\"', node => '$_[0] set as AK1A style Node', nodec => '$_[0] created as AK1A style Node', nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line', @@ -59,6 +71,11 @@ package DXM; pr => '$_[0] de $main::mycall $main::cldate $main::ztime >', priv => 'Privilege level changed on $_[0]', prx => '$main::mycall >', + qthe1 => 'Please try again, set/qth ', + qth => 'Your QTH is now \"$_[0]\"', + qrae1 => 'Please try again, set/qra ', + qrae2 => 'Don\'t recognise \"$_[0]\" as a QRA locator (eg JO02LQ)', + qra => 'Your QRA Locator is now \"$_[0]\"', rcmdo => 'RCMD \"$_[0]\" sent to $_[1]', read1 => 'Sorry, no new messages for you', read2 => 'Msg $_[0] not found', diff --git a/perl/Msg.pm b/perl/Msg.pm index 20e00033..65a32a66 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -67,7 +67,7 @@ sub disconnect { my $sock = delete $conn->{sock}; return unless defined($sock); set_event_handler ($sock, "read" => undef, "write" => undef); - close($sock); + shutdown($sock, 3); } sub send_now {