ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/schmorplog.ext
(Generate patch)

Comparing deliantra/server/ext/schmorplog.ext (file contents):
Revision 1.1 by root, Fri Dec 15 19:29:18 2006 UTC vs.
Revision 1.29 by root, Tue May 4 21:45:42 2010 UTC

1#! perl 1#! perl # depends=irc mandatory
2 2
3our $UPDATE_LOGINS = Event->idle (repeat => 0, min => 1, data => cf::WF_AUTOCANCEL, cb => sub { 3# statistics-package
4
5use Fcntl;
6use Coro::AIO;
7
8our %PLAYERSEEN;
9
10our $UPDATE_LOGINS = AE::idle sub {
11 $_[0]->stop;
12
13 cf::async {
4 my ($status, @pl) = ext::commands::who_listing; 14 my ($status, @pl) = ext::commands::who_listing;
5 15
6 open my $fh, ">", cf::localdir . "/usercount"; 16 my $fh = aio_open "$LOCALDIR/usercount", O_WRONLY | O_CREAT | O_TRUNC, 0644
7 print $fh scalar @pl; 17 or return;
18 aio_write $fh, 0, undef, scalar @pl, 0;
19 aio_close $fh;
8 20
9 open my $fh, ">", cf::localdir . "/userlisting.html"; 21 my $who;
10 for ($status, @pl) { 22 for ($status, @pl) {
11 s/[<&]//g; 23 s/[<&]//g;
12 print $fh "$_<br />\n"; 24 $who .= "$_<br />\n";
25 }
26
27 my $fh = aio_open "$LOCALDIR/userlisting.html", O_WRONLY | O_CREAT | O_TRUNC, 0644
28 or return;
29 aio_write $fh, 0, undef, $who, 0;
30 aio_close $fh;
13 } 31 };
14}); 32};
15 33
16cf::attach_to_players 34cf::object->attach (
35 on_kill => sub {
36 my ($ob, $hitter) = @_;
37
38 return unless $hitter;
39 $hitter = $hitter->outer_owner;
40 my $pl = $hitter->contr
41 or return;
42
43 ++$hitter->{stats_kill}{$ob->name};
44 },
45);
46
47cf::player->attach (
17 on_login => sub { 48 on_login => sub {
18 my ($pl) = @_; 49 my ($pl) = @_;
50
19 $pl->ob->set_ob_key_value (schmorplog_last_login => time); 51 $pl->ob->kv_set (schmorplog_last_login => time);
20 52
21 $pl->ob->set_ob_key_value (schmorplog_login_count => 53 $pl->ob->kv_set (schmorplog_login_count =>
22 1 + $pl->ob->get_ob_key_value ("schmorplog_login_count")); 54 1 + $pl->ob->kv_get ("schmorplog_login_count"));
23 55
24 (my $client = $pl->socket->client) =~ s/\n/\\n/g; 56 $pl->ob->kv_set (schmorplog_client => $pl->ns->{who_version});
25 57
26 $pl->ob->set_ob_key_value (schmorplog_client => $client); 58 my $name = $pl->ob->name;
27 59
28 ext::schmorp_irc::do_notice (sprintf "%s logged in", $pl->ob->name); 60 ext::irc::do_notice $name . " logged in";
29 61
62 undef $PLAYERSEEN{$name};
30 $UPDATE_LOGINS->start; 63 $UPDATE_LOGINS->start;
64
65 cf::trace "LOGIN: ", $pl->ob->name, " from ", $pl->ns->host;
31 }, 66 },
32 on_logout => sub { 67 on_logout => sub {
33 my ($pl) = @_; 68 my ($pl, $cleanly) = @_;
34 $pl->ob->set_ob_key_value (schmorplog_last_logout => time); 69 $pl->ob->kv_set (schmorplog_last_logout => time);
35 ext::schmorp_irc::do_notice (sprintf "%s left", $pl->ob->name); 70 ext::irc::do_notice $pl->ob->name . " left";
36 71
37 $UPDATE_LOGINS->start; 72 $UPDATE_LOGINS->start;
73
74 cf::trace "LOGOUT: ", $pl->ob->name, " from ", $pl->ns->host, " ($cleanly)";
38 }, 75 },
39 on_birth => sub { 76 on_birth => sub {
40 my ($pl) = @_; 77 my ($pl) = @_;
41 ext::schmorp_irc::do_notice (sprintf "%s was just born", $pl->ob->name);
42 $pl->ob->set_ob_key_value (schmorplog_birthdate => time); 78 $pl->ob->kv_set (schmorplog_birthdate => time);
79 ext::irc::do_notice $pl->ob->name . " was just born";
80
81 cf::trace "BIRTH: ", $pl->ob->name, " from ", $pl->ns->host;
43 }, 82 },
44 on_quit => sub { 83 on_quit => sub {
45 my ($pl) = @_; 84 my ($pl) = @_;
46 ext::schmorp_irc::do_notice (sprintf "%s quit the game", $pl->ob->name); 85 ext::irc::do_notice $pl->ob->name . " quit the game";
86
87 cf::trace "QUIT: ", $pl->ob->name, " from ", $pl->ns->host;
47 }, 88 },
48 on_death => sub { 89 on_death => sub {
49 my ($pl) = @_; 90 my ($pl) = @_;
50 ext::schmorp_irc::do_notice (sprintf "%s was killed by %s", $pl->ob->name, $pl->killer);
51 91
92 my $msg = $pl->expand_cfpod ($pl->ob->name . " was killed by " . $pl->killer_name . ".");
93 ext::irc::do_notice $msg;
94
95 ++$pl->ob->{stats_death}{$pl->killer_name};
96
52 $pl->ob->set_ob_key_value (schmorplog_death_count => 97 $pl->ob->kv_set (schmorplog_death_count =>
53 1 + $pl->ob->get_ob_key_value ("schmorplog_death_count")); 98 1 + $pl->ob->kv_get ("schmorplog_death_count"));
99
100 $_->send_msg ("" => $msg, cf::NDI_VERBATIM)
101 for cf::player::list;
54 }, 102 },
55 on_load => sub { 103 on_load => sub {
56 my ($pl, $path) = @_; 104 my ($pl, $path) = @_;
57 $pl->ob->set_ob_key_value (schmorplog_last_load => time); 105 $pl->ob->kv_set (schmorplog_last_load => time);
58 }, 106 },
59 on_save => sub { 107 on_save => sub {
60 my ($pl, $path) = @_; 108 my ($pl, $path) = @_;
61 $pl->ob->set_ob_key_value (schmorplog_last_save => time); 109 $pl->ob->kv_set (schmorplog_last_save => time);
110 },
111);
112
113cf::register_script_function "statistician::talk" => sub {
114 my ($who, $msg, $npc) = @_;
115
116 my ($cmd, $args) = split /\s+/, $msg, 2;
117
118 $args ||= $who->name;
119
120 if ($cmd eq "deaths") {
121 cf::async {
122 my $pl = cf::player::find $args
123 or return $who->reply ($npc, "I don't know any person named '$args'.");
124
125 my $s = $pl->ob->{stats_death}
126 or return $who->reply ($npc, "$args didn't die even once.");
127
128 my $rep = "$args died a total of " . $pl->ob->kv_get ("schmorplog_death_count") . " times, among them:\n\n";
129
130 for (sort { $s->{$b} <=> $s->{$a} } keys %$s) {
131 $rep .= sprintf " C<%4d> time(s) due to %s.\n", $s->{$_}, $_;
132 }
133
134 $who->reply ($npc, $rep);
135 };
136 } elsif ($cmd eq "kills") {
137 cf::async {
138 my $pl = cf::player::find $args
139 or return $who->reply ($npc, "I don't know any person named '$args'.");
140
141 my $s = $pl->ob->{stats_kill}
142 or return $who->reply ($npc, "I don't know of I<anything> that $args has killed so far.");
143
144 my $rep = sprintf "Here is a list of all the kills I know about:\n\n";
145 for (sort { $s->{$b} <=> $s->{$a} } keys %$s) {
146 $rep .= sprintf " C<%6s> %s\n", $s->{$_}, $_;
147 }
148
149 $who->reply ($npc, $rep);
150 };
151 } elsif ($cmd eq "hi") {
152 $who->reply ($npc, "Hello!\n\n"
153 . "I am a statistician, I keep statistics about all people here.\n\n"
154 . " - To know how often somebody died, ask C<deaths> I<playername>\n"
155 . " - To know how many kills somebody scored, ask C<kills> I<playername>");
156 } else {
157 $who->reply ($npc, "No idea what you want of me, how about saying 'hi' first?");
62 }, 158 }
63;
64 159
160 $cmd = lc $cmd;
161};
162
163# log "crash" messages, i.e. client exit reasons
164cf::register_exticmd clientlog => sub {
165 my ($ns, $msg) = @_;
166
167 my $name = $ns->pl && $ns->pl->ob ? $ns->pl->ob->name : "<unknown>";
168
169 $msg =~ y/\x0a\x20-\x7f//cd;
170 $msg =~ s/\s+$//;
171
172 cf::error sprintf "clientlog [%s/%s]: %s\n", $ns->host, $name, $msg;
173
174 ()
175};
176
177# log max playercount every minute
178#############################################################################
179
180our $STATSDIR = "$LOCALDIR/maxplayers";
181
182mkdir $STATSDIR;
183
184our $WRITE_MAXPLAYERS = EV::periodic 0, 60, undef, sub {
185 my $now = AE::now;
186 my $cnt = scalar keys %PLAYERSEEN;
187
188 %PLAYERSEEN = map +($_->ob->name => undef), grep $_->ns, cf::player::list;
189
190 my @time = gmtime $now;
191
192 my $path = sprintf "%s/%04d-%02d-%02d", $STATSDIR, $time[5] + 1900, $time[4] + 1, $time[3];
193 my $offs = $time [2] * 60 + $time [1];
194
195 $cnt++;
196 $cnt = 254 if $cnt > 254;
197 $cnt = chr $cnt;
198
199 IO::AIO::aio_open $path, O_WRONLY | O_CREAT, 0666, sub {
200 my $fh = shift
201 or return;
202
203 # the truncate is 1440 extra syscalls, but saves 1439
204 # slow metadata updates.
205 IO::AIO::aio_truncate $fh, 1440, sub {
206 IO::AIO::aio_write $fh, $offs, 1, $cnt, 0, sub {
207 IO::AIO::aio_close $fh;
208 };
209 };
210 };
211};
212

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines