--- deliantra/server/ext/dm-support.ext 2007/04/17 10:38:28 1.4 +++ deliantra/server/ext/dm-support.ext 2007/10/01 00:44:43 1.13 @@ -1,5 +1,6 @@ #! perl +use Coro::Debug; use IO::Socket; use Storable qw/nfreeze thaw/; @@ -8,15 +9,13 @@ sub tcp_serve($) { my ($fh) = @_; - select $fh; - binmode $fh, ":raw:perlio:utf8"; my $buf; my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z); my (%l, @l); # for use by shell users - print < "; + print $fh "\n> "; Event->io (fd => $fh, poll => 'r', data => 0, cb => sub { if (defined (my $cmd = <$fh>)) { $cmd =~ s/\s+$//; if ($cmd =~ /^\s*exit\b/i) { - print "will not exit() server.\n"; + print $fh "will not exit() server.\n"; + } elsif ($cmd =~ s/^coro\s+// or $cmd =~ /^(?:ps|bt\s)/) { + select $fh; + Coro::Debug::command $cmd; + select STDOUT; } else { my $sub = sub { package cf; @@ -56,16 +64,21 @@ print "evaluation error: $@\n" if $@; print "result:\n", cf::dumpval @res > 1 ? \@res : $res[0] if @res; print "\n> "; + + select STDOUT; }; if ($cmd =~ s/\s*&$//) { - Coro::async_pool { $sub->() }; + cf::async { + $Coro::current->desc ($cmd); + $sub->() + }; } else { $sub->(); } } - print "\n> "; + print $fh "\n> "; } else { $_[0]->w->cancel; } @@ -78,3 +91,5 @@ Event->io (fd => $listen, poll => 'r', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept }); } } + +