ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/commands.ext
Revision: 1.17
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.16: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# 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 $ob = $pl->ob;
51
52 next unless $ob->map
53 && ($privileged || !$pl->hidden);
54
55 $numwiz++ if $ob->flag (cf::FLAG_WIZ);
56 $numafk++ if $ob->flag (cf::FLAG_AFK);
57
58 push @pl, $pl;
59 }
60
61 (
62 "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
63 (
64 map {
65 my ($pl, $ob) = ($_, $_->ob);
66
67 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
68 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
69 . ($ob->flag (cf::FLAG_AFK) ? " [AFK]" : "")
70 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
71 . " [" . $pl->socket->client . "]"
72 . " [" . ($pl->peaceful || $privileged ? $ob->map->path : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"
73 . (sprintf " [rtt %.3fs/%.3f]", $pl->socket->rtt * 1e-6, $pl->socket->rttvar * 1e-6)
74 . ($privileged ? " " . $pl->socket->host : "")
75 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
76 ),
77 eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
78 )
79 }
80
81 cf::register_command who => sub {
82 my ($ob, $arg) = @_;
83
84 $ob->speed_left ($ob->speed_left - 0.25);
85
86 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
87
88 1
89 };
90
91 cf::register_command rename => sub {
92 my ($ob, $arg) = @_;
93
94 $ob->speed_left ($ob->speed_left - 0.25);
95
96 if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]*)> \s*$/x) {
97 # compatibility syntax
98 rename_to $ob, $1, $2;
99 } elsif ($arg =~ /
100 ^\s*
101 (?:
102 (?: "((?:[^"]+|\\.)*)" | (\S+) )
103 \s+)?
104 to \s+
105 (?: "((?:[^"]+|\\.)*)" | (\S+) )
106 \s*$
107 /x) {
108 # does not unquote $1 or $3
109 rename_to $ob, $2||$1, $4||$3;
110 } else {
111 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
112 }
113
114 1
115 };
116
117 cf::register_command uptime => sub {
118 my ($ob, $arg) = @_;
119
120 my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
121 my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
122 $ob->reply (undef, "server started $startup, uptime ${runtime}\d");
123
124 1
125 };
126