ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/commands.ext
Revision: 1.12
Committed: Sun Nov 19 13:50:13 2006 UTC (17 years, 6 months ago) by root
Branch: MAIN
Changes since 1.11: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     # miscellaneous commands
4    
5     sub rename_to($$$) {
6     my ($ob, $from, $to) = @_;
7    
8     $to =~ /^[a-zA-Z0-9.,=#\/%$!^]*$/
9     or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
10    
11     127 >= length $to
12     or return $ob->message ("rename: new name must be <= 127 characters.");
13    
14     my $item;
15    
16     if (length $from) {
17     $item = $ob->find_best_object_match ($from)
18     or return $ob->message ("rename: could not find a matching item to rename.");
19     } else {
20     $item = $ob->find_marked_object ()
21     or return $ob->message ("rename: no from name and no marked item found to rename.");
22     }
23    
24     $item->custom_name (length $to ? $to : undef);
25    
26     if (length $to) {
27     $item->custom_name ($to);
28     $ob->message ("Your " . $item->base_name . " will now be called $to.");
29     } else {
30     $item->custom_name (undef);
31     $ob->message ("You stop calling your " . $item->base_name . " with weird names.");
32     }
33    
34     $ob->esrv_update_item (cf::UPD_NAME, $item);
35    
36 root 1.11 1
37 root 1.1 }
38    
39 root 1.5 sub who_listing(;$) {
40 root 1.4 my ($privileged) = @_;
41    
42     my ($numwiz, $numafk) = (0, 0);
43     my @pl;
44    
45     foreach my $pl (cf::player::list) {
46     my $ob = $pl->ob;
47    
48     next unless $ob->map
49     && ($privileged || !$pl->hidden);
50    
51     $numwiz++ if $ob->flag (cf::FLAG_WIZ);
52     $numafk++ if $ob->flag (cf::FLAG_AFK);
53    
54     push @pl, $pl;
55     }
56    
57     (
58     "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
59     map {
60     my ($pl, $ob) = ($_, $_->ob);
61    
62     "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
63     . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
64     . ($ob->flag (cf::FLAG_AFK) ? " [AFK]" : "")
65     . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
66 root 1.5 . " [" . $pl->client . "]"
67 root 1.7 . " [" . ($pl->peaceful || $privileged ? $ob->map->path : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"
68 root 1.5 . ($privileged ? " " . $pl->host : "")
69 root 1.9 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
70 root 1.4 )
71     }
72    
73     cf::register_command who => $cf::TICK, sub {
74     my ($ob, $arg) = @_;
75    
76 root 1.12 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
77 root 1.11
78     1
79 root 1.4 };
80    
81     cf::register_command rename => $cf::TICK, sub {
82 root 1.1 my ($ob, $arg) = @_;
83    
84 root 1.10 if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]*)> \s*$/x) {
85 root 1.2 # compatibility syntax
86 root 1.1 rename_to $ob, $1, $2;
87     } elsif ($arg =~ /
88     ^\s*
89     (?:
90     (?: "((?:[^"]+|\\.)*)" | (\S+) )
91     \s+)?
92     to \s+
93     (?: "((?:[^"]+|\\.)*)" | (\S+) )
94     \s*$
95     /x) {
96     # does not unquote $1 or $3
97     rename_to $ob, $2||$1, $4||$3;
98     } else {
99 root 1.4 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
100 root 1.1 }
101 root 1.11
102     1
103 root 1.1 };
104 root 1.11