--- deliantra/server/ext/dm-support.ext 2007/01/09 15:36:18 1.2 +++ deliantra/server/ext/dm-support.ext 2007/09/30 22:33:52 1.12 @@ -1,5 +1,6 @@ #! perl +use Coro::Debug; use IO::Socket; use Storable qw/nfreeze thaw/; @@ -14,30 +15,70 @@ 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 $fh "Welcome!\n", - "Remember that everything entered here will be executed as a sync_job in cf::!\n", - "You can freely use \$a .. \$z and \@l and \%l\n"; + print $fh < "; - Event->io (fd => $fh, poll => 'r', data => cf::WF_AUTOCANCEL, cb => sub { + Event->io (fd => $fh, poll => 'r', data => 0, cb => sub { if (defined (my $cmd = <$fh>)) { - my $old_fh = select $fh; + $cmd =~ s/\s+$//; + select $fh; if ($cmd =~ /^\s*exit\b/i) { print "will not exit() server.\n"; + } elsif ($cmd =~ s/^coro\s+// or $cmd =~ /^(?:ps|bt\s)/) { + Coro::Debug::command $cmd; } else { - cf::sync_job { + my $sub = sub { package cf; - my @res = eval $cmd; - warn "tcpshell evaluation error: $@" if $@; - print $@ if $@; + select $fh; - print cf::dumpval @res > 1 ? \@res : $res[0] if @res; + # compile first, the execute, as Coro does not support switching in eval string + my $cb = eval "sub { $cmd }"; + + my $t1 = Time::HiRes::time; + my @res = $@ ? () : eval { $cb->() }; + my $t2 = Time::HiRes::time; + + print "\n", + "command: '$cmd'\n", + "execution time: ", $t2 - $t1, "\n"; + warn "evaluation error: $@" if $@; + 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*&$//) { + cf::async { + $Coro::current->desc ($cmd); + $sub->() + }; + } else { + $sub->(); + } } print "\n> "; - select $old_fh; + select STDOUT; } else { $_[0]->w->cancel; } @@ -50,3 +91,5 @@ Event->io (fd => $listen, poll => 'r', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept }); } } + +