server/ext/schmorplog.ext

#! perl # depends=irc

# statistics-package

use Fcntl;
use Coro::AIO;

our $UPDATE_LOGINS = EV::idle sub {
   $_[0]->stop;

   cf::async {
      my ($status, @pl) = ext::commands::who_listing;

      my $fh = aio_open "$LOCALDIR/usercount", O_WRONLY | O_CREAT | O_TRUNC, 0644
         or return;
      aio_write $fh, 0, undef, scalar @pl, 0;
      aio_close $fh;

      my $who;
      for ($status, @pl) {
         s/[<&]//g;
         $who .= "$_<br />\n";
      }

      my $fh = aio_open "$LOCALDIR/userlisting.html", O_WRONLY | O_CREAT | O_TRUNC, 0644
         or return;
      aio_write $fh, 0, undef, $who, 0;
      aio_close $fh;
   };
};

cf::object->attach (
   on_kill => sub {
      my ($ob, $hitter) = @_;

      return unless $hitter;
      $hitter = $hitter->outer_owner;
      my $pl = $hitter->contr
         or return;

      ++$hitter->{stats_kill}{$ob->name};
   },
);

cf::player->attach (
   on_login => sub {
      my ($pl) = @_;
      $pl->ob->set_ob_key_value (schmorplog_last_login => time);

      $pl->ob->set_ob_key_value (schmorplog_login_count =>
         1 + $pl->ob->get_ob_key_value ("schmorplog_login_count"));

      (my $client = $pl->ns->version) =~ s/\n/\\n/g;

      $pl->ob->set_ob_key_value (schmorplog_client => $client);

      ext::irc::do_notice (sprintf "%s logged in", $pl->ob->name);

      $UPDATE_LOGINS->start;

      warn "LOGIN: ", $pl->ob->name, " from ", $pl->ns->host;
   },
   on_logout => sub {
      my ($pl, $cleanly) = @_;
      $pl->ob->set_ob_key_value (schmorplog_last_logout => time);
      ext::irc::do_notice (sprintf "%s left", $pl->ob->name);

      $UPDATE_LOGINS->start;

      warn "LOGOUT: ", $pl->ob->name, " from ", $pl->ns->host, " ($cleanly)";
   },
   on_birth => sub {
      my ($pl) = @_;
      ext::irc::do_notice (sprintf "%s was just born", $pl->ob->name);
      $pl->ob->set_ob_key_value (schmorplog_birthdate => time);

      warn "BIRTH: ", $pl->ob->name, " from ", $pl->ns->host;
   },
   on_quit => sub {
      my ($pl) = @_;
      ext::irc::do_notice (sprintf "%s quit the game", $pl->ob->name);

      warn "QUIT: ", $pl->ob->name, " from ", $pl->ns->host;
   },
   on_death => sub {
      my ($pl) = @_;
      ext::irc::do_notice (sprintf "%s was killed by %s", $pl->ob->name, $pl->killer_name);

      ++$pl->ob->{stats_death}{$pl->killer_name};

      $pl->ob->set_ob_key_value (schmorplog_death_count =>
         1 + $pl->ob->get_ob_key_value ("schmorplog_death_count"));
   },
   on_load => sub {
      my ($pl, $path) = @_;
      $pl->ob->set_ob_key_value (schmorplog_last_load => time);
   },
   on_save => sub {
      my ($pl, $path) = @_;
      $pl->ob->set_ob_key_value (schmorplog_last_save => time);
   },
);

