From f3adc82a0299652d929b73c718127fa38571eec5 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 28 Dec 1998 01:09:44 +0000 Subject: [PATCH] 1. Various detail changes to remove some more warning with -w on 2. Added DXCron handling - you can do crontabs now. 3. Added show/program command so you can see where it is loading your .pm files from. 4. Added pc26/27 replies to locally connected cluster's merge (pc25) requests 5. Added spotters DXCC and original cluster to Spot data files. --- Changes | 7 ++ cmd/Commands_en.hlp | 4 ++ cmd/connect.pl | 6 +- cmd/crontab | 5 ++ cmd/show/program.pl | 16 +++++ cmd/show/qra.pl | 9 +-- cmd/show/station.pl | 11 ++- cmd/show/wwv.pl | 5 +- cmd/wwv.pl | 9 +++ html/cron.html | 151 ++++++++++++++++++++++++++++++++++++++++++ html/index.html | 3 +- perl/DXChannel.pm | 1 + perl/DXCommandmode.pm | 6 +- perl/DXCron.pm | 136 +++++++++++++++++++++++++++++++------ perl/DXLogPrint.pm | 12 ++-- perl/DXProt.pm | 30 ++++++++- perl/DXProtout.pm | 20 +++++- perl/DXVars.pm | 2 +- perl/Geomag.pm | 9 ++- perl/Spot.pm | 24 ++++--- perl/cluster.pl | 6 +- 21 files changed, 412 insertions(+), 60 deletions(-) create mode 100644 cmd/show/program.pl create mode 100644 html/cron.html diff --git a/Changes b/Changes index a985aed8..c2ebb14f 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,10 @@ +27Dec98======================================================================== +1. Various detail changes to remove some more warning with -w on +2. Added DXCron handling - you can do crontabs now. +3. Added show/program command so you can see where it is loading your .pm files +from. +4. Added pc26/27 replies to locally connected cluster's merge (pc25) requests +5. Added spotters DXCC and original cluster to Spot data files. 23Dec98======================================================================== 1. Reindented various things 2. Added missing $main::mycall on the end of outgoing PC11s (!) diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 368d57d5..b553934f 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -270,6 +270,10 @@ explicitly to 0 will disable paging. SET/PAGE 30 SET/PAGE 0 +=== 0^SHOW/PROGRAM^Show the locations of all the included program modules +Show the name and location where every program module was load from. This +is useful for checking where you think you have loaded a .pm file from. + === 9^SET/PRIVILEGE [msg('constart', $call)); diff --git a/cmd/crontab b/cmd/crontab index b2ebb388..508faf5b 100644 --- a/cmd/crontab +++ b/cmd/crontab @@ -1,2 +1,7 @@ # crontab in normal crontab format # +# DO NOT EDIT THIS FILE +# +# create and edit the one in /spider/local_cmd/crontab +# for doing connections and things +# diff --git a/cmd/show/program.pl b/cmd/show/program.pl new file mode 100644 index 00000000..e7416460 --- /dev/null +++ b/cmd/show/program.pl @@ -0,0 +1,16 @@ +# +# show where I have included stuff from so far +# +# Copyright (c) 1998 Dirk Koopman G1TLH +# +# $Id$ +# +my $self = shift; +return (1, $self->msg('e5')) if $self->priv < 5; +my @in = sort keys %INC; +my @out = ("Locations of included Program Modules"); +for (@in) { + push @out, "$_ => $INC{$_}" if $INC{$_} =~ /spider/o; +} + +return (1, @out); diff --git a/cmd/show/qra.pl b/cmd/show/qra.pl index fe3f08ab..90c5bb1a 100644 --- a/cmd/show/qra.pl +++ b/cmd/show/qra.pl @@ -9,7 +9,6 @@ my ($self, $line) = @_; my @list = split /\s+/, $line; # generate a list of callsigns -my $l; my @out; my $lat = $self->user->lat; my $long = $self->user->long; @@ -20,7 +19,7 @@ if (!$long && !$lat) { } 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$/); +return (1, $self->msg('qrae2', $list[0])) unless (DXBearing::is_qra($list[0]) || $list[0] =~ /^[A-Za-z][A-Za-z]\d\d$/); #print "$lat $long\n"; @@ -33,7 +32,7 @@ if (@list > 1) { ($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$/); + return (1, $self->msg('qrae2', $list[1])) unless (DXBearing::is_qra($list[1]) || $list[1] =~ /^[A-Za-z][A-Za-z]\d\d$/); $l = uc $list[1]; } @@ -43,7 +42,9 @@ 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 $to = ''; + +$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; diff --git a/cmd/show/station.pl b/cmd/show/station.pl index 2a7034e1..40c7eddb 100644 --- a/cmd/show/station.pl +++ b/cmd/show/station.pl @@ -20,8 +20,15 @@ if (@f == 0) { next if !$ref; my $lat = $ref->lat; my $long = $ref->long; + my $sort = $ref->sort || ""; + my $name = $ref->name || ""; + my $qth = $ref->qth || ""; + my $homenode = $ref->homenode || ""; + my $qra = $ref->qra || ""; 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; + $latlong = "" unless $latlong; + + push @out, sprintf "%-9s %s %-12.12s %-27.27s %-9s %s %s", $call, $sort, $name, $qth, $homenode, $latlong, $qra; } } else { foreach $call (@f) { @@ -64,7 +71,7 @@ if (@f == 0) { 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, sprintf("Heading : %.0f Deg %.0f Mi. %.0f Km.", $bearing, $miles, $dx) if $latlong; push @out, "Home Node : $homenode" if $homenode; } else { push @out, $self->msg('usernf', $call); diff --git a/cmd/show/wwv.pl b/cmd/show/wwv.pl index ed5022d7..07a0259a 100644 --- a/cmd/show/wwv.pl +++ b/cmd/show/wwv.pl @@ -29,5 +29,8 @@ while ($f = shift @f) { # next field $to = 10 if !$to; push @out, "Date Hour SFI A K Forecast Logger"; -push @out, Geomag::print($from, $to, $main::systime); +my @in = Geomag::search($from, $to, $main::systime); +for (@in) { + push @out, Geomag::print_item($_); +} return (1, @out); diff --git a/cmd/wwv.pl b/cmd/wwv.pl index e69de29b..c7b79c3a 100644 --- a/cmd/wwv.pl +++ b/cmd/wwv.pl @@ -0,0 +1,9 @@ +# +# WWV command +# +# Copyright (c) 1998 Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +my @f = diff --git a/html/cron.html b/html/cron.html new file mode 100644 index 00000000..adb9320a --- /dev/null +++ b/html/cron.html @@ -0,0 +1,151 @@ + + + + Crontab - doing things periodically + + + + + + + + + +
+

