X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=42dbe2a5d6053d951db5cff878df0e8cae8e6652;hb=61660841afb3901002602e4956f09de5567bc950;hp=94c1cad0450573d6399a08fdc5ab3c4c9c57515b;hpb=a3fd9341b7ce57dcc058b82cfba3f40f15631241;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 94c1cad0..42dbe2a5 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -12,8 +12,7 @@ use DXVars; use DXUtil; use DXM; use DXDebug; -use FileHandle; -use Carp; +use IO::File; use strict; @@ -58,7 +57,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"); @@ -218,14 +217,7 @@ 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; - } + $dxchan->disconnect if $dxchan; } # start a connect process off @@ -234,28 +226,15 @@ 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; - eval "{ package DB; sub DB {} }"; - $SIG{HUP} = 'IGNORE'; - alarm(0); - DXChannel::closeall(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec $prog, $call, 'connect' or dbg('cron', "exec '$prog' failed $!"); - } - dbg('cron', "connect to $call started"); + if (Msg->conns($call)) { + dbg('cron', "Connect not started, outstanding connect to $call"); + return; + } + if (-e "$main::root/connect/$lccall") { + ExtMsg::start_connect($call, "$main::root/connect/$lccall"); } else { - dbg('cron', "can't fork for $prog $!"); + dbg('err', "Cannot find connect script for $lccall"); } - - # coordinate - sleep(1); } # spawn any old job off @@ -269,10 +248,15 @@ sub spawn # in child, unset warnings, disable debugging and general clean up from us $^W = 0; eval "{ package DB; sub DB {} }"; - $SIG{HUP} = 'IGNORE'; - alarm(0); DXChannel::closeall(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + for (@main::listeners) { + $_->close_server; + } + unless ($main::is_win) { + $SIG{HUP} = 'IGNORE'; + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + alarm(0); + } exec "$line" or dbg('cron', "exec '$line' failed $!"); } dbg('cron', "spawn of $line started"); @@ -295,7 +279,7 @@ sub rcmd return if !$noderef || !$noderef->pcversion; # send it - DXProt::addrcmd($main::mycall, $call, $line); + DXProt::addrcmd($DXProt::me, $call, $line); } 1; __END__