server/ext/commands.ext

#! 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->visible_name : $ob->region->name) . "]"
            . (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 body => sub {
   my ($ob) = @_;

   my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head",
      "around your neck", "in your skill slot", "on your finger", "around your shoulders",
      "on your feet", "on your hands", "around your wrists", "around your waist");

   # Too hard to try and make a header that lines everything up, so just
   # give a description. (comment from C++)
   $ob->reply (undef, "The first column is the name of the body location.");
   $ob->reply (undef, "The second column is how many of those locations your body has.");
   $ob->reply (undef, "The third column is how many slots in that location are available.");

   for (0 .. scalar @body_locations - 1) {
      $ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_)))
         if $ob->body_info($_) or $ob->body_used($_);
   }

   $ob->reply (undef, "You are not allowed to wear armor")
      unless $ob->flag (cf::FLAG_USE_ARMOUR);
   $ob->reply (undef, "You are not allowed to use weapons")
      unless $ob->flag (cf::FLAG_USE_WEAPON);

   1
};

cf::register_command mark => sub {
   my ($pl, $arg) = @_;

   if (length $arg) {
      my $ob = $pl->find_best_object_match ($arg);

      return $pl->reply (undef, "Could not find an object that matches $arg")
         unless $ob;

      $pl->contr->mark ($ob);
      $pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
   } else {
      my $ob = $pl->find_marked_object;

      $pl->reply (undef, $ob
         ? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
         : "You have no marked object.");
   }

   1
};

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
};

for my $cmd ("run", "fire") {
   my $oncmd = "${cmd}_on";
   cf::register_command $cmd => sub {
      my ($ob, $arg) = @_;

      $ob->contr->$oncmd (1);

      return $ob->reply (undef, "Can't $cmd into a non adjacent square.")
         if $arg < 0 or $arg >= 9;

      $ob->move ($arg);
      
      1
   };

   cf::register_command "${cmd}_stop" => sub {
      my ($ob) = @_;
      
      $ob->contr->$oncmd (0);

      1
   };
}

cf::register_command mapinfo => sub {
   my ($ob) = @_;

   my $map = $ob->map
      or return;
   $ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
   $ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
         $map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
      if $ob->flag (cf::FLAG_WIZ);
   $ob->reply (undef, $map->msg);

   1
};

cf::register_command whereami => sub {
   my ($ob) = @_;

   my $reg = $ob->region;
   $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));

   1
};

sub _set_mode($$$@) {
   my ($name, $ob, $arg, $slot, @choices) = @_;

   my $oldmode = $ob->contr->$slot;

   return $ob->reply (undef, "$name is set to $choices[$oldmode]")
      unless $arg;

   my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
      or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;

   $ob->contr->$slot ($idx);
   $ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
}

cf::register_command applymode => sub {
   my ($ob, $arg) = @_;

   _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);

   1
};

cf::register_command petmode => sub {
   my ($ob, $arg) = @_;

   _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);

   1
};

cf::register_command usekeys => sub {
   my ($ob, $arg) = @_;

   _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);

   1
};

cf::register_command afk => sub {
   my ($ob, $arg) = @_;

   $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
   $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");

   1
};

cf::register_command sound => sub {
   my ($ob, $arg) = @_;

   $ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
   $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");

   1
};

cf::register_command brace => sub {
   my ($ob, $arg) = @_;

   $ob->contr->braced ($ob->contr->braced ? 0 : 1);
   $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");

   1
};

cf::register_command 'output-count' => sub {
   my ($ob, $arg) = @_;

   return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
      unless $arg > 0;

   $ob->contr->outputs_count ($arg);
   $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);

   1
};

cf::register_command 'output-sync' => sub {
   my ($ob, $arg) = @_;

   return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
      unless $arg > 0;

   $ob->contr->outputs_sync ($arg);
   $ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);

   1
};

# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
# some other level (which may also be 0), this does not get echoed,
# but it does get set.
cf::register_command wimpy => sub {
   my ($ob, $arg) = @_;

   my $wimpy = $ob->run_away;
   return $ob->reply (undef, "Your current wimpy level is $wimpy.")
      if $arg eq "";

   return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
      if $arg =~ /^\d+$/ and $arg <= 100;

   $ob->reply (undef, "Incorrect parameters for wimpy: $arg");

   1
};

