+21Dec98============= late! ====================================================
+1. fixed problem with missing DXDebug in DXProt.
+2. Fixed DXDebug so that it actually works as advertised with and without
+trailing \n.
+3. Added deduping of WWV spots as well (at for date,time,sfi,k and i) dups
+4. Replaced the 0 in "02-Dec-1998" with ' ' so it reads " 2-Dec-1998", it seems
+hard to credit it but some 'programs' out there that connect to clusters have
+problems with the leading '0'!
+5. In the same vain, included a strictly AK1A compatible sh/heading, apparently
+this is necessary for the same reason as 4.
+6. Started contrib tree stored the old show/heading in contrib/g0rdi/show.
+7. Because I now correctly dedupe spots and wwv (there's a hostage to fortune..)
+I have added a merge command.
21Dec98========================================================================
1. Added "issue" to the client program for 'login' connections
2. Added more docs for client program.
=== 5^KILL-^
As a sysop you can kill any message on the system.
+=== 5^MERGE <node> [<no spots>/<no wwv>]^Ask for the latest spots and WWV
+MERGE allows you to bring your spot and wwv database up to date. By default
+it will request the last 10 spots and 5 WWVs from the node you select. The
+node must be connected locally.
+
+You can request any number of spots or wwv and although they will be appended
+to your databases they will not duplicate any that have recently been added
+(the last 2 days for spots and last month for WWV data).
+
=== 8^PC <call> <text>^Send arbitrary text to a connected callsign
Send any text you like to the callsign requested. This is used mainly to send
PC protocol to connected nodes either for testing or to unstick things.
then this command will set your QRA locator for you. For example:-
SET/LOCATION 52 22 N 0 57 E
-=== 0^SET/LOCKOUT <call>^Stop a callsign connecting to the cluster
-=== 0^UNSET/LOCKOUT <call>^Allow a callsign to connect to the cluster
+=== 9^SET/LOCKOUT <call>^Stop a callsign connecting to the cluster
+=== 9^UNSET/LOCKOUT <call>^Allow a callsign to connect to the cluster
=== 0^SET/NAME <your name>^Set your name
Tell the system what your name is eg:-
} elsif ($sort eq "LOCAL") {
$line =~ s/^$f[0]\s+//; # remove it
$to = "LOCAL";
-} elsif ($sort eq "") {
- $to = "LOCAL";
} else {
- return (1, $self->msg('e11'));
+ $to = "LOCAL";
}
Log('ann', $to, $from, $line);
#
# $Id$
#
-
+# AK1A-compatible output Iain Philipps, G0RDI 16-Dec-1998
+#
my ($self, $line) = @_;
-my @list = split /\s+/, $line; # generate a list of callsigns
+my @list = split /\s+/, $line; # generate a list of callsigns
my $l;
my @out;
my $lat = $self->user->lat;
my $long = $self->user->long;
if (!$long && !$lat) {
- push @out, $self->msg('heade1');
- $lat = $main::mylatitude;
- $long = $main::mylongitude;
+ push @out, $self->msg('heade1');
+ $lat = $main::mylatitude;
+ $long = $main::mylongitude;
}
foreach $l (@list) {
- # prefixes --->
- my @ans = Prefix::extract($l);
- next if !@ans;
- my $pre = shift @ans;
- my $a;
- foreach $a (@ans) {
- my ($b, $dx) = DXBearing::bdist($lat, $long, $a->{lat}, $a->{long});
- my ($r, $rdx) = DXBearing::bdist($a->{lat}, $a->{long}, $lat, $long);
- push @out, sprintf "%-9s (%s, %s) Bearing: %.0f Recip: %.0f %.0fKm %.0fMi", uc $l, $pre, $a->name(), $b, $r, $dx, $dx * 0.62133785;
- $l = "";
- }
+ # prefixes --->
+ my @ans = Prefix::extract($l);
+ next if !@ans;
+ my $pre = shift @ans;
+ my $a;
+ foreach $a (@ans) {
+ my ($b, $dx) = DXBearing::bdist($lat, $long, $a->{lat}, $a->{long});
+ my ($r, $rdx) = DXBearing::bdist($a->{lat}, $a->{long}, $lat, $long);
+ push @out, sprintf "%-2s %s: %.0f degs - dist: %.0f mi, %.0f km Reciprocal heading: %.0f degs", $pre, $a->name(), $b, $dx * 0.62133785, $dx, $r;
+ $l = "";
+ }
}
return (1, @out);
next if $from && $to > $from;
}
if (!$to) {
- ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count?
+ ($to) = $f =~ /^(\d+)$/o; # is it a to count?
next if $to;
}
}
my $conn = $self->{conn};
my $sort = shift;
my $call = $self->{call};
- my $line;
- foreach $line (@_) {
- chomp $line;
- $conn->send_now("$sort$call|$line") if $conn;
- dbg('chan', "-> $sort $call $line") if $conn;
+ for (@_) {
+ chomp;
+ $conn->send_now("$sort$call|$_") if $conn;
+ dbg('chan', "-> $sort $call $_") if $conn;
}
$self->{t} = time;
}
my $self = shift;
my $conn = $self->{conn};
my $call = $self->{call};
- my $line;
- foreach $line (@_) {
- chomp $line;
- $conn->send_later("D$call|$line") if $conn;
- dbg('chan', "-> D $call $line") if $conn;
+ for (@_) {
+ chomp;
+ $conn->send_later("D$call|$_") if $conn;
+ dbg('chan', "-> D $call $_") if $conn;
}
$self->{t} = time;
}
{
my $self = shift;
my $call = $self->call;
-
+
+ # log out text
+ if (-e "$main::data/logout") {
+ open(I, "$main::data/logout") or confess;
+ my @in = <I>;
+ close(I);
+ $self->sendnow('D', @in);
+ }
+
if ($call eq $main::myalias) { # unset the channel if it is us really
my $node = DXNode->get($main::mycall);
$node->{dxchan} = 0;
}
- my $ref = DXNodeuser->get($call);
+ my $ref = DXCluster->get_exact($call);
# issue a pc17 to everybody interested
my $nchan = DXChannel->get($main::mycall);
{
my $l = shift;
if ($dbglevel{$l}) {
- for (@_) {
- s/\n$//og;
+ my @in = @_;
+ my $t = time;
+ for (@in) {
+ s/\n$//o;
s/\a//og; # beeps
+ print "$_\n" if defined \*STDOUT;
+ $fp->writeunix($t, "$t^$_");
}
- print "@_\n" if defined \*STDOUT;
- my $t = time;
- $fp->writeunix($t, "$t^@_");
}
}
use DXLog;
use Spot;
use DXProtout;
+use DXDebug;
use Carp;
use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds %nodehops);
+use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds %nodehops);
$me = undef; # the channel id for this cluster
$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
-$pc11_dup_age = 24*3600; # the maximum time to keep the dup list for
-%dup = (); # the pc11 and 26 dup hash
+$pc11_dup_age = 24*3600; # the maximum time to keep the spot dup list for
+$pc23_dup_age = 24*3600; # the maximum time to keep the wwv dup list for
+%spotdup = (); # the pc11 and 26 dup hash
+%wwvdup = (); # the pc23 and 27 dup hash
$last_hour = time; # last time I did an hourly periodic update
%pings = (); # outstanding ping requests outbound
%rcmds = (); # outstanding rcmd requests outbound
do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
confess $@ if $@;
# $me->{sort} = 'M'; # M for me
+
+ # now prime the spot duplicates file with today's and yesterday's data
+ my @today = Julian::unixtoj(time);
+ my @spots = Spot::readfile(@today);
+ @today = Julian::sub(@today, 1);
+ push @spots, Spot::readfile(@today);
+ for (@spots) {
+ my $dupkey = "$_->[0]$_->[1]$_->[2]$_->[3]$_->[4]";
+ $spotdup{$dupkey} = $_->[2];
+ }
+
+ # now prime the wwv duplicates file with just this month's data
+ my @wwv = Geomag::readfile(time);
+ for (@wwv) {
+ my $dupkey = "$_->[1].$_->[2]$_->[3]$_->[4]";
+ $wwvdup{$dupkey} = $_->[1];
+ }
+
}
#
my $d = cltounix($field[3], $field[4]);
# bang out (and don't pass on) if date is invalid or the spot is too old
if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) {
- dbg('chan', "Spot ignored, invalid date or too old");
+ dbg('chan', "Spot ignored, invalid date or too old\n");
return;
}
$spotter =~ s/-\d+$//o; # strip off the ssid from the spotter
# do some de-duping
- my $dupkey = "$field[1]$field[2]$d$text$field[6]";
- if ($dup{$dupkey}) {
- dbg('chan', "Duplicate Spot ignored");
+ my $freq = $field[1] - 0;
+ my $dupkey = "$freq$field[2]$d$text$spotter";
+ if ($spotdup{$dupkey}) {
+ dbg('chan', "Duplicate Spot ignored\n");
return;
}
- $dup{$dupkey} = $d;
+ $spotdup{$dupkey} = $d;
- my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter);
+ my $spot = Spot::add($freq, $field[2], $d, $text, $spotter);
# send orf to the users
if ($spot && $pcno == 11) {
my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
broadcast_users("$buf\a\a");
}
+
+ # DON'T be silly and send on PC26s!
+ return if $pcno == 26;
last SWITCH;
}
}
if ($pcno == 23 || $pcno == 27) { # WWV info
- Geomag::update(@field[1..$#field]);
+ # do some de-duping
+ my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
+ my $sfi = unpad($field[3]);
+ my $k = unpad($field[4]);
+ my $i = unpad($field[5]);
+ my $dupkey = "$d.$sfi$k$i";
+ if ($wwvdup{$dupkey}) {
+ dbg('chan', "Dup WWV Spot ignored\n");
+ return;
+ }
+
+ $wwvdup{$dupkey} = $d;
+ Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+
+ # DON'T be silly and send on PC27s!
+ return if $pcno == 27;
+
last SWITCH;
}
my $cutoff;
if ($main::systime - 3600 > $last_hour) {
$cutoff = $main::systime - $pc11_dup_age;
- while (($key, $val) = each %dup) {
- delete $dup{$key} if $val < $cutoff;
+ while (($key, $val) = each %spotdup) {
+ delete $spotdup{$key} if $val < $cutoff;
+ }
+ $cutoff = $main::systime - $pc23_dup_age;
+ while (($key, $val) = each %wwvdup) {
+ delete $wwvdup{$key} if $val < $cutoff;
}
$last_hour = $main::systime;
}
my $t = shift;
my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time);
$year += 1900;
- my $buf = sprintf "%02d-%s-%04d", $mday, $month[$mon], $year;
+ my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
return $buf;
}
#
sub print
{
- my $self = $fp;
my $from = shift;
my $to = shift;
- my @date = $self->unixtoj(shift);
+ my @date = $fp->unixtoj(shift);
my $pattern = shift;
my $search;
- my @in;
my @out;
my $eval;
my $count;
\$ref = \$in[\$c];
if ($search) {
\$count++;
- next if \$count < $from;
+ next if \$count < \$from;
push \@out, print_item(\$ref);
last LOOP if \$count >= \$to; # stop after n
}
}
);
- $self->close; # close any open files
+ $fp->close; # close any open files
- my $fh = $self->open(@date);
+ my $fh = $fp->open(@date);
LOOP:
while ($count < $to) {
- my @spots = ();
+ my @in = ();
if ($fh) {
while (<$fh>) {
chomp;
eval $eval; # do the search on this file
return ("Spot search error", $@) if $@;
}
- $fh = $self->openprev(); # get the next file
+ $fh = $fp->openprev(); # get the next file
last if !$fh;
}
return sprintf("$d %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
}
+#
+# read in this month's data
+#
+sub readfile
+{
+ my @date = $fp->unixtoj(shift);
+ my $fh = $fp->open(@date);
+ my @spots = ();
+ my @in;
+
+ if ($fh) {
+ while (<$fh>) {
+ chomp;
+ push @in, [ split '\^' ] if length > 2;
+ }
+ }
+ return @in;
+}
1;
__END__;
e8 => 'Need a callsign and some text',
e9 => 'Need at least some text',
e10 => '$_[0] not connected locally',
+ e12 => 'Need a node callsign',
+ e13 => '$_[0] is not a node',
emaile1 => 'Please enter your email address, set/email <your e-mail address>',
emaila => 'Your E-Mail Address is now \"$_[0]\"',
email => 'E-mail address set to: $_[0]',
lockout => '$_[0] Locked out',
lockoutun => '$_[0] Unlocked',
m2 => '$_[0] Information: $_[1]',
+ merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]',
namee1 => 'Please enter your name, set/name <your name>',
namee2 => 'Can\'t find user $_[0]!',
name => 'Your name is now \"$_[0]\"',
use strict;
use vars qw($db %prefix_loc %pre);
-$db = undef; # the DB_File handle
-%prefix_loc = (); # the meat of the info
-%pre = (); # the prefix list
+$db = undef; # the DB_File handle
+%prefix_loc = (); # the meat of the info
+%pre = (); # the prefix list
sub load
{
- if ($db) {
- untie %pre;
- %pre = ();
- %prefix_loc = ();
- }
- $db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0666, $DB_BTREE) or confess "can't tie \%pre ($!)";
- my $out = $@ if $@;
- do "$main::data/prefix_data.pl" if !$out;
- $out = $@ if $@;
-# print Data::Dumper->Dump([\%pre, \%prefix_loc], [qw(pre prefix_loc)]);
- return $out;
+ if ($db) {
+ untie %pre;
+ %pre = ();
+ %prefix_loc = ();
+ }
+ $db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0666, $DB_BTREE) or confess "can't tie \%pre ($!)";
+ my $out = $@ if $@;
+ do "$main::data/prefix_data.pl" if !$out;
+ $out = $@ if $@;
+ # print Data::Dumper->Dump([\%pre, \%prefix_loc], [qw(pre prefix_loc)]);
+ return $out;
}
sub store
{
- my ($k, $l);
- my $fh = new FileHandle;
- my $fn = "$main::data/prefix_data.pl";
+ my ($k, $l);
+ my $fh = new FileHandle;
+ my $fn = "$main::data/prefix_data.pl";
- confess "Prefix system not started" if !$db;
+ confess "Prefix system not started" if !$db;
- # save versions!
- rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
- rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
- rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
- rename "$fn.o", "$fn.oo" if -e "$fn.o";
- rename "$fn", "$fn.o" if -e "$fn";
+ # save versions!
+ rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
+ rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
+ rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
+ rename "$fn.o", "$fn.oo" if -e "$fn.o";
+ rename "$fn", "$fn.o" if -e "$fn";
- $fh->open(">$fn") or die "Can't open $fn ($!)";
-
- # prefix location data
- $fh->print("%prefix_loc = (\n");
- foreach $l (sort {$a <=> $b} keys %prefix_loc) {
- my $r = $prefix_loc{$l};
- $fh->printf(" $l => bless( { name => '%s', dxcc => %d, itu => %d, utcoff => %d, lat => %f, long => %f }, 'Prefix'),\n",
- $r->{name}, $r->{dxcc}, $r->{itu}, $r->{cq}, $r->{utcoff}, $r->{lat}, $r->{long});
- }
- $fh->print(");\n\n");
-
- # prefix data
- $fh->print("%pre = (\n");
- foreach $k (sort keys %pre) {
- $fh->print(" '$k' => [");
- my @list = @{$pre{$k}};
- my $l;
- my $str;
- foreach $l (@list) {
- $str .= " $l,";
- }
- chop $str;
- $fh->print("$str ],\n");
- }
- $fh->print(");\n");
- $fh->close;
+ $fh->open(">$fn") or die "Can't open $fn ($!)";
+
+ # prefix location data
+ $fh->print("%prefix_loc = (\n");
+ foreach $l (sort {$a <=> $b} keys %prefix_loc) {
+ my $r = $prefix_loc{$l};
+ $fh->printf(" $l => bless( { name => '%s', dxcc => %d, itu => %d, utcoff => %d, lat => %f, long => %f }, 'Prefix'),\n",
+ $r->{name}, $r->{dxcc}, $r->{itu}, $r->{cq}, $r->{utcoff}, $r->{lat}, $r->{long});
+ }
+ $fh->print(");\n\n");
+
+ # prefix data
+ $fh->print("%pre = (\n");
+ foreach $k (sort keys %pre) {
+ $fh->print(" '$k' => [");
+ my @list = @{$pre{$k}};
+ my $l;
+ my $str;
+ foreach $l (@list) {
+ $str .= " $l,";
+ }
+ chop $str;
+ $fh->print("$str ],\n");
+ }
+ $fh->print(");\n");
+ $fh->close;
}
# what you get is a list that looks like:-
#
sub get
{
- my $key = shift;
- my @out;
- my @outref;
- my $ref;
- my $gotkey;
+ my $key = shift;
+ my @out;
+ my @outref;
+ my $ref;
+ my $gotkey;
- $gotkey = $key;
- return () if $db->seq($gotkey, $ref, R_CURSOR);
- return () if $key ne substr $gotkey, 0, length $key;
+ $gotkey = $key;
+ return () if $db->seq($gotkey, $ref, R_CURSOR);
+ return () if $key ne substr $gotkey, 0, length $key;
- @outref = map { $prefix_loc{$_} } split ',', $ref;
- return ($gotkey, @outref);
+ @outref = map { $prefix_loc{$_} } split ',', $ref;
+ return ($gotkey, @outref);
}
#
#
sub next
{
- my $key = shift;
- my @out;
- my @outref;
- my $ref;
- my $gotkey;
+ my $key = shift;
+ my @out;
+ my @outref;
+ my $ref;
+ my $gotkey;
- return () if $db->seq($gotkey, $ref, R_NEXT);
- return () if $key ne substr $gotkey, 0, length $key;
+ return () if $db->seq($gotkey, $ref, R_NEXT);
+ return () if $key ne substr $gotkey, 0, length $key;
- @outref = map { $prefix_loc{$_} } split ',', $ref;
- return ($gotkey, @outref);
+ @outref = map { $prefix_loc{$_} } split ',', $ref;
+ return ($gotkey, @outref);
}
#
sub extract
{
- my $call = uc shift;
- my @out;
- my @nout;
- my $p;
- my @parts;
- my ($sp, $i);
+ my $call = uc shift;
+ my @out;
+ my @nout;
+ my $p;
+ my @parts;
+ my ($sp, $i);
- # first check if the whole thing succeeds
- @out = get($call);
- return @out if @out > 0 && $out[0] eq $call;
+ # first check if the whole thing succeeds
+ @out = get($call);
+ return @out if @out > 0 && $out[0] eq $call;
- # now split the call into parts if required
- @parts = ($call =~ '/') ? split('/', $call) : ($call);
-
- # remove any /0-9 /P /A /M /MM /AM suffixes etc
- if (@parts > 1) {
- $p = $parts[$#parts];
- pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
- $p = $parts[$#parts];
- pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
+ # now split the call into parts if required
+ @parts = ($call =~ '/') ? split('/', $call) : ($call);
+
+ # remove any /0-9 /P /A /M /MM /AM suffixes etc
+ if (@parts > 1) {
+ $p = $parts[$#parts];
+ pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
+ $p = $parts[$#parts];
+ pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
- # can we resolve them by direct lookup
- foreach $p (@parts) {
- @out = get($p);
- return @out if @out > 0 && $out[0] eq $call;
+ # can we resolve them by direct lookup
+ foreach $p (@parts) {
+ @out = get($p);
+ return @out if @out > 0 && $out[0] eq $call;
+ }
}
- }
- # which is the shortest part (first if equal)?
- $sp = $parts[0];
- foreach $p (@parts) {
- $sp = $p if length $sp > length $p;
- }
- # now start to resolve it from the left hand end
- for (@out = (), $i = 1; $i <= length $sp; ++$i) {
- @nout = get(substr($sp, 0, $i));
- last if @nout > 0 && $nout[0] gt $sp;
- last if @nout == 0;
- @out = @nout;
- }
+ # which is the shortest part (first if equal)?
+ $sp = $parts[0];
+ foreach $p (@parts) {
+ $sp = $p if length $sp > length $p;
+ }
+ # now start to resolve it from the left hand end
+ for (@out = (), $i = 1; $i <= length $sp; ++$i) {
+ @nout = get(substr($sp, 0, $i));
+ last if @nout > 0 && $nout[0] gt $sp;
+ last if @nout == 0;
+ @out = @nout;
+ }
- # not found
- return (@out > 0) ? @out : ();
+ # not found
+ return (@out > 0) ? @out : ();
}
my %valid = (
- lat => '0,Latitude,slat',
- long => '0,Longitude,slong',
- dxcc => '0,DXCC',
- name => '0,Name',
- itu => '0,ITU',
- cq => '0,CQ',
- utcoff => '0,UTC offset',
-);
+ lat => '0,Latitude,slat',
+ long => '0,Longitude,slong',
+ dxcc => '0,DXCC',
+ name => '0,Name',
+ itu => '0,ITU',
+ cq => '0,CQ',
+ utcoff => '0,UTC offset',
+ );
no strict;
sub AUTOLOAD
{
- my $self = shift;
- my $name = $AUTOLOAD;
+ my $self = shift;
+ my $name = $AUTOLOAD;
- return if $name =~ /::DESTROY$/;
- $name =~ s/.*:://o;
+ return if $name =~ /::DESTROY$/;
+ $name =~ s/.*:://o;
- confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
- if (@_) {
- $self->{$name} = shift;
- }
- return $self->{$name};
+ confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+ if (@_) {
+ $self->{$name} = shift;
+ }
+ return $self->{$name};
}
use strict;
sub field_prompt
{
- my ($self, $ele) = @_;
- return $valid{$ele};
+ my ($self, $ele) = @_;
+ return $valid{$ele};
}
1;
use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix);
$fp = undef;
-$maxspots = 50; # maximum spots to return
-$defaultspots = 10; # normal number of spots to return
-$maxdays = 35; # normal maximum no of days to go back
+$maxspots = 50; # maximum spots to return
+$defaultspots = 10; # normal number of spots to return
+$maxdays = 35; # normal maximum no of days to go back
$dirprefix = "spots";
sub init
sub prefix
{
- return $fp->{prefix};
+ return $fp->{prefix};
}
# add a spot to the data file (call as Spot::add)
sub add
{
- my @spot = @_; # $freq, $call, $t, $comment, $spotter = @_
+ my @spot = @_; # $freq, $call, $t, $comment, $spotter = @_
- # sure that the numeric things are numeric now (saves time later)
- $spot[0] = 0 + $spot[0];
- $spot[2] = 0 + $spot[2];
+ # sure that the numeric things are numeric now (saves time later)
+ $spot[0] = 0 + $spot[0];
+ $spot[2] = 0 + $spot[2];
- # remove ssid if present on spotter
- $spot[4] =~ s/-\d+$//o;
+ # remove ssid if present on spotter
+ $spot[4] =~ s/-\d+$//o;
- # add the 'dxcc' country on the end
- my @dxcc = Prefix::extract($spot[1]);
- push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
+ # add the 'dxcc' country on the end
+ my @dxcc = Prefix::extract($spot[1]);
+ push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
- my $buf = join("\^", @spot);
+ my $buf = join("\^", @spot);
- # compare dates to see whether need to open another save file (remember, redefining $fp
- # automagically closes the output file (if any)).
- $fp->writeunix($spot[2], $buf);
+ # compare dates to see whether need to open another save file (remember, redefining $fp
+ # automagically closes the output file (if any)).
+ $fp->writeunix($spot[2], $buf);
- return $buf;
+ return $buf;
}
# search the spot database for records based on the field no and an expression
sub search
{
- my ($expr, $dayfrom, $dayto, $from, $to) = @_;
- my $eval;
- my @out;
- my $ref;
- my $i;
- my $count;
- my @today = Julian::unixtoj(time);
- my @fromdate;
- my @todate;
+ my ($expr, $dayfrom, $dayto, $from, $to) = @_;
+ my $eval;
+ my @out;
+ my $ref;
+ my $i;
+ my $count;
+ my @today = Julian::unixtoj(time);
+ my @fromdate;
+ my @todate;
- if ($dayfrom > 0) {
- @fromdate = Julian::sub(@today, $dayfrom);
- } else {
- @fromdate = @today;
- $dayfrom = 0;
- }
- if ($dayto > 0) {
- @todate = Julian::sub(@fromdate, $dayto);
- } else {
- @todate = Julian::sub(@fromdate, $maxdays);
- }
- if ($from || $to) {
- $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
- } else {
- $from = 0;
- $to = $defaultspots;
- }
-
- $expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
-# $expr =~ s/\$f(\d)/\$spots[$1]/g; # swap the letter n for the correct field name
+ if ($dayfrom > 0) {
+ @fromdate = Julian::sub(@today, $dayfrom);
+ } else {
+ @fromdate = @today;
+ $dayfrom = 0;
+ }
+ if ($dayto > 0) {
+ @todate = Julian::sub(@fromdate, $dayto);
+ } else {
+ @todate = Julian::sub(@fromdate, $maxdays);
+ }
+ if ($from || $to) {
+ $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
+ } else {
+ $from = 0;
+ $to = $defaultspots;
+ }
+
+ $expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
+ # $expr =~ s/\$f(\d)/\$spots[$1]/g; # swap the letter n for the correct field name
- dbg("search", "expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
+ dbg("search", "expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
- # build up eval to execute
- $eval = qq(
- my \$c;
- my \$ref;
- for (\$c = \$#spots; \$c >= 0; \$c--) {
- \$ref = \$spots[\$c];
- if ($expr) {
- \$count++;
- next if \$count < \$from; # wait until from
- push(\@out, \$ref);
- last LOOP if \$count >= \$to; # stop after to
- }
- }
- );
-
- $fp->close; # close any open files
-
-LOOP:
- for ($i = 0; $i < $maxdays; ++$i) { # look thru $maxdays worth of files only
- my @now = Julian::sub(@fromdate, $i); # but you can pick which $maxdays worth
- last if Julian::cmp(@now, @todate) <= 0;
+ # build up eval to execute
+ $eval = qq(
+ my \$c;
+ my \$ref;
+ for (\$c = \$ #spots; \$c >= 0; \$c--) {
+ \$ref = \$spots[\$c];
+ if ($expr) {
+ \$count++;
+ next if \$count < \$from; # wait until from
+ push(\@out, \$ref);
+ last LOOP if \$count >= \$to; # stop after to
+ }
+ }
+ );
+
+ $fp->close; # close any open files
+
+ LOOP:
+ for ($i = 0; $i < $maxdays; ++$i) { # look thru $maxdays worth of files only
+ my @now = Julian::sub(@fromdate, $i); # but you can pick which $maxdays worth
+ last if Julian::cmp(@now, @todate) <= 0;
- my @spots = ();
- my $fh = $fp->open(@now); # get the next file
- if ($fh) {
- my $in;
- while (<$fh>) {
- chomp;
- push @spots, [ split '\^' ];
- }
- eval $eval; # do the search on this file
- return ("Spot search error", $@) if $@;
+ my @spots = ();
+ my $fh = $fp->open(@now); # get the next file
+ if ($fh) {
+ my $in;
+ while (<$fh>) {
+ chomp;
+ push @spots, [ split '\^' ];
+ }
+ eval $eval; # do the search on this file
+ return ("Spot search error", $@) if $@;
+ }
}
- }
- return @out;
+ return @out;
}
# format a spot for user output in 'broadcast' mode
sub formatb
{
- my @dx = @_;
- my $t = ztime($dx[2]);
- return sprintf "DX de %-7.7s%11.1f %-12.12s %-30s %s", "$dx[4]:", $dx[0], $dx[1], $dx[3], $t ;
+ my @dx = @_;
+ my $t = ztime($dx[2]);
+ return sprintf "DX de %-7.7s%11.1f %-12.12s %-30s %s", "$dx[4]:", $dx[0], $dx[1], $dx[3], $t ;
}
# format a spot for user output in list mode
sub formatl
{
- my @dx = @_;
- my $t = ztime($dx[2]);
- my $d = cldate($dx[2]);
- return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ;
+ my @dx = @_;
+ my $t = ztime($dx[2]);
+ my $d = cldate($dx[2]);
+ return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ;
}
-
+#
+# return all the spots from a day's file as an array of references
+# the parameter passed is a julian day
+sub readfile
+{
+ my @spots;
+
+ my $fh = $fp->open(@_);
+ if ($fh) {
+ my $in;
+ while (<$fh>) {
+ chomp;
+ push @spots, [ split '\^' ];
+ }
+ }
+ return @spots;
+}
1;
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
-$version = "1.13"; # the version no of the software
+$version = "1.14"; # the version no of the software
$starttime = 0; # the starting time of the cluster
# handle disconnections
# read in command aliases
CmdAlias->init();
-# initialise the protocol engine
-DXProt->init();
-
# initialise the Geomagnetic data engine
Geomag->init();
# initial the Spot stuff
Spot->init();
+# initialise the protocol engine
+print "reading in duplicate spot and WWV info ...\n";
+DXProt->init();
+
+
# put in a DXCluster node for us here so we can add users and take them away
DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version);
projects / spider.git / commitdiff