ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/commands.ext
Revision: 1.15
Committed: Tue Dec 12 16:59:34 2006 UTC (17 years, 5 months ago) by root
Branch: MAIN
Changes since 1.14: +7 -3 lines
Log Message:
*** empty log message ***

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->client . "]"
72 . " [" . ($pl->peaceful || $privileged ? $ob->map->path : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"
73 . ($privileged ? " " . $pl->host : "")
74 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
75 ),
76 eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
77 )
78 }
79
80 cf::register_command who => sub {
81 my ($ob, $arg) = @_;
82
83 $ob->speed_left ($ob->speed_left - 0.25);
84
85 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
86
87 1
88 };
89
90 cf::register_command rename => sub {
91 my ($ob, $arg) = @_;
92
93 $ob->speed_left ($ob->speed_left - 0.25);
94
95 if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]*)> \s*$/x) {
96 # compatibility syntax
97 rename_to $ob, $1, $2;
98 } elsif ($arg =~ /
99 ^\s*
100 (?:
101 (?: "((?:[^"]+|\\.)*)" | (\S+) )
102 \s+)?
103 to \s+
104 (?: "((?:[^"]+|\\.)*)" | (\S+) )
105 \s*$
106 /x) {
107 # does not unquote $1 or $3
108 rename_to $ob, $2||$1, $4||$3;
109 } else {
110 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
111 }
112
113 1
114 };
115
116 cf::register_command uptime => sub {
117 my ($ob, $arg) = @_;
118
119 my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
120 my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
121 $ob->reply (undef, "server started $startup, uptime ${runtime}\d");
122
123 1
124 };
125