--- deliantra/server/ext/dm-support.ext	2007/01/12 01:29:23	1.3
+++ deliantra/server/ext/dm-support.ext	2010/05/04 21:45:42	1.30
@@ -1,7 +1,7 @@
 #! perl
 
+use Coro::Debug;
 use IO::Socket;
-use Storable qw/nfreeze thaw/;
 
 my %global; # for use by eval'ed commands
 
@@ -14,37 +14,87 @@
    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 in the main coro context within cf::!\n",
-             "You can freely use \$a .. \$z and \@l and \%l\n";
+   print $fh <<EOF;
+Welcome!
+Remember that everything entered here will be in the main coro context within cf::!
+You can freely use \$a .. \$z and \@l and \%l
+
+Useful commands (note the '&'):
+
+reload_perl &
+reload_sound &
+reload_config &
+reload_regions &
+reload_facedata &
+reload_treasures &
+reload_archetypes &
+reload_resources &
+ext::help::reload &
+ext::books::reload &
+ext::map_tags::reload &
+ext::map_world::reload &
+# ext::map_scheduler::loadall & # debugging only!
+while (EV::TIMEOUT & Coro::EV::timed_io_once \$fh, EV::READ, 1) { Coro::Debug::command "ps" } &
+({mallinfo})
+({objinfo})
+EOF
    print $fh "\n> ";
 
-   Event->io (fd => $fh, poll => 'r', data => 0, cb => sub {
+   my $iow; $iow = AE::io $fh, 0, sub {
       if (defined (my $cmd = <$fh>)) {
-         my $old_fh = select $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 {
-            package cf;
-            my @res = eval $cmd;
-            warn "tcpshell evaluation error: $@" if $@;
-            print $@ if $@;
-
-            print cf::dumpval @res > 1 ? \@res : $res[0] if @res;
+            my $sub = sub {
+               package cf;
+               select $fh;
+
+               # compile first, then execute, as Coro does not support switching in eval string
+               my $cb = eval "sub { $cmd \n}";
+
+               my $t1 = Time::HiRes::time;
+               my @res = $@ ? () : eval { $cb->() };
+               my $t2 = Time::HiRes::time;
+
+               print "\n",
+                     "command: '$cmd'\n",
+                     "execution time: ", $t2 - $t1, "\n";
+               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;
+         print $fh "\n> ";
       } else {
-         $_[0]->w->cancel;
+         undef $iow;
       }
-   });
+   };
 }
 
+our $LISTENER;
+
 # now a shell listening on a tcp-port - let the firewall decide access rights
 if ($cf::CFG{perl_shell}) {
-   if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1) {
-      Event->io (fd => $listen, poll => 'r', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept });
+   if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1, Blocking => 0) {
+      $LISTENER = AE::io $listen, 0, sub { tcp_serve $listen->accept };
    }
 }
+