ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/commands.ext
(Generate patch)

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.35 by root, Wed Mar 14 15:44:47 2007 UTC vs.
Revision 1.62 by root, Sat Sep 8 10:14:09 2007 UTC

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

Diff Legend

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