cf::register_script_function "statistician::talk" => sub {
   my ($who, $msg, $npc) = @_;

   my ($cmd, $args) = split /\s+/, $msg, 2;

   $args ||= $who->name;

   if ($cmd eq "deaths") {
      cf::async {
         my $pl = cf::player::find $args
            or return $who->reply ($npc, "I don't know any person named '$args'.");

         my $s = $pl->ob->{stats_death}
            or return $who->reply ($npc, "$args didn't die even once.");

         my $rep = "$args died a total of " . $pl->ob->get_ob_key_value ("schmorplog_death_count") . " times, among them:\n\n\n\n";

         for (sort { $s->{$b} <=> $s->{$a} } keys %$s) {
            $rep .= "$s->{$_} time(s) due to $_.\n\n";
         }

         $who->reply ($npc, $rep);
      };
   } elsif ($cmd eq "kills") {
      cf::async {
         my $pl = cf::player::find $args
            or return $who->reply ($npc, "I don't know any person named '$args'.");

         my $s = $pl->ob->{stats_kill}
            or return $who->reply ($npc, "I don't know of I<anything> that $args has killed so far.");

         my $rep = sprintf "\n\nC<%6s> %s\n\n", "Kills", "Name";
         for (sort { $s->{$a} <=> $s->{$b} } keys %$s) {
            $rep .= sprintf "C<%6s> %s\n\n", $s->{$_}, $_;
         }

         $who->reply ($npc, $rep);
      };
   } elsif ($cmd eq "hi") {
      $who->reply ($npc, "Hello!\n\n"
                   . "I am a statistician, I keep statistics about all people here.\n\n"
                   . "To know how often somebody died, ask C<deaths> I<playername>\n\n"
                   . "To know how many kills somebody scored, ask C<kills> I<playername>");
   } else {
      $who->reply ($npc, "No idea what you want of me, how about saying 'hi' first?");
   }

   $cmd = lc $cmd;
};

