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
#	Content
1	#! perl
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	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	for my $cmd ("run", "fire") {
151	my $oncmd = "${cmd}_on";
152	cf::register_command $cmd => sub {
153	my ($ob, $arg) = @_;
154
155	$ob->contr->$oncmd (1);
156
157	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	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	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	sub _set_mode($$$@) {
198	my ($name, $ob, $arg, $slot, @choices) = @_;
199
200	my $oldmode = $ob->contr->$slot;
201
202	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
203	unless $arg;
204
205	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
206	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
207
208	$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
217	1
218	};
219
220	cf::register_command petmode => sub {
221	my ($ob, $arg) = @_;
222
223	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
224
225	1
226	};
227
228	cf::register_command usekeys => sub {
229	my ($ob, $arg) = @_;
230
231	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
232
233	1
234	};
235
236	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
242	1
243	};
244
245	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
251	1
252	};
253
254	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
260	1
261	};
262
263	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	# 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
302	1
303	};
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
316	1
317	};
318
319	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	my %IN_MEMORY = (
356	cf::MAP_IN_MEMORY => "I",
357	cf::MAP_SWAPPED => "S",
358	cf::MAP_LOADING => "L",
359	);
360
361	cf::register_command maps => sub {
362	my ($ob, $arg) = @_;
363
364	no re 'eval'; $arg = qr<$arg>;
365
366	my $format = "%2s %1s %3s %5s %.60s\n";
367
368	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);
369
370	for (sort keys %cf::MAP) {
371	my $map = $cf::MAP{$_}
372	or next;
373
374	next unless $map->path =~ $arg;
375	next if $map->{deny_list};
376
377	my $svd = int $cf::RUNTIME - $map->{last_save};
378	$svd = "++" if $svd > 99;
379
380	$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	$map->visible_name),
387	cf::NDI_BLACK \| cf::NDI_UNIQUE);
388	}
389
390	1
391	};
392