X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=54295e4b7beaaec871a50d39187319f5ffd6aeaf;hb=f4bc6091a243be2891148902d41e921e171e1a44;hp=d9827a651fc8daf635f886aae7ef1fd6dbfdf717;hpb=b0dc102f62871b43134807fa254749b1720d326a;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index d9827a65..54295e4b 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -70,7 +70,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.35"; # the version no of the software +$version = "1.40"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name @outstanding_connects = (); # list of outstanding connects @@ -103,9 +103,11 @@ sub rec my ($conn, $msg, $err) = @_; my $dxchan = DXChannel->get_by_cnum($conn); # get the dxconnnect object for this message - if (defined $err && $err) { + if (!defined $msg || (defined $err && $err)) { if ($dxchan) { $dxchan->disconnect; + } elsif ($conn) { + $conn->disconnect; } return; } @@ -113,21 +115,21 @@ sub rec # set up the basic channel info - this needs a bit more thought - there is duplication here if (!defined $dxchan) { my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; - - # is there one already connected to me ? + + # is there one already connected to me - locally? my $user = DXUser->get($call); if (DXChannel->get($call)) { - my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); + my $mess = DXM::msg($lang, ($user && $user->sort eq 'A') ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; } - # is there one already connected elsewhere in the cluster (and not a cluster) + # is there one already connected elsewhere in the cluster? if ($user) { if (($user->sort eq 'A' || $call eq $myalias) && !DXCluster->get_exact($call)) { ; } else { - if (DXCluster->get($call) || DXChannel->get($call)) { + if (DXCluster->get_exact($call)) { my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; @@ -135,7 +137,7 @@ sub rec } $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } else { - if (DXCluster->get($call)) { + if (DXCluster->get_exact($call)) { my $mess = DXM::msg($lang, 'conother', $call); already_conn($conn, $call, $mess); return; @@ -369,11 +371,17 @@ dbg('local', "Local::init error $@") if $@; # this, such as it is, is the main loop! print "orft we jolly well go ...\n"; dbg('chan', "DXSpider version $version started..."); + +open(DB::OUT, "|tee /tmp/aa"); + for (;;) { my $timenow; + $DB::trace = 1; + Msg->event_loop(1, 0.1); $timenow = time; process_inqueue(); # read in lines from the input queue and despatch them + $DB::trace = 0; # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) {