2 |
use strict; |
use strict; |
3 |
$|++; |
$|++; |
4 |
|
|
5 |
|
=head1 NAME |
6 |
|
|
7 |
|
irc-logger.pl |
8 |
|
|
9 |
|
=head1 SYNOPSIS |
10 |
|
|
11 |
|
./irc-logger.pl |
12 |
|
|
13 |
|
=head1 DESCRIPTION |
14 |
|
|
15 |
|
log all conversation on irc channel |
16 |
|
|
17 |
|
=cut |
18 |
|
|
19 |
## CONFIG |
## CONFIG |
20 |
|
|
21 |
my $NICK = 'irc-logger'; |
my $NICK = 'irc-logger-dev'; |
22 |
my $CONNECT = |
my $CONNECT = |
23 |
{Server => 'irc.freenode.net', |
{Server => 'irc.freenode.net', |
24 |
Nick => $NICK, |
Nick => $NICK, |
33 |
ERROR => "/var/log/apache/error.log", |
ERROR => "/var/log/apache/error.log", |
34 |
); |
); |
35 |
|
|
36 |
|
my $DSN = 'DBI:Pg:dbname=irc-logger'; |
37 |
|
|
38 |
## END CONFIG |
## END CONFIG |
39 |
|
|
40 |
my $SKIPPING = 0; # if skipping, how many we've done |
|
|
my $SEND_QUEUE; # cache |
|
41 |
|
|
42 |
use POE qw(Component::IRC Wheel::FollowTail); |
use POE qw(Component::IRC Wheel::FollowTail); |
43 |
|
use DBI; |
44 |
|
use Encode qw/from_to/; |
45 |
|
|
46 |
|
|
47 |
|
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; |
48 |
|
|
49 |
|
=for SQL schema |
50 |
|
|
51 |
|
$dbh->do(qq{ |
52 |
|
create table log ( |
53 |
|
id serial, |
54 |
|
time timestamp default now(), |
55 |
|
channel text not null, |
56 |
|
nick text not null, |
57 |
|
message text not null, |
58 |
|
primary key(id) |
59 |
|
); |
60 |
|
|
61 |
|
create index log_time on log(time); |
62 |
|
create index log_channel on log(channel); |
63 |
|
create index log_nick on log(nick); |
64 |
|
|
65 |
|
}); |
66 |
|
|
67 |
|
=cut |
68 |
|
|
69 |
|
my $sth = $dbh->prepare(qq{ |
70 |
|
insert into log |
71 |
|
(channel, nick, message) |
72 |
|
values (?,?,?) |
73 |
|
}); |
74 |
|
|
75 |
|
|
76 |
|
my $SKIPPING = 0; # if skipping, how many we've done |
77 |
|
my $SEND_QUEUE; # cache |
78 |
|
|
79 |
POE::Component::IRC->new($IRC_ALIAS); |
POE::Component::IRC->new($IRC_ALIAS); |
80 |
|
|
81 |
POE::Session->create |
POE::Session->create |
82 |
(inline_states => |
(inline_states => |
83 |
{_start => sub { |
{_start => sub { |
84 |
$_[KERNEL]->post($IRC_ALIAS => register => 'all'); |
$_[KERNEL]->post($IRC_ALIAS => register => 'all'); |
85 |
$_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); |
$_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); |
86 |
}, |
}, |
87 |
irc_255 => sub { # server is done blabbing |
irc_255 => sub { # server is done blabbing |
88 |
$_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL); |
$_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL); |
89 |
$_[KERNEL]->post($IRC_ALIAS => join => '#logger'); |
$_[KERNEL]->post($IRC_ALIAS => join => '#logger'); |
90 |
$_[KERNEL]->yield("heartbeat"); # start heartbeat |
$_[KERNEL]->yield("heartbeat"); # start heartbeat |
91 |
# $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS; |
# $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS; |
92 |
}, |
}, |
93 |
irc_public => sub { |
irc_public => sub { |
94 |
my $kernel = $_[KERNEL]; |
my $kernel = $_[KERNEL]; |
95 |
my $nick = (split /!/, $_[ARG0])[0]; |
my $nick = (split /!/, $_[ARG0])[0]; |
96 |
my $channel = $_[ARG1]->[0]; |
my $channel = $_[ARG1]->[0]; |
97 |
my $msg = $_[ARG2]; |
my $msg = $_[ARG2]; |
98 |
|
|
99 |
|
from_to($msg, 'UTF-8', 'ISO-8859-2'); |
100 |
|
|
101 |
print "$channel: <$nick> $msg\n"; |
print "$channel: <$nick> $msg\n"; |
102 |
|
$sth->execute($channel, $nick, $msg); |
103 |
}, |
}, |
104 |
|
irc_msg => sub { |
105 |
|
my $kernel = $_[KERNEL]; |
106 |
|
my $nick = (split /!/, $_[ARG0])[0]; |
107 |
|
my $msg = $_[ARG2]; |
108 |
|
from_to($msg, 'UTF-8', 'ISO-8859-2'); |
109 |
|
|
110 |
|
my $res = 'unknown command ' . $msg; |
111 |
|
|
112 |
|
print "<< $msg\n"; |
113 |
|
|
114 |
|
if ($msg =~ m/^stat.*\s*(\d*)/) { |
115 |
|
|
116 |
|
my $nr = $1 || 10; |
117 |
|
|
118 |
|
my $sth = $dbh->prepare(qq{ |
119 |
|
select nick,count(*) from log group by nick order by count desc limit $nr |
120 |
|
}); |
121 |
|
$sth->execute(); |
122 |
|
$res = "Top $nr users: "; |
123 |
|
while (my $row = $sth->fetchrow_hashref) { |
124 |
|
$res .= $row->{nick} . ': ' . $row->{count} . ", "; |
125 |
|
} |
126 |
|
} |
127 |
|
|
128 |
|
$res =~ s/,\s*$//; |
129 |
|
print ">> [$nick] $res\n"; |
130 |
|
|
131 |
|
from_to($res, 'ISO-8859-2', 'UTF-8'); |
132 |
|
$_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); |
133 |
|
|
134 |
|
}, |
135 |
|
irc_505 => sub { |
136 |
|
print "# irc_505: ",$_[ARG1], "\n"; |
137 |
|
$_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" ); |
138 |
|
warn "## register $NICK\n"; |
139 |
|
$_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); |
140 |
|
warn "## indetify $NICK\n"; |
141 |
|
}, |
142 |
(map |
(map |
143 |
{ |
{ |
144 |
;"irc_$_" => sub { }} |
;"irc_$_" => sub { }} |
147 |
connected snotice ctcp_action ping notice mode part quit |
connected snotice ctcp_action ping notice mode part quit |
148 |
001 002 003 004 005 |
001 002 003 004 005 |
149 |
250 251 252 253 254 265 266 |
250 251 252 253 254 265 266 |
150 |
332 333 353 366 372 375 376)), |
332 333 353 366 372 375 376 |
151 |
|
477 |
152 |
|
)), |
153 |
_child => sub {}, |
_child => sub {}, |
154 |
_default => sub { |
_default => sub { |
155 |
printf "%s: session %s caught an unhandled %s event.\n", |
printf "%s: session %s caught an unhandled %s event.\n", |