From: Dirk Koopman Date: Sat, 14 Sep 2013 13:08:50 +0000 (+0100) Subject: add more Mojo converted stuff X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=61e7e8734559481ea454bb3facca88139e51addd;p=spider.git add more Mojo converted stuff --- diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ad9baad0..68027807 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -793,7 +793,7 @@ sub find_cmd_name { #we have compiled this subroutine already, #it has not been updated on disk, nothing left to do #print STDERR "already compiled $package->handler\n"; - ; + dbg("find_cmd_name: $package cached") if isdbg('command'); } else { my $sub = readfilestr($filename); diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index f3f473ab..19aa3b47 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -54,11 +54,8 @@ sub enqueue sub send_raw { my ($conn, $msg) = @_; - my $sock = $conn->{sock}; - return unless defined($sock); - push (@{$conn->{outqueue}}, $msg); - dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); - Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); + dbg((ref $conn) . " connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); + $conn->SUPER::send_raw($msg); } sub echo @@ -154,57 +151,21 @@ sub to_connected $conn->{timeout}->del if $conn->{timeout}; delete $conn->{timeout}; $conn->{csort} = $sort; - unless ($conn->ax25) { - eval {$conn->{peerhost} = $conn->{sock}->peerhost}; - $conn->nolinger; - } &{$conn->{rproc}}($conn, "$dir$call|$sort"); $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; } sub new_client { + my $server_conn = shift; - my $sock = $server_conn->{sock}->accept(); - if ($sock) { - my $conn = $server_conn->new($server_conn->{rproc}); - $conn->{sock} = $sock; - $conn->nolinger; - Msg::blocking($sock, 0); - $conn->{blocking} = 0; - eval {$conn->{peerhost} = $sock->peerhost}; - if ($@) { - dbg($@) if isdbg('connll'); - $conn->disconnect; - } else { - eval {$conn->{peerport} = $sock->peerport}; - $conn->{peerport} = 0 if $@; - my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport}); - dbg("accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll'); - if ($eproc) { - $conn->{eproc} = $eproc; - Msg::set_event_handler ($sock, "error" => $eproc); - } - if ($rproc) { - $conn->{rproc} = $rproc; - my $callback = sub {$conn->_rcv}; - Msg::set_event_handler ($sock, "read" => $callback); - # send login prompt - $conn->{state} = 'WL'; - # $conn->send_raw("\xff\xfe\x01\xff\xfc\x01\ff\fd\x22"); - # $conn->send_raw("\xff\xfa\x22\x01\x01\xff\xf0"); - # $conn->send_raw("\xFF\xFC\x01"); - $conn->_send_file("$main::data/issue"); - $conn->send_raw("login: "); - $conn->_dotimeout(60); - $conn->{echo} = 1; - } else { - &{$conn->{eproc}}() if $conn->{eproc}; - $conn->disconnect(); - } - } - } else { - dbg("ExtMsg: error on accept ($!)") if isdbg('err'); - } + my $client = shift; + my $conn = $server_conn->SUPER::new_client($client); + # send login prompt + $conn->{state} = 'WL'; + $conn->_send_file("$main::data/issue"); + $conn->send_raw("login: "); + $conn->_dotimeout(60); + $conn->{echo} = 1; } sub start_connect diff --git a/perl/Version.pm b/perl/Version.pm index a9a4d35d..27bd1c0f 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -12,6 +12,6 @@ use vars qw($version $subversion $build $gitversion); $version = '1.57'; $subversion = '0'; $build = '1'; -$gitversion = 'e399440'; +$gitversion = '06a6935'; 1; diff --git a/perl/cluster.pl b/perl/cluster.pl index a3e915a6..51d1455b 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -591,6 +591,8 @@ $script->run($main::me) if $script; #open(DB::OUT, "|tee /tmp/aa"); +my $main_loop = Mojo::IOLoop->recurring($idle_interval => \&idle_loop); + Mojo::IOLoop->start; cease(0);