/[irc-logger]/trunk/bin/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/bin/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (show annotations)
Sun Mar 12 14:19:00 2006 UTC (14 years, 10 months ago) by dpavlin
Original Path: trunk/irc-logger.pl
File MIME type: text/plain
File size: 9812 byte(s)
added http server to display last messages
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 Component::Server::HTTP);
43 use HTTP::Status;
44 use DBI;
45 use Encode qw/from_to/;
46
47
48 my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
49
50 =for SQL schema
51
52 $dbh->do(qq{
53 create table log (
54 id serial,
55 time timestamp default now(),
56 channel text not null,
57 nick text not null,
58 message text not null,
59 primary key(id)
60 );
61
62 create index log_time on log(time);
63 create index log_channel on log(channel);
64 create index log_nick on log(nick);
65
66 });
67
68 =cut
69
70 my $sth = $dbh->prepare(qq{
71 insert into log
72 (channel, nick, message)
73 values (?,?,?)
74 });
75
76 =head2 get_from_log
77
78 my @messages = get_from_log(
79 limit => 42,
80 search => '%what to stuff in ilike%',
81 fmt => {
82 time => '{%s} ',
83 time_channel => '{%s %s} ',
84 nick => '%s: ',
85 message => '%s',
86 },
87 );
88
89 =cut
90
91 sub get_from_log {
92 my $args = {@_};
93
94 $args->{limit} ||= 10;
95
96 $args->{fmt} ||= {
97 time => '{%s} ',
98 time_channel => '{%s %s} ',
99 nick => '%s: ',
100 message => '%s',
101 };
102
103 my $sql = qq{
104 select
105 time::date as date,
106 time::time as time,
107 channel,
108 nick,
109 message
110 from log
111 };
112 $sql .= " where message ilike ? " if ($args->{search});
113 $sql .= " order by log.time desc";
114 $sql .= " limit " . $args->{limit};
115
116 my $sth = $dbh->prepare( $sql );
117 if ($args->{search}) {
118 $sth->execute( $args->{search} );
119 } else {
120 $sth->execute();
121 }
122 my $last_row = {
123 date => '',
124 time => '',
125 channel => '',
126 nick => '',
127 };
128
129 my @rows;
130
131 while (my $row = $sth->fetchrow_hashref) {
132 unshift @rows, $row;
133 }
134
135 my @msgs;
136
137 foreach my $row (@rows) {
138
139 $row->{time} =~ s#\.\d+##;
140
141 my $t;
142 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
143 $t .= $row->{time};
144
145 my $msg = '';
146
147 if ($last_row->{channel} ne $row->{channel}) {
148 $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
149 } else {
150 $msg .= sprintf($args->{fmt}->{time}, $t);
151 }
152
153 my $append = 1;
154
155 if ($last_row->{nick} ne $row->{nick}) {
156 $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});
157 $append = 0;
158 }
159
160 $msg .= sprintf($args->{fmt}->{message}, $row->{message});
161
162 if ($append && @msgs) {
163 $msgs[$#msgs] .= " " . $msg;
164 } else {
165 push @msgs, $msg;
166 }
167
168 $last_row = $row;
169 }
170
171 return @msgs;
172 }
173
174
175 my $SKIPPING = 0; # if skipping, how many we've done
176 my $SEND_QUEUE; # cache
177
178 POE::Component::IRC->new($IRC_ALIAS);
179
180 POE::Session->create
181 (inline_states =>
182 {_start => sub {
183 $_[KERNEL]->post($IRC_ALIAS => register => 'all');
184 $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
185 },
186 irc_255 => sub { # server is done blabbing
187 $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
188 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
189 $_[KERNEL]->yield("heartbeat"); # start heartbeat
190 # $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
191 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
192 },
193 irc_public => sub {
194 my $kernel = $_[KERNEL];
195 my $nick = (split /!/, $_[ARG0])[0];
196 my $channel = $_[ARG1]->[0];
197 my $msg = $_[ARG2];
198
199 from_to($msg, 'UTF-8', 'ISO-8859-2');
200
201 print "$channel: <$nick> $msg\n";
202 $sth->execute($channel, $nick, $msg);
203 },
204 irc_msg => sub {
205 my $kernel = $_[KERNEL];
206 my $nick = (split /!/, $_[ARG0])[0];
207 my $msg = $_[ARG2];
208 from_to($msg, 'UTF-8', 'ISO-8859-2');
209
210 my $res = "unknown command '$msg', try /msg $NICK help!";
211 my @out;
212
213 print "<< $msg\n";
214
215 if ($msg =~ m/^help/i) {
216
217 $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
218
219 } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
220
221 print ">> /msg $1 $2\n";
222 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
223 $res = '';
224
225 } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
226
227 my $nr = $1 || 10;
228
229 my $sth = $dbh->prepare(qq{
230 select nick,count(*) from log group by nick order by count desc limit $nr
231 });
232 $sth->execute();
233 $res = "Top $nr users: ";
234 my @users;
235 while (my $row = $sth->fetchrow_hashref) {
236 push @users,$row->{nick} . ': ' . $row->{count};
237 }
238 $res .= join(" | ", @users);
239 } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
240
241 foreach my $res (get_from_log( limit => $1 )) {
242 print "last: $res\n";
243 from_to($res, 'ISO-8859-2', 'UTF-8');
244 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
245 }
246
247 $res = '';
248
249 } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {
250
251 my $what = $2;
252
253 foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {
254 print "search [$what]: $res\n";
255 from_to($res, 'ISO-8859-2', 'UTF-8');
256 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
257 }
258
259 $res = '';
260
261 }
262
263 if ($res) {
264 print ">> [$nick] $res\n";
265 from_to($res, 'ISO-8859-2', 'UTF-8');
266 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
267 }
268
269 },
270 irc_477 => sub {
271 print "# irc_477: ",$_[ARG1], "\n";
272 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
273 },
274 irc_505 => sub {
275 print "# irc_505: ",$_[ARG1], "\n";
276 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
277 # $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
278 # $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
279 },
280 irc_registered => sub {
281 warn "## indetify $NICK\n";
282 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
283 },
284 # irc_433 => sub {
285 # print "# irc_433: ",$_[ARG1], "\n";
286 # warn "## indetify $NICK\n";
287 # $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
288 # },
289 irc_372 => sub {
290 print "MOTD: ", $_[ARG1], "\n";
291 },
292 irc_snotice => sub {
293 print "(server notice): ", $_[ARG0], "\n";
294 },
295 (map
296 {
297 ;"irc_$_" => sub { }}
298 qw(
299 )),
300 # join
301 # ctcp_version
302 # connected snotice ctcp_action ping notice mode part quit
303 # 001 002 003 004 005
304 # 250 251 252 253 254 265 266
305 # 332 333 353 366 372 375 376
306 # 477
307 _child => sub {},
308 _default => sub {
309 printf "%s: session %s caught an unhandled %s event.\n",
310 scalar localtime(), $_[SESSION]->ID, $_[ARG0];
311 print "The $_[ARG0] event was given these parameters: ",
312 join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";
313 0; # false for signals
314 },
315 my_add => sub {
316 my $trailing = $_[ARG0];
317 my $session = $_[SESSION];
318 POE::Session->create
319 (inline_states =>
320 {_start => sub {
321 $_[HEAP]->{wheel} =
322 POE::Wheel::FollowTail->new
323 (
324 Filename => $FOLLOWS{$trailing},
325 InputEvent => 'got_line',
326 );
327 },
328 got_line => sub {
329 $_[KERNEL]->post($session => my_tailed =>
330 time, $trailing, $_[ARG0]);
331 },
332 },
333 );
334
335 },
336 my_tailed => sub {
337 my ($time, $file, $line) = @_[ARG0..ARG2];
338 ## $time will be undef on a probe, or a time value if a real line
339
340 ## PoCo::IRC has throttling built in, but no external visibility
341 ## so this is reaching "under the hood"
342 $SEND_QUEUE ||=
343 $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};
344
345 ## handle "no need to keep skipping" transition
346 if ($SKIPPING and @$SEND_QUEUE < 1) {
347 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
348 "[discarded $SKIPPING messages]");
349 $SKIPPING = 0;
350 }
351
352 ## handle potential message display
353 if ($time) {
354 if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds
355 $SKIPPING++;
356 } else {
357 my @time = localtime $time;
358 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
359 sprintf "%02d:%02d:%02d: %s: %s",
360 ($time[2] + 11) % 12 + 1, $time[1], $time[0],
361 $file, $line);
362 }
363 }
364
365 ## handle re-probe/flush if skipping
366 if ($SKIPPING) {
367 $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef
368 }
369
370 },
371 my_heartbeat => sub {
372 $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");
373 $_[KERNEL]->delay($_[STATE] => 10);
374 }
375 },
376 );
377
378 # http server
379
380 my $httpd = POE::Component::Server::HTTP->new(
381 Port => 8000,
382 ContentHandler => { '/' => \&root_handler },
383 Headers => { Server => 'irc-logger' },
384 );
385
386 my $style = <<'_END_OF_STYLE_';
387 .time, .channel { color: #808080; font-size: 60%; }
388 .nick { color: #0000ff; font-size: 80%; }
389 .message { color: #000000; font-size: 100%; }
390 _END_OF_STYLE_
391
392 sub root_handler {
393 my ($request, $response) = @_;
394 $response->code(RC_OK);
395 $response->content_type('text/html');
396 $response->content(
397 qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>} .
398 "irc-logger url: " . $request->uri . '<br/>' .
399 join("<br/>",
400 get_from_log(
401 limit => 100,
402 fmt => {
403 time => '<span class="time">%s</span> ',
404 time_channel => '<span class="channel">%s %s</span> ',
405 nick => '<span class="nick">%s:</span> ',
406 message => '<span class="message">%s</span>',
407 },
408 )
409 ) .
410 qq{</body></html>}
411 );
412 return RC_OK;
413 }
414
415 POE::Kernel->run;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26