]> dxcluster.org Git - spider.git/commitdiff
1. Various detail changes to remove some more warning with -w on R_1_17
authordjk <djk>
Mon, 28 Dec 1998 01:09:44 +0000 (01:09 +0000)
committerdjk <djk>
Mon, 28 Dec 1998 01:09:44 +0000 (01:09 +0000)
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.

21 files changed:
Changes
cmd/Commands_en.hlp
cmd/connect.pl
cmd/crontab
cmd/show/program.pl [new file with mode: 0644]
cmd/show/qra.pl
cmd/show/station.pl
cmd/show/wwv.pl
cmd/wwv.pl
html/cron.html [new file with mode: 0644]
html/index.html
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXCron.pm
perl/DXLogPrint.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/DXVars.pm
perl/Geomag.pm
perl/Spot.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index a985aed84fbbe581767d72e128f77e3bbbae9870..c2ebb14f904526659e2a7a8929dec57c676d7607 100644 (file)
--- 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 (!)
index 368d57d5610063d7719435c5fd9c44d2af8685ff..b553934ff3ca32d4b47ec142d8629b71692aad3a 100644 (file)
@@ -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 <n> <call> [<call..]^Set privilege level on a call
 Set the privilege level on a callsign. The privilege levels that pertain
 to commands are as default:-