cf::register_command peaceful => sub {
   my ($ob, $arg) = @_;

   $ob->reply (undef, "You cannot change your peaceful setting with this command."
                     ." Please speak to the priest in the temple of Gorokh"
                     ." if you want to become hostile or in temple of Valriel"
                     ." if you want to become peaceful again.");

   #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
   #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");

   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->{deny_list};

      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->visible_name),
                  cf::NDI_BLACK | cf::NDI_UNIQUE);
   }

   1
};

Revision:	1.33
Committed:	Fri Mar 2 15:09:05 2007 UTC (17 years, 2 months ago) by pippijn
Branch:	MAIN
Changes since 1.32:	+2 -1 lines
Log Message:	fixed bug with firing onto oneself
#	User	Rev	Content
1	root	1.1	#! perl
2
3			use POSIX ();
4
5			# miscellaneous commands
6
7			sub rename_to($$$) {
8			my ($ob, $from, $to) = @_;
9
10	root	1.12	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
11	root	1.1	or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
12
13			127 >= length $to
14			or return $ob->message ("rename: new name must be <= 127 characters.");
15
16			my $item;
17
18			if (length $from) {
19			$item = $ob->find_best_object_match ($from)
20			or return $ob->message ("rename: could not find a matching item to rename.");
21			} else {
22	root	1.31	$item = $ob->find_marked_object
23	root	1.1	or return $ob->message ("rename: no from name and no marked item found to rename.");
24			}
25
26			$item->custom_name (length $to ? $to : undef);
27
28			if (length $to) {
29			$item->custom_name ($to);
30			$ob->message ("Your " . $item->base_name . " will now be called $to.");
31			} else {
32			$item->custom_name (undef);
33			$ob->message ("You stop calling your " . $item->base_name . " with weird names.");
34			}
35
36			$ob->esrv_update_item (cf::UPD_NAME, $item);
37
38			1
39			}
40
41			sub ext::schmorp_irc::users; # HACK: TODO: replace by signal
42
43			sub who_listing(;$) {
44			my ($privileged) = @_;
45
46			my ($numwiz, $numafk) = (0, 0);
47			my @pl;
48
49			foreach my $pl (cf::player::list) {
50	root	1.5	my $ns = $pl->ns or next;
51	root	1.1	my $ob = $pl->ob;
52
53			next unless $ob->map
54			&& ($privileged \|\| !$pl->hidden);
55
56			$numwiz++ if $ob->flag (cf::FLAG_WIZ);
57	root	1.5	$numafk++ if $ns->afk;
58	root	1.1
59			push @pl, $pl;
60			}
61
62			(
63			"Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
64			(
65			map {
66	root	1.5	my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);
67	root	1.1
68			"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
69			. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
70	root	1.5	. ($ns->afk ? " [AFK]" : "")
71	root	1.1	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
72	root	1.4	. " [" . $pl->ns->version . "]"
73	root	1.18	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
74	root	1.4	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
75			. ($privileged ? " " . $pl->ns->host : "")
76	root	1.1	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
77			),
78			eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
79			)
80			}
81
82			cf::register_command who => sub {
83			my ($ob, $arg) = @_;
84
85			$ob->speed_left ($ob->speed_left - 0.25);
86
87			$ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE \| cf::NDI_DK_ORANGE);
88
89			1
90			};
91
92	pippijn	1.27	cf::register_command body => sub {
93			my ($ob) = @_;
94
95			my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head",
96			"around your neck", "in your skill slot", "on your finger", "around your shoulders",
97			"on your feet", "on your hands", "around your wrists", "around your waist");
98
99			# Too hard to try and make a header that lines everything up, so just
100			# give a description. (comment from C++)
101			$ob->reply (undef, "The first column is the name of the body location.");
102			$ob->reply (undef, "The second column is how many of those locations your body has.");
103			$ob->reply (undef, "The third column is how many slots in that location are available.");
104
105			for (0 .. scalar @body_locations - 1) {
106			$ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_)))
107			if $ob->body_info($_) or $ob->body_used($_);
108			}
109
110			$ob->reply (undef, "You are not allowed to wear armor")
111			unless $ob->flag (cf::FLAG_USE_ARMOUR);
112			$ob->reply (undef, "You are not allowed to use weapons")
113			unless $ob->flag (cf::FLAG_USE_WEAPON);
114
115			1
116			};
117
118	pippijn	1.28	cf::register_command mark => sub {
119			my ($pl, $arg) = @_;
120
121	pippijn	1.32	if (length $arg) {
122	pippijn	1.28	my $ob = $pl->find_best_object_match ($arg);
123
124			return $pl->reply (undef, "Could not find an object that matches $arg")
125			unless $ob;
126
127	pippijn	1.29	$pl->contr->mark ($ob);
128	pippijn	1.28	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
129	pippijn	1.32	} else {
130			my $ob = $pl->find_marked_object;
131
132			$pl->reply (undef, $ob
133			? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
134			: "You have no marked object.");
135	pippijn	1.28	}
136
137			1
138			};
139
140	pippijn	1.27	cf::register_command who => sub {
141			my ($ob, $arg) = @_;
142
143			$ob->speed_left ($ob->speed_left - 0.25);
144
145			$ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE \| cf::NDI_DK_ORANGE);
146
147			1
148			};
149
150	pippijn	1.28	for my $cmd ("run", "fire") {
151			my $oncmd = "${cmd}_on";
152			cf::register_command $cmd => sub {
153			my ($ob, $arg) = @_;
154
155	pippijn	1.33	$ob->contr->$oncmd (1);
156
157	pippijn	1.28	return $ob->reply (undef, "Can't $cmd into a non adjacent square.")
158			if $arg < 0 or $arg >= 9;
159
160			$ob->move ($arg);
161
162			1
163			};
164
165			cf::register_command "${cmd}_stop" => sub {
166			my ($ob) = @_;
167
168			$ob->contr->$oncmd (0);
169
170			1
171			};
172			}
173
174	pippijn	1.26	cf::register_command mapinfo => sub {
175			my ($ob) = @_;
176
177			my $map = $ob->map
178			or return;
179			$ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
180			$ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
181			$map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
182			if $ob->flag (cf::FLAG_WIZ);
183			$ob->reply (undef, $map->msg);
184
185			1
186			};
187
188	pippijn	1.25	cf::register_command whereami => sub {
189			my ($ob) = @_;
190
191			my $reg = $ob->region;
192			$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
193
194			1
195			};
196
197	root	1.31	sub _set_mode($$$@) {
198			my ($name, $ob, $arg, $slot, @choices) = @_;
199	pippijn	1.23
200	root	1.31	my $oldmode = $ob->contr->$slot;
201	pippijn	1.23
202	root	1.31	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
203	pippijn	1.23	unless $arg;
204
205	root	1.31	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
206			or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
207	pippijn	1.23
208	root	1.31	$ob->contr->$slot ($idx);
209			$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
210			}
211
212			cf::register_command applymode => sub {
213			my ($ob, $arg) = @_;
214
215			_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
216	pippijn	1.23
217			1
218			};
219
220			cf::register_command petmode => sub {
221			my ($ob, $arg) = @_;
222
223	root	1.31	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
224	pippijn	1.23
225			1
226			};
227
228	pippijn	1.21	cf::register_command usekeys => sub {
229			my ($ob, $arg) = @_;
230
231	root	1.31	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
232	pippijn	1.22
233			1
234	pippijn	1.21	};
235
236	pippijn	1.19	cf::register_command afk => sub {
237			my ($ob, $arg) = @_;
238
239			$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
240			$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
241	pippijn	1.22
242			1
243	pippijn	1.19	};
244
245	pippijn	1.21	cf::register_command sound => sub {
246			my ($ob, $arg) = @_;
247
248			$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
249			$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
250	pippijn	1.22
251			1
252	pippijn	1.21	};
253
254	pippijn	1.20	cf::register_command brace => sub {
255			my ($ob, $arg) = @_;
256
257			$ob->contr->braced ($ob->contr->braced ? 0 : 1);
258			$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
259	pippijn	1.22
260			1
261	pippijn	1.20	};
262
263	pippijn	1.24	cf::register_command 'output-count' => sub {
264			my ($ob, $arg) = @_;
265
266			return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
267			unless $arg > 0;
268
269			$ob->contr->outputs_count ($arg);
270			$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
271
272			1
273			};
274
275			cf::register_command 'output-sync' => sub {
276			my ($ob, $arg) = @_;
277
278			return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
279			unless $arg > 0;
280
281			$ob->contr->outputs_sync ($arg);
282			$ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
283
284			1
285			};
286
287	pippijn	1.20	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
288			# some other level (which may also be 0), this does not get echoed,
289			# but it does get set.
290			cf::register_command wimpy => sub {
291			my ($ob, $arg) = @_;
292
293			my $wimpy = $ob->run_away;
294			return $ob->reply (undef, "Your current wimpy level is $wimpy.")
295			if $arg eq "";
296
297			return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
298			if $arg =~ /^\d+$/ and $arg <= 100;
299
300			$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
301	pippijn	1.22
302			1
303	pippijn	1.20	};
304
305			cf::register_command peaceful => sub {
306			my ($ob, $arg) = @_;
307
308			$ob->reply (undef, "You cannot change your peaceful setting with this command."
309			." Please speak to the priest in the temple of Gorokh"
310			." if you want to become hostile or in temple of Valriel"
311			." if you want to become peaceful again.");
312
313			#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
314			#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
315	pippijn	1.22
316			1
317	pippijn	1.20	};
318
319	root	1.1	cf::register_command rename => sub {
320			my ($ob, $arg) = @_;
321
322			$ob->speed_left ($ob->speed_left - 0.25);
323
324			if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>])> \s$/x) {
325			# compatibility syntax
326			rename_to $ob, $1, $2;
327			} elsif ($arg =~ /
328			^\s*
329			(?:
330			(?: "((?:[^"]+\|\\.)*)" \| (\S+) )
331			\s+)?
332			to \s+
333			(?: "((?:[^"]+\|\\.)*)" \| (\S+) )
334			\s*$
335			/x) {
336			# does not unquote $1 or $3
337			rename_to $ob, $2\|\|$1, $4\|\|$3;
338			} else {
339			$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
340			}
341
342			1
343			};
344
345			cf::register_command uptime => sub {
346			my ($ob, $arg) = @_;
347
348			my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
349			my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
350			$ob->reply (undef, "server started $startup, uptime ${runtime}\d");
351
352			1
353			};
354
355	root	1.8	my %IN_MEMORY = (
356			cf::MAP_IN_MEMORY => "I",
357			cf::MAP_SWAPPED => "S",
358			cf::MAP_LOADING => "L",
359			);
360
361	root	1.7	cf::register_command maps => sub {
362			my ($ob, $arg) = @_;
363
364			no re 'eval'; $arg = qr<$arg>;
365
366	root	1.13	my $format = "%2s %1s %3s %5s %.60s\n";
367	root	1.7
368	root	1.15	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);
369	root	1.7
370			for (sort keys %cf::MAP) {
371			my $map = $cf::MAP{$_}
372			or next;
373
374			next unless $map->path =~ $arg;
375	root	1.17	next if $map->{deny_list};
376	root	1.7
377	root	1.10	my $svd = int $cf::RUNTIME - $map->{last_save};
378			$svd = "++" if $svd > 99;
379
380	root	1.14	$ob->reply (undef,
381			(sprintf $format,
382			(scalar $map->players),
383			$IN_MEMORY{$map->in_memory} \|\| "?",
384			$svd,
385			(int $map->reset_at - $cf::RUNTIME),
386	root	1.17	$map->visible_name),
387	root	1.14	cf::NDI_BLACK \| cf::NDI_UNIQUE);
388	root	1.7	}
389
390			1
391			};
392