+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
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 <prefix>^Interrogate the spot database by country
This command takes the <prefix> (which can be a full or partial
$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>) {
+#
+# 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));
+}
+
+#
+# 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));
+}
+
#
# $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));
+}
+
+#
+# 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));
+}
+#
+# 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));
+}
+
#
# 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));
+}
+
#
-# 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));
+}
+
$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;
$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;
$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;
} 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]);
}
already => '$_[0] already connnected',
anns => 'Announce flag set on $_[0]',
annu => 'Announce flag unset on $_[0]',
+ bbse1 => 'Please try again, set/bbs <your bbs address>',
+ 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',
e8 => 'Need a callsign and some text',
e9 => 'Need at least some text',
e10 => '$_[0] not connected locally',
+ emaile1 => 'Please try again, set/email <your e-mail address>',
+ 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]',
hereu => 'Here unset on $_[0]',
homebbs => 'Home BBS set to: $_[0]',
homenode => 'Home Node set to: $_[0]',
+ hnodee1 => 'Please try again, set/homenode <your home DX Cluster>',
+ 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 <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]\"',
m2 => '$_[0] Information: $_[1]',
+ namee1 => 'Please try again, set/name <your 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',
pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
priv => 'Privilege level changed on $_[0]',
prx => '$main::mycall >',
+ qthe1 => 'Please try again, set/qth <your qth>',
+ qth => 'Your QTH is now \"$_[0]\"',
+ qrae1 => 'Please try again, set/qra <qra locator>',
+ 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',
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 {
projects / spider.git / commitdiff