From cef696652d16bbeec53aca45234ea0b64f3496d3 Mon Sep 17 00:00:00 2001 From: djk Date: Fri, 13 Nov 1998 18:35:47 +0000 Subject: [PATCH] added logging made the Spots as near the same as possible to ak1a --- perl/DXCommandmode.pm | 5 ++- perl/DXLog.pm | 9 +++-- perl/DXMsg.pm | 3 ++ perl/DXProt.pm | 3 ++ perl/Julian.pm | 93 ++++++++++++++++++++++--------------------- perl/Spot.pm | 6 +-- perl/client.pl | 2 +- perl/cluster.pl | 5 ++- 8 files changed, 72 insertions(+), 54 deletions(-) diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 522200da..aa4cb1a3 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -17,6 +17,7 @@ use DXUser; use DXVars; use DXDebug; use DXM; +use DXLog; use CmdAlias; use FileHandle; use Carp; @@ -74,6 +75,7 @@ sub start my $nchan = DXChannel->get($main::mycall); my @pc16 = DXProt::pc16($nchan, $cuser); DXProt::broadcast_ak1a(@pc16); + Log('DXCommand', "$call connected"); } # @@ -192,7 +194,8 @@ sub finish my $nchan = DXChannel->get($main::mycall); my $pc17 = $nchan->pc17($self); DXProt::broadcast_ak1a($pc17); - + + Log('DXCommand', "$call disconnected"); $ref->del() if $ref; } diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 5b5914b4..e4f22803 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -72,7 +72,8 @@ sub open delete $self->{mode}; } - $self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing; + $self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{sort} eq 'm'; + $self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{sort} eq 'd'; $self->{fn} .= ".$self->{suffix}" if $self->{suffix}; $mode = 'r' if !$mode; @@ -144,7 +145,8 @@ sub write sub writenow { my ($self, $line) = @_; - my @date = $self->unixtoj(time); + my $t = time; + my @date = $self->unixtoj($t); return $self->write(@date, $line); } @@ -171,7 +173,8 @@ sub close # The user is responsible for making sense of this! sub Log { - $log->writeunix($main::systime, join('^', $main::systime, @_) ); + my $t = time; + $log->writeunix($t, join('^', $t, @_) ); } sub DESTROY # catch undefs and do what is required further do the tree diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 9316c374..6a6f104a 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -19,6 +19,7 @@ use DXCluster; use DXProtVars; use DXProtout; use DXDebug; +use DXLog; use FileHandle; use Carp; @@ -268,6 +269,7 @@ sub store } $fh->close; dbg('msg', "file $ref->{to} stored\n"); + Log('msg', "file $ref->{to} from $ref->{from} stored" ); } else { confess "can't open file $ref->{to} $!"; } @@ -294,6 +296,7 @@ sub store } $fh->close; dbg('msg', "msg $ref->{msgno} stored\n"); + Log('msg', "msg $ref->{msgno} from $ref->{from} to $ref->{to} stored" ); } else { confess "can't open msg file $fn $!"; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 8985e8ab..ab9e0e33 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -18,6 +18,7 @@ use DXM; use DXCluster; use DXProtVars; use DXCommandmode; +use DXLog; use Spot; use DXProtout; use Carp; @@ -68,6 +69,7 @@ sub start $self->send(pc18()); $self->state('init'); $self->pc50_t(time); + Log('DXProt', "$call connected"); } # @@ -427,6 +429,7 @@ sub finish # now broadcast to all other ak1a nodes that I have gone broadcast_ak1a(pc21($self->call, 'Gone.'), $self); + Log('DXProt', $self->call . " Disconnected"); $ref->del() if $ref; } diff --git a/perl/Julian.pm b/perl/Julian.pm index 5616542b..c770e4a9 100644 --- a/perl/Julian.pm +++ b/perl/Julian.pm @@ -19,13 +19,13 @@ my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); # take a unix date and transform it into a julian day (ie (1998, 13) = 13th day of 1998) sub unixtoj { - my $t = shift; - my ($year, $day) = (gmtime($t))[5,7]; - - if ($year < 100) { - $year += ($year < 50) ? 2000 : 1900; - } - return ($year, $day+1); + my $t = shift; + my ($year, $day) = (gmtime($t))[5,7]; + + if ($year < 100) { + $year += ($year < 50) ? 2000 : 1900; + } + return ($year, $day+1); } # take a unix and return a julian month from it @@ -33,71 +33,74 @@ sub unixtojm { my $t = shift; my ($mon, $year) = (gmtime($t))[4..5]; - return ($year, $mon); + if ($year < 100) { + $year += ($year < 50) ? 2000 : 1900; + } + return ($year, $mon + 1); } # take a julian date and subtract a number of days from it, returning the julian date sub sub { - my ($year, $day, $amount) = @_; - my $diny = isleap($year) ? 366 : 365; - $day -= $amount; - while ($day <= 0) { - $day += $diny; - $year -= 1; - $diny = isleap($year) ? 366 : 365; - } - return ($year, $day); + my ($year, $day, $amount) = @_; + my $diny = isleap($year) ? 366 : 365; + $day -= $amount; + while ($day <= 0) { + $day += $diny; + $year -= 1; + $diny = isleap($year) ? 366 : 365; + } + return ($year, $day); } sub add { - my ($year, $day, $amount) = @_; - my $diny = isleap($year) ? 366 : 365; - $day += $amount; - while ($day > $diny) { - $day -= $diny; - $year += 1; - $diny = isleap($year) ? 366 : 365; - } - return ($year, $day); + my ($year, $day, $amount) = @_; + my $diny = isleap($year) ? 366 : 365; + $day += $amount; + while ($day > $diny) { + $day -= $diny; + $year += 1; + $diny = isleap($year) ? 366 : 365; + } + return ($year, $day); } # take a julian month and subtract a number of months from it, returning the julian month sub subm { - my ($year, $mon, $amount) = @_; - $mon -= $amount; - while ($mon <= 0) { - $mon += 12; - $year -= 1; - } - return ($year, $mon); + my ($year, $mon, $amount) = @_; + $mon -= $amount; + while ($mon <= 0) { + $mon += 12; + $year -= 1; + } + return ($year, $mon); } sub addm { - my ($year, $mon, $amount) = @_; - $mon += $amount; - while ($mon > 12) { - $mon -= 12; - $year += 1; - } - return ($year, $mon); + my ($year, $mon, $amount) = @_; + $mon += $amount; + while ($mon > 12) { + $mon -= 12; + $year += 1; + } + return ($year, $mon); } sub cmp { - my ($y1, $d1, $y2, $d2) = @_; - return $d1 - $d2 if ($y1 == $y2); - return $y1 - $y2; + my ($y1, $d1, $y2, $d2) = @_; + return $d1 - $d2 if ($y1 == $y2); + return $y1 - $y2; } # is it a leap year? sub isleap { - my $year = shift; - return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; + my $year = shift; + return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; } diff --git a/perl/Spot.pm b/perl/Spot.pm index dca64688..e53880e1 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -162,7 +162,7 @@ sub formatb { my @dx = @_; my $t = ztime($dx[2]); - return sprintf "DX de %-7.7s: %13.1f %-12.12s %-30s<%s>", $dx[4], $dx[0], $dx[1], $dx[3], $t ; + 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 @@ -171,7 +171,7 @@ sub formatl my @dx = @_; my $t = ztime($dx[2]); my $d = cldate($dx[2]); - return sprintf "%9.1f %-12s %s %s %-30s<%s>", $dx[0], $dx[1], $d, $t, $dx[3], $dx[4] ; -} + return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ; +} 1; diff --git a/perl/client.pl b/perl/client.pl index b8129cbb..cff140b2 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -102,7 +102,7 @@ sub rec_socket my $snl = $mynl; my $newsavenl = ""; $snl = "" if $mode == 0; - if ($mode && $line =~ />$/) { + if ($mode == 2 && $line =~ />$/) { $newsavenl = $snl; $snl = ' '; } diff --git a/perl/cluster.pl b/perl/cluster.pl index 4c65e868..848131f7 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -47,7 +47,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = 1.3; # the version no of the software +$version = 1.4; # the version no of the software # handle disconnections sub disconnect @@ -129,6 +129,7 @@ sub cease foreach $dxchan (DXChannel->get_all()) { disconnect($dxchan); } + Log('cluster', "DXSpider V$version stopped"); exit(0); } @@ -176,6 +177,8 @@ foreach (@debug) { } STDOUT->autoflush(1); +Log('cluster', "DXSpider V$version started"); + # banner print "DXSpider DX Cluster Version $version\nCopyright (c) 1998 Dirk Koopman G1TLH\n"; -- 2.43.0