X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=c0565fa1e9e8268b2c3c8aed8719398227f91409;hb=d9db74c1b2b9b57cb6d31e8c8c425f3636f62f87;hp=3c9c04fb8bb015a7fb37a5c2cc541c55832fdfc5;hpb=5d197c9f7aa2ea796d86aa5473f93956b24cf1b7;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 3c9c04fb..c0565fa1 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -12,7 +12,7 @@ use DXVars; use DXUtil; use DXM; use DXDebug; -use FileHandle; +use IO::File; use Carp; use strict; @@ -20,7 +20,7 @@ use strict; use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); -$mtime = 1; +$mtime = 0; $lasttime = 0; $lastmin = 0; @@ -41,7 +41,7 @@ sub init $t = -M $fn; cread($fn); - $mtime = $t if $t <= $mtime; + $mtime = $t if !$mtime || $t <= $mtime; } # then read in any local ones @@ -58,7 +58,7 @@ sub init sub cread { my $fn = shift; - my $fh = new FileHandle; + my $fh = new IO::File; my $line = 0; dbg('cron', "cron: reading $fn\n"); @@ -165,12 +165,70 @@ sub process # these are simple stub functions to make connecting easy in DXCron contexts # +# is it locally connected? sub connected { my $call = uc shift; return DXChannel->get($call); } +# is it remotely connected anywhere (with exact callsign)? +sub present +{ + my $call = uc shift; + return DXCluster->get_exact($call); +} + +# is it remotely connected anywhere (ignoring SSIDS)? +sub presentish +{ + my $call = uc shift; + return DXCluster->get($call); +} + +# is it remotely connected anywhere (with exact callsign) and on node? +sub present_on +{ + my $call = uc shift; + my $node = uc shift; + my $ref = DXCluster->get_exact($call); + return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; +} + +# is it remotely connected anywhere (ignoring SSIDS) and on node? +sub presentish_on +{ + my $call = uc shift; + my $node = uc shift; + my $ref = DXCluster->get($call); + return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; +} + +# last time this thing was connected +sub last_connect +{ + my $call = uc shift; + return $main::systime if DXChannel->get($call); + my $user = DXUser->get($call); + return $user ? $user->lastin : 0; +} + +# disconnect a locally connected thing +sub disconnect +{ + my $call = uc shift; + my $dxchan = DXChannel->get($call); + if ($dxchan) { + if ($dxchan->is_ak1a) { + $dxchan->send_now("D", DXProt::pc39($main::mycall, "$main::mycall DXCron")); + } else { + $dxchan->send_now('D', ""); + } + $dxchan->disconnect; + } +} + +# start a connect process off sub start_connect { my $call = uc shift; @@ -189,8 +247,7 @@ sub start_connect alarm(0); DXChannel::closeall(); $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec $prog, $call, 'connect'; - dbg('cron', "exec '$prog' failed $!"); + exec $prog, $call, 'connect' or dbg('cron', "exec '$prog' failed $!"); } dbg('cron', "connect to $call started"); } else { @@ -201,6 +258,7 @@ sub start_connect sleep(1); } +# spawn any old job off sub spawn { my $line = shift; @@ -215,8 +273,7 @@ sub spawn alarm(0); DXChannel::closeall(); $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec "$line"; - dbg('cron', "exec '$line' failed $!"); + exec "$line" or dbg('cron', "exec '$line' failed $!"); } dbg('cron', "spawn of $line started"); } else { @@ -226,5 +283,19 @@ sub spawn # coordinate sleep(1); } + +# do an rcmd to another cluster from the crontab +sub rcmd +{ + my $call = uc shift; + my $line = shift; + + # can we see it? Is it a node? + my $noderef = DXCluster->get_exact($call); + return if !$noderef || !$noderef->pcversion; + + # send it + DXProt::addrcmd($main::mycall, $call, $line); +} 1; __END__