server/ext/commands.ext

#! perl # MANDATORY

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

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

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

      $ob->contr->$oncmd (1);
      $ob->move_player ($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-rate' => sub {
   my ($ob, $arg) = @_;

   return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
      unless $arg > 0;

   # minimum is 2k/s
   $ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
   $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);

   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, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
      unless length $arg;

   $ob->contr->outputs_sync ($arg / $cf::TICK);
   $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);

   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.39
Committed:	Mon Apr 2 19:56:11 2007 UTC (17 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.38:	+2 -1 lines
Log Message:	add untested ber integer encoding function
#	Content
1	#! perl # MANDATORY
2
3	use POSIX ();
4
5	# miscellaneous commands
6
7	sub rename_to($$$) {
8	my ($ob, $from, $to) = @_;
9
10	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
11	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	$item = $ob->find_marked_object
23	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	my $ns = $pl->ns or next;
51	my $ob = $pl->ob;
52
53	next unless $ob->map
54	&& ($privileged \|\| !$pl->hidden);
55
56	$numwiz++ if $ob->flag (cf::FLAG_WIZ);
57	$numafk++ if $ns->afk;
58
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	my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);
67
68	"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
69	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
70	. ($ns->afk ? " [AFK]" : "")
71	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
72	. " [" . $pl->ns->version . "]"
73	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
74	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
75	. ($privileged ? " " . $pl->ns->host : "")
76	} 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	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	cf::register_command mark => sub {
119	my ($pl, $arg) = @_;
120
121	if (length $arg) {
122	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	$pl->contr->mark ($ob);
128	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
129	} 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	}
136
137	1
138	};
139
140	for my $cmd ("run", "fire") {
141	my $oncmd = "${cmd}_on";
142	cf::register_command $cmd => sub {
143	my ($ob, $arg) = @_;
144
145	$ob->reply (undef, "Can't $cmd into a non adjacent square.")
146	if $arg < 0 or $arg >= 9;
147
148	$ob->contr->$oncmd (1);
149	$ob->move_player ($arg);
150
151	1
152	};
153
154	cf::register_command "${cmd}_stop" => sub {
155	my ($ob) = @_;
156
157	$ob->contr->$oncmd (0);
158
159	1
160	};
161	}
162
163	cf::register_command mapinfo => sub {
164	my ($ob) = @_;
165
166	my $map = $ob->map
167	or return;
168	$ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
169	$ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
170	$map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
171	if $ob->flag (cf::FLAG_WIZ);
172	$ob->reply (undef, $map->msg);
173
174	1
175	};
176
177	cf::register_command whereami => sub {
178	my ($ob) = @_;
179
180	my $reg = $ob->region;
181	$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
182
183	1
184	};
185
186	sub _set_mode($$$@) {
187	my ($name, $ob, $arg, $slot, @choices) = @_;
188
189	my $oldmode = $ob->contr->$slot;
190
191	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
192	unless $arg;
193
194	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
195	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
196
197	$ob->contr->$slot ($idx);
198	$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
199	}
200
201	cf::register_command applymode => sub {
202	my ($ob, $arg) = @_;
203
204	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
205
206	1
207	};
208
209	cf::register_command petmode => sub {
210	my ($ob, $arg) = @_;
211
212	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
213
214	1
215	};
216
217	cf::register_command usekeys => sub {
218	my ($ob, $arg) = @_;
219
220	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
221
222	1
223	};
224
225	cf::register_command afk => sub {
226	my ($ob, $arg) = @_;
227
228	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
229	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
230
231	1
232	};
233
234	cf::register_command sound => sub {
235	my ($ob, $arg) = @_;
236
237	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
238	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
239
240	1
241	};
242
243	cf::register_command brace => sub {
244	my ($ob, $arg) = @_;
245
246	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
247	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
248
249	1
250	};
251
252	cf::register_command 'output-rate' => sub {
253	my ($ob, $arg) = @_;
254
255	return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
256	unless $arg > 0;
257
258	# minimum is 2k/s
259	$ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
260	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
261
262	1
263	};
264
265	cf::register_command 'output-count' => sub {
266	my ($ob, $arg) = @_;
267
268	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
269	unless $arg > 0;
270
271	$ob->contr->outputs_count ($arg);
272	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
273
274	1
275	};
276
277	cf::register_command 'output-sync' => sub {
278	my ($ob, $arg) = @_;
279
280	return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
281	unless length $arg;
282
283	$ob->contr->outputs_sync ($arg / $cf::TICK);
284	$ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
285
286	1
287	};
288
289	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
290	# some other level (which may also be 0), this does not get echoed,
291	# but it does get set.
292	cf::register_command wimpy => sub {
293	my ($ob, $arg) = @_;
294
295	my $wimpy = $ob->run_away;
296	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
297	if $arg eq "";
298
299	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
300	if $arg =~ /^\d+$/ and $arg <= 100;
301
302	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
303
304	1
305	};
306
307	cf::register_command peaceful => sub {
308	my ($ob, $arg) = @_;
309
310	$ob->reply (undef, "You cannot change your peaceful setting with this command."
311	." Please speak to the priest in the temple of Gorokh"
312	." if you want to become hostile or in temple of Valriel"
313	." if you want to become peaceful again.");
314
315	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
316	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
317
318	1
319	};
320
321	cf::register_command rename => sub {
322	my ($ob, $arg) = @_;
323
324	$ob->speed_left ($ob->speed_left - 0.25);
325
326	if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>])> \s$/x) {
327	# compatibility syntax
328	rename_to $ob, $1, $2;
329	} elsif ($arg =~ /
330	^\s*
331	(?:
332	(?: "((?:[^"]+\|\\.)*)" \| (\S+) )
333	\s+)?
334	to \s+
335	(?: "((?:[^"]+\|\\.)*)" \| (\S+) )
336	\s*$
337	/x) {
338	# does not unquote $1 or $3
339	rename_to $ob, $2\|\|$1, $4\|\|$3;
340	} else {
341	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
342	}
343
344	1
345	};
346
347	cf::register_command uptime => sub {
348	my ($ob, $arg) = @_;
349
350	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
351	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
352	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");
353
354	1
355	};
356
357	my %IN_MEMORY = (
358	cf::MAP_IN_MEMORY => "I",
359	cf::MAP_SWAPPED => "S",
360	cf::MAP_LOADING => "L",
361	);
362
363	cf::register_command maps => sub {
364	my ($ob, $arg) = @_;
365
366	no re 'eval'; $arg = qr<$arg>;
367
368	my $format = "%2s %1s %3s %5s %.60s\n";
369
370	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);
371
372	for (sort keys %cf::MAP) {
373	my $map = $cf::MAP{$_}
374	or next;
375
376	next unless $map->path =~ $arg;
377	next if $map->{deny_list};
378
379	my $svd = int $cf::RUNTIME - $map->{last_save};
380	$svd = "++" if $svd > 99;
381
382	$ob->reply (undef,
383	(sprintf $format,
384	(scalar $map->players),
385	$IN_MEMORY{$map->in_memory} \|\| "?",
386	$svd,
387	(int $map->reset_at - $cf::RUNTIME),
388	$map->visible_name),
389	cf::NDI_BLACK \| cf::NDI_UNIQUE);
390	}
391
392	1
393	};
394