/[irc-logger]/trunk/irc-logger.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 9 - (show annotations)
Wed Mar 1 23:35:56 2006 UTC (14 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 6947 byte(s)
sort by full time, not just time

1 #!/usr/bin/perl -w
2 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
20
21 my $NICK = 'irc-logger-dev';
22 my $CONNECT =
23 {Server => 'irc.freenode.net',
24 Nick => $NICK,
25 Ircname => "try /msg $NICK help",
26 };
27 my $CHANNEL = '#razmjenavjestina';
28 my $IRC_ALIAS = "log";
29
30 my %FOLLOWS =
31 (
32 ACCESS => "/var/log/apache/access.log",
33 ERROR => "/var/log/apache/error.log",
34 );
35
36 my $DSN = 'DBI:Pg:dbname=irc-logger';
37
38 ## END CONFIG
39
40
41
42 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);
80
81 POE::Session->create
82 (inline_states =>
83 {_start => sub {
84 $_[KERNEL]->post($IRC_ALIAS => register => 'all');
85 $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
86 },
87 irc_255 => sub { # server is done blabbing
88 $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
89 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
90 $_[KERNEL]->yield("heartbeat"); # start heartbeat
91 # $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
92 },
93 irc_public => sub {
94 my $kernel = $_[KERNEL];
95 my $nick = (split /!/, $_[ARG0])[0];
96 my $channel = $_[ARG1]->[0];
97 my $msg = $_[ARG2];
98
99 from_to($msg, 'UTF-8', 'ISO-8859-2');
100
101 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', try /msg $NICK help!";
111
112 print "<< $msg\n";
113
114 if ($msg =~ m/^help/i) {
115
116 $res = "usage: /msg $NICK stat - shows user statistics | /msg $NICK last - show backtrace of conversations";
117
118 } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
119
120 my $nr = $1 || 10;
121
122 my $sth = $dbh->prepare(qq{
123 select nick,count(*) from log group by nick order by count desc limit $nr
124 });
125 $sth->execute();
126 $res = "Top $nr users: ";
127 my @users;
128 while (my $row = $sth->fetchrow_hashref) {
129 push @users,$row->{nick} . ': ' . $row->{count};
130 }
131 $res .= join(" | ", @users);
132 } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
133
134 my $nr = $1 || 10;
135
136 my $sth = $dbh->prepare(qq{
137 select
138 time::date as date,
139 time::time as time,
140 channel,
141 nick,
142 message
143 from log order by log.time desc limit $nr
144 });
145 $sth->execute();
146 $res = "Last $nr messages: ";
147 my $last_row = {
148 date => '',
149 time => '',
150 channel => '',
151 nick => '',
152 };
153
154 my @rows;
155
156 while (my $row = $sth->fetchrow_hashref) {
157 unshift @rows, $row;
158 }
159
160 my @msgs;
161
162 foreach my $row (@rows) {
163
164 $row->{time} =~ s#\.\d+##;
165
166 my $t;
167 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
168 $t .= $row->{time};
169
170 my $msg = '';
171
172 $msg .= "($t";
173 $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});
174 $msg .= ") ";
175
176 $msg .= $row->{nick} . ': ' if ($last_row->{nick} ne $row->{nick});
177
178 $msg .= $row->{message};
179
180 push @msgs, $msg;
181
182 $last_row = $row;
183 }
184
185 foreach my $res (@msgs) {
186 print "last: $res\n";
187 from_to($res, 'ISO-8859-2', 'UTF-8');
188 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
189 }
190
191 $res = '';
192 }
193
194 if ($res) {
195 print ">> [$nick] $res\n";
196 from_to($res, 'ISO-8859-2', 'UTF-8');
197 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
198 }
199
200 },
201 irc_505 => sub {
202 print "# irc_505: ",$_[ARG1], "\n";
203 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
204 warn "## register $NICK\n";
205 },
206 irc_registered => sub {
207 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
208 warn "## indetify $NICK\n";
209 },
210 (map
211 {
212 ;"irc_$_" => sub { }}
213 qw(join
214 ctcp_version
215 connected snotice ctcp_action ping notice mode part quit
216 001 002 003 004 005
217 250 251 252 253 254 265 266
218 332 333 353 366 372 375 376
219 477
220 )),
221 _child => sub {},
222 _default => sub {
223 printf "%s: session %s caught an unhandled %s event.\n",
224 scalar localtime(), $_[SESSION]->ID, $_[ARG0];
225 print "The $_[ARG0] event was given these parameters: ",
226 join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";
227 0; # false for signals
228 },
229 my_add => sub {
230 my $trailing = $_[ARG0];
231 my $session = $_[SESSION];
232 POE::Session->create
233 (inline_states =>
234 {_start => sub {
235 $_[HEAP]->{wheel} =
236 POE::Wheel::FollowTail->new
237 (
238 Filename => $FOLLOWS{$trailing},
239 InputEvent => 'got_line',
240 );
241 },
242 got_line => sub {
243 $_[KERNEL]->post($session => my_tailed =>
244 time, $trailing, $_[ARG0]);
245 },
246 },
247 );
248
249 },
250 my_tailed => sub {
251 my ($time, $file, $line) = @_[ARG0..ARG2];
252 ## $time will be undef on a probe, or a time value if a real line
253
254 ## PoCo::IRC has throttling built in, but no external visibility
255 ## so this is reaching "under the hood"
256 $SEND_QUEUE ||=
257 $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};
258
259 ## handle "no need to keep skipping" transition
260 if ($SKIPPING and @$SEND_QUEUE < 1) {
261 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
262 "[discarded $SKIPPING messages]");
263 $SKIPPING = 0;
264 }
265
266 ## handle potential message display
267 if ($time) {
268 if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds
269 $SKIPPING++;
270 } else {
271 my @time = localtime $time;
272 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
273 sprintf "%02d:%02d:%02d: %s: %s",
274 ($time[2] + 11) % 12 + 1, $time[1], $time[0],
275 $file, $line);
276 }
277 }
278
279 ## handle re-probe/flush if skipping
280 if ($SKIPPING) {
281 $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef
282 }
283
284 },
285 my_heartbeat => sub {
286 $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");
287 $_[KERNEL]->delay($_[STATE] => 10);
288 }
289 },
290 );
291
292 POE::Kernel->run;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26