Crontab - doing things periodically

+
+
+ + +
Dirk Koopman G1TLH
+

+ + +Last modified: Mon Dec 28 01:06:43 GMT 1998 + +

Introduction

+ + There are a number of jobs that need to be done periodically. The + principle one being starting connections to other clusters if you are + not connected. The crontab allows you to do this. + +

Location

+ + There two locations for the crontab files. The first and standard one (which + in common with other 'issue' files should not be changed) lives at /spider/cmd/crontab. + The sysop changable one lives at /spider/local_cmd/crontab. + +

The files will automatically be re-read whenever you change them. + +

The Crontab File

+ + The crontab file defines what is to be done and + when. It consists of lines of text created by your favorite editor. Completely blank + lines or lines starting with '#' are ignored. + +

Each line of a crontab file contains six fields + each separated with white space. The first five fields are times when the + command is to be executed and the last field is the command + itself. The time fields consist of:- + +

+ + + + + + +
fieldAllowed Values
minute0 - 59
hour0 - 23
day of month1 - 31
month1 - 12
day of week0 - 6 (0 is Sunday)
+ +

A field may be '*', which means 'any when' for that field. + +

Ranges of numbers are allowed. Ranges are two numbers + separated with a hyphen. The specified range is inclusive. For + example, 8-11 for an hours entry specifies execution at hours + 8, 9, 10 and 11. + +

