[ViewVC] Diff of: cvs/deliantra/server/ext/commands.ext

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.25 by pippijn, Fri Mar 2 11:13:50 2007 UTC vs.
Revision 1.73 by root, Sat Oct 3 22:36:08 2009 UTC

…		…
1	#! perl	1	#! perl # mandatory depends=irc
2		2
3	use POSIX ();	3	use POSIX ();
4		4
5	# miscellaneous commands	5	# miscellaneous commands
		6
		7	sub who_listing(;$$) {
		8	my ($privileged, $select) = @_;
		9
		10	my ($numwiz, $numafk) = (0, 0);
		11	my @pl;
		12
		13	foreach my $pl (cf::player::list) {
		14	my $ns = $pl->ns or next;
		15	my $ob = $pl->ob;
		16
		17	next unless $ob->map
		18	&& ($privileged \|\| !$pl->hidden);
		19
		20	$numwiz++ if $ob->flag (cf::FLAG_WIZ);
		21	$numafk++ if $ns->afk;
		22
		23	push @pl, $pl;
		24	}
		25
		26	(
		27	"Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
		28	(grep /$select/,
		29	map {
		30	my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);
		31
		32	"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
		33	. ($pl->gender ? " [f]" : " [m]")
		34	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
		35	. ($ns->afk ? " [AFK]" : "")
		36	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
		37	. " [" . $pl->ns->version . "]"
		38	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
		39	. (sprintf " [rtt %.3fs]", $pl->ns->tcpi_rtt * 1e-6)
		40	. ($privileged ? " " . $pl->ns->host : "")
		41	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
		42	),
		43	eval { "* IRC: " . join ", ", ext::irc::users },
		44	)
		45	}
		46
		47	cf::register_command who => sub {
		48	my ($ob, $arg) = @_;
		49
		50	$ob->speed_left ($ob->speed_left - 4);
		51
		52	$ob->send_msg ("c/who" => (join "\r", who_listing $ob->may ("extended_who"), $arg), cf::NDI_DK_ORANGE \| cf::NDI_REPLY \| cf::NDI_CLEAR \| cf::NDI_DEF);
		53	};
		54
		55	cf::register_command seen => sub {
		56	my ($pl, $args) = @_;
		57
		58	cf::async {
		59	if (my ($login) = $args =~ /(\S+)/) {
		60	if ($login eq $pl->name) {
		61	$pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_REPLY);
		62	} elsif (cf::player::find_active $login) {
		63	$pl->message ("$login is right here on this server!", cf::NDI_REPLY);
		64	} elsif (cf::player::exists $login
		65	and stat cf::player::path $login) {
		66	my $time = (stat _)[9];
		67
		68	$pl->message ("$login was last seen here "
		69	. (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time)
		70	. " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_REPLY);
		71	} else {
		72	$pl->message ("No player named $login is known to me.", cf::NDI_REPLY);
		73	}
		74	} else {
		75	$pl->message ("Usage: seen <player>", cf::NDI_REPLY);
		76	}
		77	};
		78	};
		79
		80	cf::register_command body => sub {
		81	my ($ob) = @_;
		82
		83	my $observe = $ob->contr->observe;
		84
		85	# Too hard to try and make a header that lines everything up, so just
		86	# give a description. (comment from C++)
		87	my $reply =
		88	"The first column is the name of the body location.\r"
		89	. "The second column is how many of those locations your body has.\r"
		90	. "The third column is how many slots in that location are available.\r"
		91	. "The last column shows the items currently using the slot\n\n";
		92
		93	# first process all applied items and hash them into their slots
		94	my @slot;
		95
		96	for my $item (grep $_->flag (cf::FLAG_APPLIED), $observe->inv) {
		97	$item->slot_info ($_)
		98	and push @{ $slot[$_] }, $item
		99	for 0 .. cf::NUM_BODY_LOCATIONS-1;
		100	}
		101
		102	$reply .= sprintf " %-20s %3s %5s %s\n", "Location", "You", "Avail", "What";
		103	for (0 .. cf::NUM_BODY_LOCATIONS - 1) {
		104	my $msg = cf::object::slot_nonuse_name $_;
		105	$msg =~ s/^.*? a //;
		106	$reply .= sprintf " %-20s %3d %5d %s\n",
		107	$msg,
		108	$observe->slot_info ($_),
		109	$observe->slot_used ($_),
		110	join ", ", map $_->query_short_name, @{ $slot[$_] }
		111	if $observe->slot_info ($_) \|\| $observe->slot_used ($_);
		112	}
		113
		114	$reply .= "You are not allowed to wear armor\r"
		115	unless $observe->flag (cf::FLAG_USE_ARMOUR);
		116	$reply .= "You are not allowed to use weapons\r"
		117	unless $observe->flag (cf::FLAG_USE_WEAPON);
		118
		119	$ob->send_msg ("c/body" => $reply, cf::NDI_REPLY \| cf::NDI_CLEAR);
		120	};
		121
		122	cf::register_command mark => sub {
		123	my ($pl, $arg) = @_;
		124
		125	if (length $arg) {
		126	my $ob = $pl->find_best_object_match ($arg);
		127
		128	return $pl->reply (undef, "Could not find an object that matches $arg")
		129	unless $ob;
		130
		131	$pl->contr->mark ($ob);
		132	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
		133	} else {
		134	my $ob = $pl->find_marked_object;
		135
		136	$pl->reply (undef, $ob
		137	? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
		138	: "You have no marked object.");
		139	}
		140	};
		141
		142	for my $cmd ("run", "fire") {
		143	my $oncmd = "${cmd}_on";
		144	cf::register_command $cmd => sub {
		145	my ($ob, $arg) = @_;
		146
		147	$ob->reply (undef, "Can't $cmd into a non adjacent square.")
		148	if $arg < 0 or $arg >= 9;
		149
		150	$ob->contr->$oncmd (1);
		151	$ob->move_player ($arg);
		152	};
		153
		154	cf::register_command "${cmd}_stop" => sub {
		155	my ($ob) = @_;
		156
		157	$ob->contr->$oncmd (0);
		158	};
		159	}
		160
		161	cf::register_command mapinfo => sub {
		162	my ($ob) = @_;
		163
		164	my $observe = $ob->contr->observe;
		165
		166	my $map = $observe->map
		167	or return;
		168
		169	my $msg = sprintf "%s (%s)\r%s", $map->name, $map->path, $observe->region->longname;
		170	$msg .= sprintf "\rplayers: %d difficulty: %d size: %d start: %dx%d timeout: %d",
		171	(scalar $map->players), $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout
		172	if $ob->flag (cf::FLAG_WIZ);
		173
		174	$ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		175	};
		176
		177	cf::register_command whereami => sub {
		178	my ($ob) = @_;
		179
		180	my $reg = $ob->contr->observe->region;
		181	$ob->send_msg ("c/who" => (sprintf "You are %s.\n\n%s", $reg->longname, $reg->msg), cf::NDI_REPLY \| cf::NDI_CLEAR);
		182	};
		183
		184	cf::register_command whereabouts => sub {
		185	my ($ob, $arg) = @_;
		186
		187	my %count;
		188
		189	for my $pl (cf::player::list) {
		190	++$count{$pl->ob->region->longname};
		191	}
		192
		193	my $msg = "T<In the world currently there are:>\n\n"
		194	. join "", map { sprintf " C<%3d >player(s) %s\r", $count{$_}, $_ } sort keys %count;
		195
		196	$ob->send_msg ("c/who" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		197	};
		198
		199	cf::register_command hiscore => sub {
		200	my ($ob, $arg) = @_;
		201
		202	my $url = $cf::CFG{hiscore_url};
		203	$ob->send_msg (log => "See $url", cf::NDI_REPLY);
		204	};
		205
		206	sub _set_mode($$$@) {
		207	my ($name, $ob, $arg, $slot, @choices) = @_;
		208
		209	my $oldmode = $ob->contr->$slot;
		210
		211	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
		212	unless $arg;
		213
		214	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
		215	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
		216
		217	$ob->contr->$slot ($idx);
		218	$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
		219	}
		220
		221	cf::register_command applymode => sub {
		222	my ($ob, $arg) = @_;
		223
		224	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
		225	};
		226
		227	cf::register_command petmode => sub {
		228	my ($ob, $arg) = @_;
		229
		230	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
		231	};
		232
		233	cf::register_command usekeys => sub {
		234	my ($ob, $arg) = @_;
		235
		236	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
		237	};
		238
		239	cf::register_command hintmode => sub {
		240	my ($ob, $arg) = @_;
		241
		242	_set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);
		243	};
		244
		245	cf::register_command afk => sub {
		246	my ($ob, $arg) = @_;
		247
		248	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
		249	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		250	};
		251
		252	cf::register_command sound => sub {
		253	my ($ob, $arg) = @_;
		254
		255	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
		256	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		257	};
		258
		259	cf::register_command brace => sub {
		260	my ($ob, $arg) = @_;
		261
		262	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
		263	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
		264	};
		265
		266	cf::register_command 'output-rate' => sub {
		267	my ($ob, $arg) = @_;
		268
		269	return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
		270	unless $arg > 0;
		271
		272	# minimum is 5k/s
		273	# maximum is 100k/s, this should be configurable
		274	$ob->contr->ns->max_rate ((List::Util::max 5000, List::Util::min 100000, $arg) * $cf::TICK);
		275	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
		276	};
		277
		278	cf::register_command 'output-count' => sub {
		279	my ($ob, $arg) = @_;
		280
		281	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
		282	unless $arg > 0;
		283
		284	$arg = 4 if $arg < 4;
		285
		286	$ob->contr->outputs_count ($arg);
		287	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
		288	};
		289
		290	cf::register_command 'output-sync' => sub {
		291	my ($ob, $arg) = @_;
		292
		293	return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
		294	unless length $arg;
		295
		296	$arg = 0.5 if $arg < 0.5;
		297
		298	$ob->contr->outputs_sync ($arg / $cf::TICK);
		299	$ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
		300	};
		301
		302	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
		303	# some other level (which may also be 0), this does not get echoed,
		304	# but it does get set.
		305	cf::register_command wimpy => sub {
		306	my ($ob, $arg) = @_;
		307
		308	my $wimpy = $ob->run_away;
		309	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
		310	if $arg eq "";
		311
		312	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
		313	if $arg =~ /^\d+$/ and $arg <= 100;
		314
		315	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
		316	};
		317
		318	cf::register_command peaceful => sub {
		319	my ($ob, $arg) = @_;
		320
		321	$ob->reply (undef, "You cannot change your peaceful setting with this command."
		322	." Please speak to the priest in the temple of Gorokh"
		323	." if you want to become hostile or in temple of Valriel"
		324	." if you want to become peaceful again.");
		325
		326	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
		327	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
		328	};