index 93f62b71871d7d90b03c9e910edef02dfef72626..ed6ba9a07a8286dbfd622bc7397af452be741df1 100644 (file)
@@ -16,7 +16,11 @@ $prog = "$main::root/perl/client.pl" if ! -e $prog;
 my $pid = fork();
 if (defined $pid) {
        if (!$pid) {
-               # in child
+               # in child, unset warnings, disable debugging and general clean up from us
+               $^W = 0;
+               eval "{ package DB; sub DB {} }";
+               alarm(0);
+               $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
                exec $prog, $call, 'connect';
        } else {
                return(1, $self->msg('constart', $call));
index b2ebb388aa61a7fe0c9b9ef2f1d97b604143c45b..508faf5bdea3f1982249754e8695db15826af7d2 100644 (file)
@@ -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 (file)
index 0000000..e741646
--- /dev/null
@@ -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);
index fe3f08abc59d555918a2dcf826816bb17aa9ac95..90c5bb1a864231da0fd0fd6b33ef9a8ebea7e10d 100644 (file)
@@ -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;
index 2a7034e164804fabab15fd7fd55b8071bc584ee7..40c7eddbe3d6f59c7805ad9cba07b9a5f7f266eb 100644 (file)
@@ -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);
index ed5022d728d1e131dc62fa4e31bf7849b2feb6b7..07a0259a34af5939b10a3d223f1fd763a4e31bba 100644 (file)
@@ -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);
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..c7b79c3ae132d7a217e9a016467a535ff461bc96 100644 (file)
@@ -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 (file)
index 0000000..adb9320
--- /dev/null
@@ -0,0 +1,151 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+  <head>
+    <title>Crontab - doing things periodically</title>
+  </head>
+
+       <meta name="Keywords" content="DX Cluster, DXSpider, Spider, Packet Cluster, DXCluster, Pavillion Software, AK1A, AX25, AX.25, WWV, Packet Radio, Amateur Radio, Propagation, DX, DXing, G1TLH, GB7TLH, Dirk Koopman, Mailing list, Linux, RedHat, PERL">
+       <meta name="Description" content="Software and systems for realtime digital communications between amateur radio stations for the provision of information on propagation conditions and stations operating">
+       <meta name="Author" content="Dirk Koopman G1TLH">
+  </head>
+
+  <body TEXT="#000000" LINK="#0000ff" VLINK="#800080" BGCOLOR="#FFFFFF">
+       <FONT COLOR="#606060"> 
+         <hr>
+         <h2>Crontab - doing things periodically</h2>
+         <hr>
+       </font>
+       
+       
+       <address><a href="mailto:djk@tobit.co.uk">Dirk Koopman G1TLH</a></address>
+       <p>
+         <!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
+         <!-- hhmts start -->
+Last modified: Mon Dec 28 01:06:43 GMT 1998
+<!-- hhmts end -->
+       <h4>Introduction</h4>
+
+       There are a number of jobs that need to be done periodically. The
+       principle one being starting <a
+       href="connect.html">connections</a> to other clusters if you are
+       not connected. The <tt>crontab</tt> allows you to do this.
+
+       <h4>Location</h4>
+
+       There two locations for the <tt>crontab</tt> files. The first and standard one (which
+       in common with other 'issue' files should not be changed) lives at <b>/spider/cmd/crontab</b>.
+       The sysop changable one lives at <b>/spider/local_cmd/crontab</b>.
+
+       <p>The files will automatically be re-read whenever you change them.
+
+       <h4>The <tt>Crontab</tt> File </h4>
+
+       The <tt>crontab</tt> 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.
+
+       <p>Each line of a <tt>crontab</tt> 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:-
+
+       <p><table border=2>
+         <tr><td>field</td><td>Allowed Values</td></tr>
+         <tr><td>minute</td><td>0 - 59</td></tr>
+         <tr><td>hour</td><td>0 - 23</td></tr>
+         <tr><td>day of month</td><td>1 - 31</td></tr>
+         <tr><td>month</td><td>1 - 12</td></tr>
+         <tr><td>day of week</td><td>0 - 6 (0 is Sunday)</td></tr>
+       </table>
+
+       <p>A field may be '*', which means 'any when' for that field.
+
+    <p>Ranges of numbers are allowed.  Ranges are two numbers
+    separated with a hyphen.  The specified range is inclusive.  For
+    example, 8-11 for an <tt>hours</tt> entry specifies execution at hours
+    8, 9, 10 and 11.
+
+    <p>Lists are allowed.  A list is a set of numbers (or ranges)
+    separated by commas.  Examples: <tt>1,2,5,9</tt> or <tt>0-3,5,8-12</tt>.
+
+       <p>Commands are actually small snippets of perl. They can be anything legal within
+         perl and the context of the DXSpider <tt>cluster.pl</tt> daemon. The normal use will be connecting
+         to another cluster and a set of routines are specially provided in the context
+         of the <tt>DXCron</tt> package to make this easy. For example
+       <pre>
+  start_connect('gb7tlh') if !connected('gb7tlh')
+    </pre>
+       will attempt to start a <a href="connect.html">connection</a>  process to GB7TLH if it isn't
+       already locally connected.
+
+       <p>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 <tt>crontab</tt>
+
+       <p>A full <tt>crontab</tt> file could like like:-
+       <pre>
+  #
+  # 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")
+       </pre>
+
+       It is important remember that these <tt>crontab</tt> routines execute in line with the main
+       cluster code, so if you create a long, slow <tt>crontab</tt> commands, it will impact on the speed
+       and usability of the cluster as a whole.
+
+       <h4>Standard Routines</h4>
+
+       As mentioned earlier, there are a small number of routines that are declared in <tt>DXCron</tt>
+       context. They are there basically to make the starting of connections and external programs easy.
+       They are:-
+
+       <ul>
+               <p><li><b>connected(&lt;callsign>)</b> - returns true if the &lt;callsign> is directly connected
+               to this cluster node.
+               <p><li><b>start_connect(&lt;script-name>)</b> - starts a <a href="connect.html">connection</a>
+               script just as if you had typed in <tt>connect script-name</tt> on the sysop console client.
+               <p><li><b>spawn(&lt;command>)</b> - start a &lt;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 <em>be warned</em> <b>stdin</b> and <b>stdout</b> are
+               still connected to the same terminal (if any) as the cluster daemon. Any unix command and arguments
+               can used, see <tt>exec</tt> in the <a href="http://www.perl.com">perl</a> documentation.
+       </ul>
+
+       <h4>Caveats</h4>
+       
+       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
+       <tt>forked</tt> processes.
+
+<!-- Standard Footer!! -->
+       <p>&nbsp;</p>
+       <p>
+         <FONT COLOR="#606060"><hr></font>
+       <font color="#FF0000" size=-2>
+         Copyright &copy; 1998 by Dirk Koopman G1TLH. All Rights Reserved<br>
+       </font>
+       <font color="#000000" size=-2>$Id$</font>
+  </body>
+</html>
index 22cad7e41974b8dcec8ee9cbb2659e46f3af5a2a..97eb4c22116a3e893124d8d636357d36f914566c 100644 (file)
@@ -18,7 +18,7 @@
        <p>
        <!-- Created: Wed Dec  2 18:22:33 GMT 1998 -->
        <!-- hhmts start -->
