| 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 |
|