Lists are allowed. A list is a set of numbers (or ranges) + separated by commas. Examples: 1,2,5,9 or 0-3,5,8-12. + +

Commands are actually small snippets of perl. They can be anything legal within + perl and the context of the DXSpider cluster.pl daemon. The normal use will be connecting + to another cluster and a set of routines are specially provided in the context + of the DXCron package to make this easy. For example +

+  start_connect('gb7tlh') if !connected('gb7tlh')
+    
+ will attempt to start a connection process to GB7TLH if it isn't + already locally connected. + +

There is absolutely no reason why you could not do something more complicated using information + contained inside the DXSpider daemon, but this will obviously require a more complex line of code. + You can also write your own functions, include them within the DXSpider system and call them from + the crontab + +

A full crontab file could like like:- +

+  #
+  # This is a sample crontab file 
+  #
+  #
+  # check every 10 minutes to see if gb7tlh is connected and if not
+  # start a connect job going
+
+  0,10,20,30,40,50 * * * * start_connect('gb7tlh') if !connected('gb7tlh')
+
+  # at 03:15 on Sundays start a job called 'analyse.pl' which does something
+  # or other. This starts a new process and runs to completion, be careful
+  # what you do with stdin and stdout as they are the same as those of
+  # cluster.pl 
+
+  15 3 * * 0 spawn('/spider/local/analyse.pl')
+
+  # this is a pointless command which will echo the string shown
+  # on the same terminal as the cluster.pl program after substituting
+  # the values for mycall and version
+ 
+  15,30 * * * spawn("echo $main::mycall is a DXSpider Version $main::version DX Cluster system")
+	
+ + It is important remember that these crontab routines execute in line with the main + cluster code, so if you create a long, slow crontab commands, it will impact on the speed + and usability of the cluster as a whole. + +

Standard Routines

+ + As mentioned earlier, there are a small number of routines that are declared in DXCron + context. They are there basically to make the starting of connections and external programs easy. + They are:- + +
    +

  • connected(<callsign>) - returns true if the <callsign> is directly connected + to this cluster node. +

  • start_connect(<script-name>) - starts a connection + script just as if you had typed in connect script-name on the sysop console client. +

  • spawn(<command>) - start a <command> as a new process. This is used to do + various batch jobs that you may wish to happen at certain times of the day or week that operate + on your machine but don't require access to the real-time internals of the cluster daemon. You can + execute just about any command you like, but be warned stdin and stdout are + still connected to the same terminal (if any) as the cluster daemon. Any unix command and arguments + can used, see exec in the perl documentation. +
+ +

Caveats

+ + There seems to be an intermittent problem when running + (especially?) with the debugger on. Essentially you will + experience random crashes with nonsensical error messages. I + believe that this is caused by stack tracing trying to work inside + forked processes. + + +

 

+

+


+ + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
+
+ $Id$ + + diff --git a/html/index.html b/html/index.html index 22cad7e4..97eb4c22 100644 --- a/html/index.html +++ b/html/index.html @@ -18,7 +18,7 @@

-Last modified: Wed Dec 23 16:59:32 GMT 1998 +Last modified: Sun Dec 27 20:18:24 GMT 1998

Introduction

