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) = @_;

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

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