6		329
7	sub rename_to($$$) {	330	sub rename_to($$$) {
8	my ($ob, $from, $to) = @_;	331	my ($ob, $from, $to) = @_;
9		332
10	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/	333	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
17		340
18	if (length $from) {	341	if (length $from) {
19	$item = $ob->find_best_object_match ($from)	342	$item = $ob->find_best_object_match ($from)
20	or return $ob->message ("rename: could not find a matching item to rename.");	343	or return $ob->message ("rename: could not find a matching item to rename.");
21	} else {	344	} else {
22	$item = $ob->find_marked_object ()	345	$item = $ob->find_marked_object
23	or return $ob->message ("rename: no from name and no marked item found to rename.");	346	or return $ob->message ("rename: no from name and no marked item found to rename.");
24	}	347	}
25		348
26	$item->custom_name (length $to ? $to : undef);	349	$item->custom_name (length $to ? $to : undef);
27		350
…		…
35		358
36	$ob->esrv_update_item (cf::UPD_NAME, $item);	359	$ob->esrv_update_item (cf::UPD_NAME, $item);
37		360
38	1	361	1
39	}	362	}
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 whereami => sub {
93	my ($ob) = @_;
94
95	my $reg = $ob->region;
96	$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
97
98	1
99	};
100
101	cf::register_command applymode => sub {
102	my ($ob, $arg) = @_;
103	my @types = ("nochoice", "never", "always");
104	my $mapping = {
105	nochoice => 1,
106	never => 2,
107	always => 3,
108	};
109
110	my $oldmode = $ob->contr->unapply;
111	my $oldmode_name = $types[$oldmode];
112
113	return $ob->reply (undef, "applymode is set to $oldmode_name")
114	unless $arg;
115
116	return $ob->reply (undef, "applymode: Unknown options '$arg', valid options are @types")
117	unless $mapping->{$arg};
118
119	$ob->contr->unapply ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
120	# but $arg would be 0 if a user enters an incorrect value
121	$ob->reply (undef, "applymode" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $types[$ob->contr->unapply]);
122
123	1
124	};
125
126	cf::register_command petmode => sub {
127	my ($ob, $arg) = @_;
128	my @types = ("normal", "sad", "defend", "arena");
129	my $mapping = {
130	normal => 1,
131	sad => 2,
132	defend => 3,
133	arena => 4,
134	};
135
136	my $oldtype = $ob->contr->petmode;
137	my $oldtype_name = $types[$oldtype];
138
139	return $ob->reply (undef, "petmode is set to $oldtype_name")
140	unless $arg;
141
142	return $ob->reply (undef, "petmode: Unknown options '$arg', valid options are @types")
143	unless $mapping->{$arg};
144
145	$ob->contr->petmode ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
146	# but $arg would be 0 if a user enters an incorrect value
147	$ob->reply (undef, "petmode" . ($oldtype == $ob->contr->petmode ? "" : " now") . " set to " . $types[$ob->contr->petmode]);
148
149	1
150	};
151
152	cf::register_command usekeys => sub {
153	my ($ob, $arg) = @_;
154	my @types = ("inventory", "keyrings", "containers");
155	my $mapping = {
156	inventory => 1,
157	keyrings => 2,
158	containers => 3,
159	};
160
161	my $oldtype = $ob->contr->usekeys;
162	my $oldtype_name = $types[$oldtype];
163
164	return $ob->reply (undef, "usekeys is set to $oldtype_name")
165	unless $arg;
166
167	return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are @types")
168	unless $mapping->{$arg};
169
170	$ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
171	# but $arg would be 0 if a user enters an incorrect value
172	$ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]);
173
174	1
175	};
176
177	cf::register_command afk => sub {
178	my ($ob, $arg) = @_;
179
180	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
181	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
182
183	1
184	};
185
186	cf::register_command sound => sub {
187	my ($ob, $arg) = @_;
188
189	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
190	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
191
192	1
193	};
194
195	cf::register_command brace => sub {
196	my ($ob, $arg) = @_;
197
198	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
199	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
200
201	1
202	};
203
204	cf::register_command 'output-count' => sub {
205	my ($ob, $arg) = @_;
206
207	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
208	unless $arg > 0;
209
210	$ob->contr->outputs_count ($arg);
211	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
212
213	1
214	};
215
216	cf::register_command 'output-sync' => sub {
217	my ($ob, $arg) = @_;
218
219	return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
220	unless $arg > 0;
221
222	$ob->contr->outputs_sync ($arg);
223	$ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
224
225	1
226	};
227
228	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
229	# some other level (which may also be 0), this does not get echoed,
230	# but it does get set.
231	cf::register_command wimpy => sub {
232	my ($ob, $arg) = @_;
233
234	my $wimpy = $ob->run_away;
235	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
236	if $arg eq "";
237
238	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
239	if $arg =~ /^\d+$/ and $arg <= 100;
240
241	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
242
243	1
244	};
245
246	cf::register_command peaceful => sub {
247	my ($ob, $arg) = @_;
248
249	$ob->reply (undef, "You cannot change your peaceful setting with this command."
250	." Please speak to the priest in the temple of Gorokh"
251	." if you want to become hostile or in temple of Valriel"
252	." if you want to become peaceful again.");
253
254	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
255	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
256
257	1
258	};
259		363
260	cf::register_command rename => sub {	364	cf::register_command rename => sub {
261	my ($ob, $arg) = @_;	365	my ($ob, $arg) = @_;
262		366
263	$ob->speed_left ($ob->speed_left - 0.25);	367	$ob->speed_left ($ob->speed_left - 0.25);
…		…
277	# does not unquote $1 or $3	381	# does not unquote $1 or $3
278	rename_to $ob, $2\|\|$1, $4\|\|$3;	382	rename_to $ob, $2\|\|$1, $4\|\|$3;
279	} else {	383	} else {
280	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');	384	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
281	}	385	}
282
283	1
284	};	386	};
285		387
286	cf::register_command uptime => sub {	388	cf::register_command uptime => sub {
287	my ($ob, $arg) = @_;	389	my ($ob, $arg) = @_;
288		390
289	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;	391	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
290	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;	392	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
291	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");	393	$ob->send_msg ("c/uptime" => "server started $startup, uptime ${runtime}\d", cf::NDI_REPLY \| cf::NDI_CLEAR);
292
293	1
294	};	394	};
295		395
296	my %IN_MEMORY = (	396	my %IN_MEMORY = (
297	cf::MAP_IN_MEMORY => "I",	397	cf::MAP_ACTIVE => "I",
298	cf::MAP_SWAPPED => "S",	398	cf::MAP_SWAPPED => "S",
299	cf::MAP_LOADING => "L",	399	cf::MAP_LOADING => "L",
300	);	400	);
301		401
302	cf::register_command maps => sub {	402	cf::register_command maps => sub {
303	my ($ob, $arg) = @_;	403	my ($ob, $arg) = @_;
304		404
305	no re 'eval'; $arg = qr<$arg>;	405	no re 'eval'; $arg = qr<$arg>;
306		406
307	my $format = "%2s %1s %3s %5s %.60s\n";	407	my $format = " %2s %1s %3s %5s %.60s\n";
308		408
309	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);	409	my $msg = "\n" . sprintf $format, "Pl", "I", "Svd", "Reset", "Name";
310		410
311	for (sort keys %cf::MAP) {	411	for (sort keys %cf::MAP) {
312	my $map = $cf::MAP{$_}	412	my $map = $cf::MAP{$_}
313	or next;	413	or next;
314		414
…		…
316	next if $map->{deny_list};	416	next if $map->{deny_list};
317		417
318	my $svd = int $cf::RUNTIME - $map->{last_save};	418	my $svd = int $cf::RUNTIME - $map->{last_save};
319	$svd = "++" if $svd > 99;	419	$svd = "++" if $svd > 99;
320		420
321	$ob->reply (undef,	421	$msg .= sprintf $format,
322	(sprintf $format,
323	(scalar $map->players),	422	(scalar $map->players),
324	$IN_MEMORY{$map->in_memory} \|\| "?",	423	$IN_MEMORY{$map->in_memory} \|\| "?",
325	$svd,	424	$svd,
326	(int $map->reset_at - $cf::RUNTIME),	425	(int $map->reset_at - $cf::RUNTIME),
327	$map->visible_name),	426	$map->visible_name;
328	cf::NDI_BLACK \| cf::NDI_UNIQUE);
329	}
330
331	1	427	}
332	};
333		428
		429	$ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		430	};
		431

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.25 by pippijn, Fri Mar 2 11:13:50 2007 UTC vs. Revision 1.73 by root, Sat Oct 3 22:36:08 2009 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.25 by pippijn, Fri Mar 2 11:13:50 2007 UTC vs.
Revision 1.73 by root, Sat Oct 3 22:36:08 2009 UTC