#! perl use POSIX (); # miscellaneous commands sub rename_to($$$) { my ($ob, $from, $to) = @_; $to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/ or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things."); 127 >= length $to or return $ob->message ("rename: new name must be <= 127 characters."); my $item; if (length $from) { $item = $ob->find_best_object_match ($from) or return $ob->message ("rename: could not find a matching item to rename."); } else { $item = $ob->find_marked_object () or return $ob->message ("rename: no from name and no marked item found to rename."); } $item->custom_name (length $to ? $to : undef); if (length $to) { $item->custom_name ($to); $ob->message ("Your " . $item->base_name . " will now be called $to."); } else { $item->custom_name (undef); $ob->message ("You stop calling your " . $item->base_name . " with weird names."); } $ob->esrv_update_item (cf::UPD_NAME, $item); 1 } 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 $ns = $pl->ns or next; my $ob = $pl->ob; next unless $ob->map && ($privileged || !$pl->hidden); $numwiz++ if $ob->flag (cf::FLAG_WIZ); $numafk++ if $ns->afk; push @pl, $pl; } ( "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)", ( map { my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns); "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title) . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]") . ($ns->afk ? " [AFK]" : "") . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "") . " [" . $pl->ns->version . "]" . " [" . ($pl->peaceful || $privileged ? $ob->map->{path}->visible_name : $ob->map->region ? $ob->map->region->name : "the unknown") . "]" . (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6) . ($privileged ? " " . $pl->ns->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) = @_; $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); 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 =~ / ^\s* (?: (?: "((?:[^"]+|\\.)*)" | (\S+) ) \s+)? to \s+ (?: "((?:[^"]+|\\.)*)" | (\S+) ) \s*$ /x) { # does not unquote $1 or $3 rename_to $ob, $2||$1, $4||$3; } else { $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 }; my %IN_MEMORY = ( cf::MAP_IN_MEMORY => "I", cf::MAP_SWAPPED => "S", cf::MAP_LOADING => "L", ); cf::register_command maps => sub { my ($ob, $arg) = @_; no re 'eval'; $arg = qr<$arg>; my $format = "%2s %1s %3s %5s %.60s\n"; $ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK | cf::NDI_UNIQUE); for (sort keys %cf::MAP) { my $map = $cf::MAP{$_} or next; next unless $map->path =~ $arg; next if $map->{path}->is_style_map; my $svd = int $cf::RUNTIME - $map->{last_save}; $svd = "++" if $svd > 99; $ob->reply (undef, (sprintf $format, (scalar $map->players), $IN_MEMORY{$map->in_memory} || "?", $svd, (int $map->reset_at - $cf::RUNTIME), $map->{path}->visible_name), cf::NDI_BLACK | cf::NDI_UNIQUE); } 1 };