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

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.72 by root, Sun Jan 11 06:08:40 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.72 by root, Sun Jan 11 06:08:40 2009 UTC