--- cf.schmorp.de/maps/perl/commands.ext	2006/09/14 19:36:17	1.2
+++ cf.schmorp.de/maps/perl/commands.ext	2006/12/15 19:06:29	1.16
@@ -1,12 +1,12 @@
 #! perl
 
+use POSIX ();
+
 # miscellaneous commands
 
 sub rename_to($$$) {
    my ($ob, $from, $to) = @_;
 
-   warn "<$ob|$from|$to>\n";#d#
-
    $to =~ /^[a-zA-Z0-9.,=#\/%$!^]*$/
       or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
 
@@ -35,15 +35,65 @@
 
   $ob->esrv_update_item (cf::UPD_NAME, $item);
 
-  return 1;
+  1
 }
 
-cf::register_command rename => 0, sub {
+sub ext::schmorp_irc::users; # HACK: TODO: replace by signal
+
+sub who_listing(;$) {
+   my ($privileged) = @_;
+
+   my ($numwiz, $numafk) = (0, 0);
+   my @pl;
+
+   foreach my $pl (cf::player::list) {
+      my $ob = $pl->ob;
+
+      next unless $ob->map
+               && ($privileged || !$pl->hidden);
+
+      $numwiz++ if $ob->flag (cf::FLAG_WIZ);
+      $numafk++ if $ob->flag (cf::FLAG_AFK);
+
+      push @pl, $pl;
+   }
+
+   (
+      "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
+      (
+         map {
+            my ($pl, $ob) = ($_, $_->ob);
+    
+            "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
+            . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
+            . ($ob->flag (cf::FLAG_AFK) ? " [AFK]" : "")
+            . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
+            . " [" . $pl->socket->client . "]"
+            . " [" . ($pl->peaceful || $privileged ? $ob->map->path : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"
+            . (sprintf " [rtt %.3fs/%.3f]", $pl->socket->rtt * 1e-6, $pl->socket->rttvar * 1e-6)
+            . ($privileged ? " " . $pl->socket->host : "")
+         } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
+      ),
+      eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
+   )
+}
+
+cf::register_command who => sub {
    my ($ob, $arg) = @_;
 
-   warn "<<<$arg>>>\n";#d#
+   $ob->speed_left ($ob->speed_left - 0.25);
+
+   $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
 
-   if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]+)> \s*$/x) {
+   1
+};
+
+cf::register_command rename => sub {
+   my ($ob, $arg) = @_;
+
+   $ob->speed_left ($ob->speed_left - 0.25);
+
+   if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]*)> \s*$/x) {
       # compatibility syntax
       rename_to $ob, $1, $2;
    } elsif ($arg =~ /
@@ -58,6 +108,19 @@
       # does not unquote $1 or $3
       rename_to $ob, $2||$1, $4||$3;
    } else {
-      $ob->message ('Syntax error. Rename usage: rename ["oldname"] to "newname"');
+      $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
    }
+
+   1
 };
+
+cf::register_command uptime => sub {
+   my ($ob, $arg) = @_;
+
+   my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
+   my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
+   $ob->reply (undef, "server started $startup, uptime ${runtime}\d");
+
+   1
+};
+