Revision:	1.18
Committed:	Thu May 1 08:58:59 2008 UTC (16 years ago) by root
Branch:	MAIN
Changes since 1.17:	+2 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.10	#! perl # depends=irc
2	root	1.1
3	root	1.17	# statistics-package
4
5	root	1.12	use Fcntl;
6			use Coro::AIO;
7
8			our $UPDATE_LOGINS = EV::idle sub {
9	root	1.11	$_[0]->stop;
10
11	root	1.12	cf::async {
12			my ($status, @pl) = ext::commands::who_listing;
13	root	1.1
14	root	1.12	my $fh = aio_open "$LOCALDIR/usercount", O_WRONLY \| O_CREAT \| O_TRUNC, 0644
15			or return;
16			aio_write $fh, 0, undef, scalar @pl, 0;
17			aio_close $fh;
18
19			my $who;
20			for ($status, @pl) {
21			s/[<&]//g;
22			$who .= "$_<br />\n";
23			}
24
25			my $fh = aio_open "$LOCALDIR/userlisting.html", O_WRONLY \| O_CREAT \| O_TRUNC, 0644
26			or return;
27			aio_write $fh, 0, undef, $who, 0;
28			aio_close $fh;
29			};
30	root	1.11	};
31	root	1.1
32	root	1.14	cf::object->attach (
33			on_kill => sub {
34			my ($ob, $hitter) = @_;
35
36			return unless $hitter;
37			$hitter = $hitter->outer_owner;
38			my $pl = $hitter->contr
39			or return;
40
41	root	1.16	++$hitter->{stats_kill}{$ob->name};
42	root	1.14	},
43			);
44
45	root	1.3	cf::player->attach (
46	root	1.1	on_login => sub {
47			my ($pl) = @_;
48			$pl->ob->set_ob_key_value (schmorplog_last_login => time);
49
50			$pl->ob->set_ob_key_value (schmorplog_login_count =>
51			1 + $pl->ob->get_ob_key_value ("schmorplog_login_count"));
52
53	root	1.4	(my $client = $pl->ns->version) =~ s/\n/\\n/g;
54	root	1.1
55			$pl->ob->set_ob_key_value (schmorplog_client => $client);
56
57	root	1.9	ext::irc::do_notice (sprintf "%s logged in", $pl->ob->name);
58	root	1.1
59			$UPDATE_LOGINS->start;
60	root	1.5
61			warn "LOGIN: ", $pl->ob->name, " from ", $pl->ns->host;
62	root	1.1	},
63			on_logout => sub {
64	root	1.6	my ($pl, $cleanly) = @_;
65	root	1.1	$pl->ob->set_ob_key_value (schmorplog_last_logout => time);
66	root	1.9	ext::irc::do_notice (sprintf "%s left", $pl->ob->name);
67	root	1.1
68			$UPDATE_LOGINS->start;
69	root	1.5
70	root	1.6	warn "LOGOUT: ", $pl->ob->name, " from ", $pl->ns->host, " ($cleanly)";
71	root	1.1	},
72			on_birth => sub {
73			my ($pl) = @_;
74	root	1.9	ext::irc::do_notice (sprintf "%s was just born", $pl->ob->name);
75	root	1.1	$pl->ob->set_ob_key_value (schmorplog_birthdate => time);
76	root	1.5
77			warn "BIRTH: ", $pl->ob->name, " from ", $pl->ns->host;
78	root	1.1	},
79			on_quit => sub {
80			my ($pl) = @_;
81	root	1.9	ext::irc::do_notice (sprintf "%s quit the game", $pl->ob->name);
82	root	1.5
83			warn "QUIT: ", $pl->ob->name, " from ", $pl->ns->host;
84	root	1.1	},
85			on_death => sub {
86			my ($pl) = @_;
87	root	1.13	ext::irc::do_notice (sprintf "%s was killed by %s", $pl->ob->name, $pl->killer_name);
88	root	1.1
89	root	1.14	++$pl->ob->{stats_death}{$pl->killer_name};
90
91	root	1.1	$pl->ob->set_ob_key_value (schmorplog_death_count =>
92			1 + $pl->ob->get_ob_key_value ("schmorplog_death_count"));
93			},
94			on_load => sub {
95			my ($pl, $path) = @_;
96			$pl->ob->set_ob_key_value (schmorplog_last_load => time);
97			},
98			on_save => sub {
99			my ($pl, $path) = @_;
100			$pl->ob->set_ob_key_value (schmorplog_last_save => time);
101			},
102	root	1.3	);
103	root	1.1
104	root	1.17	cf::register_script_function "statistician::talk" => sub {
105			my ($who, $msg, $npc) = @_;
106
107			my ($cmd, $args) = split /\s+/, $msg, 2;
108
109			$args \|\|= $who->name;
110
111			if ($cmd eq "deaths") {
112			cf::async {
113			my $pl = cf::player::find $args
114			or return $who->reply ($npc, "I don't know any person named '$args'.");
115
116			my $s = $pl->ob->{stats_death}
117			or return $who->reply ($npc, "$args didn't die even once.");
118
119			my $rep = "$args died a total of " . $pl->ob->get_ob_key_value ("schmorplog_death_count") . " times, among them:\n\n\n\n";
120
121			for (sort { $s->{$b} <=> $s->{$a} } keys %$s) {
122	root	1.18	$rep .= "$s->{$_} time(s) due to $_.\n\n";
123	root	1.17	}
124
125			$who->reply ($npc, $rep);
126			};
127			} elsif ($cmd eq "kills") {
128			cf::async {
129			my $pl = cf::player::find $args
130			or return $who->reply ($npc, "I don't know any person named '$args'.");
131
132			my $s = $pl->ob->{stats_kill}
133			or return $who->reply ($npc, "I don't know of I<anything> that $args has killed so far.");
134
135	root	1.18	my $rep = sprintf "\n\nC<%6s> %s\n\n", "Kills", "Name";
136	root	1.17	for (sort { $s->{$a} <=> $s->{$b} } keys %$s) {
137			$rep .= sprintf "C<%6s> %s\n\n", $s->{$_}, $_;
138			}
139
140			$who->reply ($npc, $rep);
141			};
142			} elsif ($cmd eq "hi") {
143			$who->reply ($npc, "Hello!\n\n"
144			. "I am a statistician, I keep statistics about all people here.\n\n"
145			. "To know how often somebody died, ask C<deaths> I<playername>\n\n"
146			. "To know how many kills somebody scored, ask C<kills> I<playername>");
147			} else {
148			$who->reply ($npc, "No idea what you want of me, how about saying 'hi' first?");
149			}
150
151			$cmd = lc $cmd;
152			};
153