1 |
#! perl # mandatory |
2 |
|
3 |
# implements user list monitoring |
4 |
|
5 |
# if opted in via exti ["nickmon", 1], |
6 |
# sends ext ["nicklist", [add/upd...], [del...]] messages |
7 |
# where each add/upd stands for an added or changed nick: |
8 |
# [nick, NT_PLAYER, count, uuid] - deliantra player |
9 |
# [nick, NT_SERVICE, description] - some internal service |
10 |
# [nick, NT_OTHER, type] - some other user (e.g. irc) |
11 |
# and each del is simply the nickname that is gone. |
12 |
|
13 |
sub NT_PLAYER() { 0 } |
14 |
sub NT_SERVICE() { 1 } |
15 |
sub NT_OTHER() { 2 } |
16 |
|
17 |
# uses global variables in extvar::nickmon: %CLIENT, $NICK |
18 |
|
19 |
cf::register_exticmd nickmon => sub { |
20 |
my ($ns, $enable) = @_; |
21 |
|
22 |
delete $ns->{nickmon}; |
23 |
delete $extvar::nickmon::CLIENT{$ns}; |
24 |
|
25 |
if ($enable) { |
26 |
$ns->{nickmon} = 1; |
27 |
$extvar::nickmon::CLIENT{$ns+0} = $ns; |
28 |
$ns->ext_msg (nicklist => [values %extvar::nickmon::NICK], []) |
29 |
if %extvar::nickmon::NICK; |
30 |
} |
31 |
|
32 |
$enable |
33 |
}; |
34 |
|
35 |
cf::client->attach ( |
36 |
on_client_destroy => sub { |
37 |
my ($ns) = @_; |
38 |
|
39 |
delete $extvar::nickmon::CLIENT{$ns+0}; |
40 |
}, |
41 |
); |
42 |
|
43 |
sub msg($$) { |
44 |
$_->ext_msg (nicklist => $_[0], $_[1]) |
45 |
for values %extvar::nickmon::CLIENT; |
46 |
} |
47 |
|
48 |
# to be called by other extensions as well |
49 |
sub upd($$@) { |
50 |
my $nick = [@_]; |
51 |
|
52 |
$extvar::nickmon::NICK{$nick->[0]} = $nick; |
53 |
msg [$nick], []; |
54 |
} |
55 |
|
56 |
sub del($) { |
57 |
delete $extvar::nickmon::NICK{$_[0]}; |
58 |
msg [], [$_[0]]; |
59 |
} |
60 |
|
61 |
cf::player->attach ( |
62 |
on_login => sub { |
63 |
my ($pl) = @_; |
64 |
$pl = $pl->ob; |
65 |
upd $pl->name, NT_PLAYER, $pl->count, $pl->uuid; |
66 |
}, |
67 |
on_logout => sub { |
68 |
my ($pl) = @_; |
69 |
del $pl->ob->name; |
70 |
}, |
71 |
on_birth => sub { |
72 |
my ($pl) = @_; |
73 |
$pl = $pl->ob; |
74 |
upd $pl->name, NT_PLAYER, $pl->count, $pl->uuid; |
75 |
}, |
76 |
on_quit => sub { |
77 |
my ($pl) = @_; |
78 |
del $pl->ob->name; |
79 |
}, |
80 |
); |
81 |
|
82 |
|