@@ -65,6 +65,7 @@ Last modified: Wed Dec 23 16:59:32 GMT 1998
  • Installing the lastest version of CPAN.
  • Explaining the client.pl program.
  • Connecting to other clusters. +
  • Periodic jobs, e.g. starting connection to other clusters.
  • Hop control, network isolation etc.
  • Programming new commands or altering existing ones.
  • Download the software and any patches. diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 8f641a44..d540004e 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -210,6 +210,7 @@ sub state if (@_) { $self->{oldstate} = $self->{state}; $self->{state} = shift; + $self->{func} = '' unless defined $self->{func}; dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n"); } return $self->{state}; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 1c54424e..de591606 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -477,12 +477,14 @@ sub find_cmd_name { return undef; } - if(defined $Cache{$package}->{mtime} && $Cache{$package}->{mtime } <= $mtime) { + if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) { #we have compiled this subroutine already, #it has not been updated on disk, nothing left to do #print STDERR "already compiled $package->handler\n"; ; } else { + delete_package($package) if defined $Cache{$package}{mtime}; + my $fh = new FileHandle; if (!open $fh, $filename) { $errstr = "Syserr: can't open '$filename' $!"; @@ -515,7 +517,7 @@ sub find_cmd_name { delete_package($package); } else { #cache it unless we're cleaning out each time - $Cache{$package}->{'mtime'} = $mtime; + $Cache{$package}{'mtime'} = $mtime; } } diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 961fa3a6..9e4bde71 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -17,11 +17,12 @@ use Carp; use strict; -use vars qw{@crontab $mtime $lasttime}; +use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); -$mtime = 0; +$mtime = 1; $lasttime = 0; +$lastmin = 0; my $fn = "$main::cmd/crontab"; @@ -30,18 +31,26 @@ my $localfn = "$main::localcmd/crontab"; # cron initialisation / reading in cronjobs sub init { - my $t; - - if (-e $localfn) { - if (-e $localfn && ($t = -M $localfn) != $mtime) { + if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) { + my $t; + + @crontab = (); + + # first read in the standard one + if (-e $fn) { + $t = -M $fn; + + cread($fn); + $mtime = $t if $t <= $mtime; + } + + # then read in any local ones + if (-e $localfn) { + $t = -M $localfn; + cread($localfn); - $mtime = $t; + $mtime = $t if $t <= $mtime; } - return; - } - if (($t = -M $fn) != $mtime) { - cread($fn); - $mtime = $t; } } @@ -52,14 +61,13 @@ sub cread my $fh = new FileHandle; my $line = 0; - dbg('cron', "reading $fn\n"); - open($fh, $fn) or confess("can't open $fn $!"); - @crontab = (); # clear out the old stuff + dbg('cron', "cron: reading $fn\n"); + open($fh, $fn) or confess("cron: can't open $fn $!"); while (<$fh>) { $line++; - + chomp; next if /^\s*#/o or /^\s*$/o; - my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(.+)$/o; + my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o; next if !$min; my $ref = bless {}; my $err; @@ -72,9 +80,9 @@ sub cread if (!$err) { $ref->{cmd} = $cmd; push @crontab, $ref; - dbg('cron', "adding $_\n"); + dbg('cron', "cron: adding $_\n"); } else { - dbg('cron', "error on line $line '$_'\n"); + dbg('cron', "cron: error on line $line '$_'\n"); } } close($fh); @@ -111,6 +119,8 @@ sub parse push @req, 0 + $_; } } + $ref->{$sort} = \@req; + return 0; } @@ -118,13 +128,95 @@ sub parse sub process { my $now = $main::systime; + return if $now-$lasttime < 1; - if ($now - $lasttime >= 60) { - my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($main::systime))[0-4,6]; + my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6]; + + # are we at a minute boundary? + if ($min != $lastmin) { - $lasttime = $now; + # read in any changes if the modification time has changed + init(); + + $mon += 1; # months otherwise go 0-11 + my $cron; + foreach $cron (@crontab) { + if ((!$cron->{min} || grep $_ eq $min, @{$cron->{min}}) && + (!$cron->{hour} || grep $_ eq $hour, @{$cron->{hour}}) && + (!$cron->{mday} || grep $_ eq $mday, @{$cron->{mday}}) && + (!$cron->{mon} || grep $_ eq $mon, @{$cron->{mon}}) && + (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}}) ){ + + if ($cron->{cmd}) { + dbg('cron', "cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'"); + eval "$cron->{cmd}"; + dbg('cron', "cron: cmd error $@") if $@; + } + } + } + } + + # remember when we are now + $lasttime = $now; + $lastmin = $min; +} + +# +# these are simple stub functions to make connecting easy in DXCron contexts +# + +sub connected +{ + my $call = uc shift; + return DXChannel->get($call); +} + +sub start_connect +{ + my $call = uc shift; + my $lccall = lc $call; + + my $prog = "$main::root/local/client.pl"; + $prog = "$main::root/perl/client.pl" if ! -e $prog; + + my $pid = fork(); + if (defined $pid) { + if (!$pid) { + # in child, unset warnings, disable debugging and general clean up from us + $^W = 0; +# do "$main::root/perl/Disable_debug.pl"; + eval "{ package DB; sub DB {} }"; + alarm(0); + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + exec $prog, $call, 'connect'; + dbg('cron', "exec '$prog' failed $!"); + } + dbg('cron', "connect to $call started"); + } else { + dbg('cron', "can't fork for $prog $!"); } } +sub spawn +{ + my $line = shift; + + my $pid = fork(); + if (defined $pid) { + if (!$pid) { + # in child, unset warnings, disable debugging and general clean up from us + $^W = 0; +# do "$main::root/perl/Disable_debug.pl"; + eval "{ package DB; sub DB {} }"; + alarm(0); + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + exec "$line"; + dbg('cron', "exec '$line' failed $!"); + } + dbg('cron', "spawn of $line started"); + } else { + dbg('cron', "can't fork for $line $!"); + } +} 1; __END__ diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 8a12b05c..9c5633e1 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -50,7 +50,7 @@ sub print \$count++; next if \$count < $from; push \@out, print_item(\$ref); - last LOOP if \$count >= \$to; # stop after n + last if \$count >= \$to; # stop after n } } ); @@ -58,8 +58,7 @@ sub print $self->close; # close any open files my $fh = $self->open(@date); -LOOP: - while ($count < $to) { + for ($count = 0; $count < $to; ) { my @spots = (); if ($fh) { while (<$fh>) { @@ -67,13 +66,14 @@ LOOP: push @in, [ split '\^' ]; } eval $eval; # do the search on this file - return ("Spot search error", $@) if $@; + last if $count >= $to; # stop after n + return ("Log search error", $@) if $@; } $fh = $self->openprev(); # get the next file last if !$fh; } - - return @out; + + return @out if defined @out; } # diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 27416fab..8bd96984 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -177,7 +177,7 @@ sub normal $spotdup{$dupkey} = $d; - my $spot = Spot::add($freq, $field[2], $d, $text, $spotter); + my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]); # send orf to the users if ($spot && $pcno == 11) { @@ -381,8 +381,32 @@ sub normal last SWITCH; } - if ($pcno == 25) { - last SWITCH; + if ($pcno == 25) { # merge request + unless ($field[1] eq $main::mycall) { + dbg('chan', "merge request to $field[1] from $field[2] ignored"); + return; + } + + Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[1]"); + + # spots + if ($field[3] > 0) { + my @in = reverse Spot::search(1, undef, undef, 0, $field[3]-1); + my $in; + foreach $in (@in) { + $self->send(pc26(@{$in}[0..4], $in->[7])); + } + } + + # wwv + if ($field[4] > 0) { + my @in = reverse Geomag::search(0, $field[4], time, 1); + my $in; + foreach $in (@in) { + $self->send(pc27(@{$in})); + } + } + return; } if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index a1dca223..7afb0e92 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -153,6 +153,23 @@ sub pc24 return "PC24^$call^$flag^$hops^"; } + +# create a merged dx message (freq, dxcall, t, text, spotter, orig-node) +sub pc26 +{ + my ($freq, $dxcall, $t, $text, $spotter, $orignode) = @_; + $text = ' ' unless $text; + $orignode = $main::mycall unless $orignode; + return sprintf "PC26^%.1f^$dxcall^%s^%s^$text^$spotter^$orignode^ ^~", $freq, cldate($t), ztime($t); +} + +# create a merged WWV spot (logger, t, sfi, a, k, forecast, orig-node) +sub pc27 +{ + my ($logger, $t, $sfi, $a, $k, $forecast, $orignode) = @_; + return sprintf "PC27^%s^%-2.2s^$sfi^$a^$k^$forecast^$logger^$orignode^ ^~", cldate($t), ztime($t); +} + # message start (fromnode, tonode, to, from, t, private, subject, origin) sub pc28 { @@ -168,7 +185,8 @@ sub pc28 sub pc29 { my ($fromnode, $tonode, $stream, $text) = @_; - $text =~ s/\^//og; # remove ^ + $text =~ s/\^/:/og; # remove ^ + $text =~ s/\~/S/og; return "PC29^$fromnode^$tonode^$stream^$text^~"; } diff --git a/perl/DXVars.pm b/perl/DXVars.pm index 4d208b1b..ab43ca64 100644 --- a/perl/DXVars.pm +++ b/perl/DXVars.pm @@ -87,4 +87,4 @@ $userfn = "$data/users"; $motd = "$data/motd"; # are we debugging ? -@debug = ('chan', 'state', 'msg'); +@debug = ('chan', 'state', 'msg', 'cron'); diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 1a118fe0..8b0d2ea7 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -140,7 +140,7 @@ sub forecast # # This command outputs a list of n lines starting from line $from to $to # -sub print +sub search { my $from = shift; my $to = shift; @@ -160,7 +160,7 @@ sub print if ($search) { \$count++; next if \$count < \$from; - push \@out, print_item(\$ref); + push \@out, \$ref; last if \$count >= \$to; # stop after n } } @@ -169,8 +169,7 @@ sub print $fp->close; # close any open files my $fh = $fp->open(@date); -LOOP: - while ($count < $to) { + for ($count = 0; $count < $to; ) { my @in = (); if ($fh) { while (<$fh>) { @@ -178,7 +177,7 @@ LOOP: push @in, [ split '\^' ] if length > 2; } eval $eval; # do the search on this file - return ("Spot search error", $@) if $@; + return ("Geomag search error", $@) if $@; last if $count >= $to; # stop after n } $fh = $fp->openprev(); # get the next file diff --git a/perl/Spot.pm b/perl/Spot.pm index 5831e9b3..efdf16ed 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -41,23 +41,28 @@ sub prefix sub add { my @spot = @_; # $freq, $call, $t, $comment, $spotter = @_ - + my @out = @spot[0..4]; # just up to the spotter + # 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; - - # add the 'dxcc' country on the end - my @dxcc = Prefix::extract($spot[1]); - push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0; + # remove ssids if present on spotter + $out[4] =~ s/-\d+$//o; + + # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call + my @dxcc = Prefix::extract($out[1]); + push @out, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0; + @dxcc = Prefix::extract($out[4]); + push @out, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0; + push @out, $spot[5]; + - my $buf = join("\^", @spot); + my $buf = join("\^", @out); # 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); + $fp->writeunix($out[2], $buf); return $buf; } @@ -127,7 +132,6 @@ sub search $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; diff --git a/perl/cluster.pl b/perl/cluster.pl index d2ae39d2..5e5d18f3 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -50,7 +50,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.16"; # the version no of the software +$version = "1.17"; # the version no of the software $starttime = 0; # the starting time of the cluster # handle disconnections @@ -151,6 +151,7 @@ sub cease # the reaper of children sub reap { + $SIG{'CHLD'} = \&reap; my $cpid = wait; } @@ -268,6 +269,9 @@ DXMsg::clean_old(); print "reading cron jobs\n"; DXCron->init(); +# print various flags +#print "useful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P\n"; + # this, such as it is, is the main loop! print "orft we jolly well go ...\n"; for (;;) { -- 2.34.1