-Last modified: Wed Dec 23 16:59:32 GMT 1998
+Last modified: Sun Dec 27 20:18:24 GMT 1998
 <!-- hhmts end -->
 
        <h4>Introduction</h4>
@@ -65,6 +65,7 @@ Last modified: Wed Dec 23 16:59:32 GMT 1998
          <li> Installing the lastest version of <a href="cpan.html">CPAN</a>.
          <li> Explaining the <a href="client.html">client.pl</a> program.
          <li> <a href="connect.html">Connecting</a> to other clusters.
+         <li> <a href="cron.html">Periodic</a> jobs, e.g. starting connection to other clusters.
          <li> <a href="hops.html">Hop</a> control, network <a href="hops.html#isolate">isolation</a> etc.
          <li> <a href="program.html">Programming</a> new commands or altering existing ones.
          <li> <a href="../download/">Download</a> the software and any patches.
index 8f641a443c5d497dedb5322a077da674bb986a12..d540004e638f2c9ad2051dc487a37433f50f5549 100644 (file)
@@ -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};
index 1c54424e0744e8457700fbc77634f74cac072445..de59160663c080356a11a354c5a52b098f0f3ea1 100644 (file)
@@ -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;
                }
        }
        
index 961fa3a60df61c6aab1a096c16ef8412ba8e2806..9e4bde71e9083c5b5c7e9c45a4522c98251ebb3f 100644 (file)
@@ -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__
index 8a12b05c2791aa3f137fc13ce4f821f1dde5e528..9c5633e1fbf2d3bb085d8eeec62c4bf267ebd3b5 100644 (file)
@@ -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;
 }
 
 #
index 27416fab8e36952cd442263605024c3dd4dde1fb..8bd96984b3278837974d71d6600c91859cf0cd2f 100644 (file)
@@ -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
index a1dca22391ace8c49b762d942b645bafbb1fe8f1..7afb0e92af1241c134908c04348bbfb857a581d7 100644 (file)
@@ -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^~";
 }
 
index 4d208b1b57bbf8233dbe3289e24ece4d709ccb49..ab43ca6489195ae63c7f3f8f87de45f3b4ff8cb8 100644 (file)
@@ -87,4 +87,4 @@ $userfn = "$data/users";
 $motd = "$data/motd";
 
 # are we debugging ?
-@debug = ('chan', 'state', 'msg');
+@debug = ('chan', 'state', 'msg', 'cron');
index 1a118fe07a869d5d60efb020556bda7180928092..8b0d2ea7f4cd0933757ed90f6ac68d174ca9bd3b 100644 (file)
@@ -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
index 5831e9b31d974ec2ad3c9e14d560b3c42fc34e99..efdf16ed4edcb3947ca144103c49f7da84db66f8 100644 (file)
@@ -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;         
index d2ae39d2b7c6fb21abd980108a030b60e2dab8f8..5e5d18f3e65271bf991ee1f05185ebb15f6060e7 100755 (executable)
@@ -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 (;;) {