/[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

Diff of /trunk/bin/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by dpavlin, Wed Mar 1 23:35:56 2006 UTC revision 33 by dpavlin, Sat Jun 24 22:15:47 2006 UTC
# Line 18  log all conversation on irc channel Line 18  log all conversation on irc channel
18    
19  ## CONFIG  ## CONFIG
20    
21  my $NICK = 'irc-logger-dev';  my $HOSTNAME = `hostname`;
22    
23    my $NICK = 'irc-logger';
24    $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
25  my $CONNECT =  my $CONNECT =
26    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
27     Nick => $NICK,     Nick => $NICK,
28     Ircname => "try /msg $NICK help",     Ircname => "try /msg $NICK help",
29    };    };
30  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
31    $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
32  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
33    
34  my %FOLLOWS =  my %FOLLOWS =
# Line 33  my %FOLLOWS = Line 37  my %FOLLOWS =
37     ERROR => "/var/log/apache/error.log",     ERROR => "/var/log/apache/error.log",
38    );    );
39    
40  my $DSN = 'DBI:Pg:dbname=irc-logger';  my $DSN = 'DBI:Pg:dbname=' . $NICK;
41    
42    my $ENCODING = 'ISO-8859-2';
43    
44  ## END CONFIG  ## END CONFIG
45    
46    
47    
48  use POE qw(Component::IRC Wheel::FollowTail);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
49    use HTTP::Status;
50  use DBI;  use DBI;
51  use Encode qw/from_to/;  use Encode qw/from_to is_utf8/;
52    use Regexp::Common qw /URI/;
53    use CGI::Simple;
54    use HTML::TagCloud;
55    
56  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
57    
58  =for SQL schema  eval {
59            $dbh->do(qq{ select count(*) from log });
60    };
61    
62    if ($@) {
63            warn "creating database table in $DSN\n";
64            $dbh->do(<<'_SQL_SCHEMA_');
65    
 $dbh->do(qq{  
66  create table log (  create table log (
67          id serial,          id serial,
68          time timestamp default now(),          time timestamp default now(),
69          channel text not null,          channel text not null,
70            me boolean default false,
71          nick text not null,          nick text not null,
72          message text not null,          message text not null,
73          primary key(id)          primary key(id)
# Line 62  create index log_time on log(time); Line 77  create index log_time on log(time);
77  create index log_channel on log(channel);  create index log_channel on log(channel);
78  create index log_nick on log(nick);  create index log_nick on log(nick);
79    
80  });  _SQL_SCHEMA_
81    }
 =cut  
82    
83  my $sth = $dbh->prepare(qq{  my $sth = $dbh->prepare(qq{
84  insert into log  insert into log
85          (channel, nick, message)          (channel, me, nick, message)
86  values (?,?,?)  values (?,?,?,?)
87  });  });
88    
89    my $tags;
90    my $tag_regex = '\b([\w-_]+)//';
91    
92    =head2 get_from_log
93    
94     my @messages = get_from_log(
95            limit => 42,
96            search => '%what to stuff in ilike%',
97            fmt => {
98                    time => '{%s} ',
99                    time_channel => '{%s %s} ',
100                    nick => '%s: ',
101                    me_nick => '***%s ',
102                    message => '%s',
103            },
104            filter => {
105                    message => sub {
106                            # modify message content
107                            return shift;
108                    }
109            },
110            context => 5,
111     );
112    
113    Order is important. Fields are first passed through C<filter> (if available) and
114    then throgh C<< sprintf($fmt->{message}, $message >> if available.
115    
116    C<context> defines number of messages around each search hit for display.
117    
118    =cut
119    
120    sub get_from_log {
121            my $args = {@_};
122    
123            $args->{limit} ||= 10;
124    
125            $args->{fmt} ||= {
126                    date => '[%s] ',
127                    time => '{%s} ',
128                    time_channel => '{%s %s} ',
129                    nick => '%s: ',
130                    me_nick => '***%s ',
131                    message => '%s',
132            };
133    
134            my $sql_message = qq{
135                    select
136                            time::date as date,
137                            time::time as time,
138                            channel,
139                            me,
140                            nick,
141                            message
142                    from log
143            };
144    
145            my $sql_context = qq{
146                    select
147                            id
148                    from log
149            };
150    
151            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
152    
153            my $sql = $context ? $sql_context : $sql_message;
154    
155            $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
156            $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });
157            $sql .= " order by log.time desc";
158            $sql .= " limit " . $args->{limit};
159    
160            my $sth = $dbh->prepare( $sql );
161            if (my $search = $args->{search}) {
162                    $search =~ s/^\s+//;
163                    $search =~ s/\s+$//;
164                    $sth->execute( ( '%' . $search . '%' ) x 2 );
165                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
166            } elsif (my $tag = $args->{tag}) {
167                    $sth->execute();
168                    warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n";
169            } else {
170                    $sth->execute();
171            }
172            my $last_row = {
173                    date => '',
174                    time => '',
175                    channel => '',
176                    nick => '',
177            };
178    
179            my @rows;
180    
181            while (my $row = $sth->fetchrow_hashref) {
182                    unshift @rows, $row;
183            }
184    
185            my @msgs = (
186                    "Showing " . ($#rows + 1) . " messages..."
187            );
188    
189            if ($context) {
190                    my @ids = @rows;
191                    @rows = ();
192    
193                    my $last_to = 0;
194    
195                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
196                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
197                            my $id = $row_id->{id} || die "can't find id in row";
198            
199                            my ($from, $to) = ($id - $context, $id + $context);
200                            $from = $last_to if ($from < $last_to);
201                            $last_to = $to;
202                            $sth->execute( $from, $to );
203    
204                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
205    
206                            while (my $row = $sth->fetchrow_hashref) {
207                                    push @rows, $row;
208                            }
209    
210                    }
211            }
212    
213            foreach my $row (@rows) {
214    
215                    $row->{time} =~ s#\.\d+##;
216    
217                    my $msg = '';
218    
219                    $msg = sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
220                    my $t = $row->{time};
221    
222                    if ($last_row->{channel} ne $row->{channel}) {
223                            $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
224                    } else {
225                            $msg .= sprintf($args->{fmt}->{time}, $t);
226                    }
227    
228                    my $append = 1;
229    
230                    my $nick = $row->{nick};
231                    if ($nick =~ s/^_*(.*?)_*$/$1/) {
232                            $row->{nick} = $nick;
233                    }
234    
235                    if ($last_row->{nick} ne $nick) {
236                            # obfu way to find format for me_nick if needed or fallback to default
237                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
238                            $fmt ||= '%s';
239    
240                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
241    
242                            $msg .= sprintf( $fmt, $nick );
243                            $append = 0;
244                    }
245    
246                    $args->{fmt}->{message} ||= '%s';
247                    if (ref($args->{filter}->{message}) eq 'CODE') {
248                            $msg .= sprintf($args->{fmt}->{message},
249                                    $args->{filter}->{message}->(
250                                            $row->{message}
251                                    )
252                            );
253                    } else {
254                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
255                    }
256    
257                    if ($append && @msgs) {
258                            $msgs[$#msgs] .= " " . $msg;
259                    } else {
260                            push @msgs, $msg;
261                    }
262    
263                    $last_row = $row;
264            }
265    
266            return @msgs;
267    }
268    
269    
270  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
271  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
# Line 89  POE::Session->create Line 283  POE::Session->create
283                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
284                  $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
285  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
286                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
287      },      },
288      irc_public => sub {      irc_public => sub {
289                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 96  POE::Session->create Line 291  POE::Session->create
291                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
292                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
293    
294                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
295    
296                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
297                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
298                    add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
299                            message => $msg);
300        },
301        irc_ctcp_action => sub {
302                    my $kernel = $_[KERNEL];
303                    my $nick = (split /!/, $_[ARG0])[0];
304                    my $channel = $_[ARG1]->[0];
305                    my $msg = $_[ARG2];
306    
307                    from_to($msg, 'UTF-8', $ENCODING);
308    
309                    print "$channel ***$nick $msg\n";
310                    $sth->execute($channel, 1, $nick, $msg);
311                    add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
312                            message => $msg);
313      },      },
314          irc_msg => sub {          irc_msg => sub {
315                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
316                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
317                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
318                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
319    
320                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
321                    my @out;
322    
323                  print "<< $msg\n";                  print "<< $msg\n";
324    
325                  if ($msg =~ m/^help/i) {                  if ($msg =~ m/^help/i) {
326    
327                          $res = "usage: /msg $NICK stat - shows user statistics | /msg $NICK last - show backtrace of conversations";                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
328    
329                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
330    
331                            print ">> /msg $1 $2\n";
332                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
333                            $res = '';
334    
335                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
336    
# Line 131  POE::Session->create Line 348  POE::Session->create
348                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
349                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
350    
351                          my $nr = $1 || 10;                          foreach my $res (get_from_log( limit => $1 )) {
352                                    print "last: $res\n";
353                          my $sth = $dbh->prepare(qq{                                  from_to($res, $ENCODING, 'UTF-8');
354                                  select                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
                                         time::date as date,  
                                         time::time as time,  
                                         channel,  
                                         nick,  
                                         message  
                                 from log order by log.time desc limit $nr  
                         });  
                         $sth->execute();  
                         $res = "Last $nr messages: ";  
                         my $last_row = {  
                                 date => '',  
                                 time => '',  
                                 channel => '',  
                                 nick => '',  
                         };  
   
                         my @rows;  
   
                         while (my $row = $sth->fetchrow_hashref) {  
                                 unshift @rows, $row;  
355                          }                          }
356    
357                          my @msgs;                          $res = '';
   
                         foreach my $row (@rows) {  
   
                                 $row->{time} =~ s#\.\d+##;  
   
                                 my $t;  
                                 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});  
                                 $t .= $row->{time};  
   
                                 my $msg = '';  
   
                                 $msg .= "($t";  
                                 $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});  
                                 $msg .= ") ";  
   
                                 $msg .= $row->{nick} . ': '  if ($last_row->{nick} ne $row->{nick});  
   
                                 $msg .= $row->{message};  
358    
359                                  push @msgs, $msg;                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
360    
361                                  $last_row = $row;                          my $what = $2;
                         }  
362    
363                          foreach my $res (@msgs) {                          foreach my $res (get_from_log(
364                                  print "last: $res\n";                                          limit => 20,
365                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                          search => $what,
366                                    )) {
367                                    print "search [$what]: $res\n";
368                                    from_to($res, $ENCODING, 'UTF-8');
369                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
370                          }                          }
371    
372                          $res = '';                          $res = '';
373    
374                  }                  }
375    
376                  if ($res) {                  if ($res) {
377                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
378                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
379                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
380                  }                  }
381    
382          },          },
383            irc_477 => sub {
384                    print "# irc_477: ",$_[ARG1], "\n";
385                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
386            },
387          irc_505 => sub {          irc_505 => sub {
388          print "# irc_505: ",$_[ARG1], "\n";                  print "# irc_505: ",$_[ARG1], "\n";
389                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
390                  warn "## register $NICK\n";  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
391    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
392          },          },
393          irc_registered => sub {          irc_registered => sub {
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
394                  warn "## indetify $NICK\n";                  warn "## indetify $NICK\n";
395                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
396            },
397    #       irc_433 => sub {
398    #               print "# irc_433: ",$_[ARG1], "\n";
399    #               warn "## indetify $NICK\n";
400    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
401    #       },
402            irc_372 => sub {
403                    print "MOTD: ", $_[ARG1], "\n";
404            },
405            irc_snotice => sub {
406                    print "(server notice): ", $_[ARG0], "\n";
407          },          },
408      (map      (map
409       {       {
410         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
411       qw(join       qw(
         ctcp_version  
         connected snotice ctcp_action ping notice mode part quit  
         001 002 003 004 005  
         250 251 252 253 254 265 266  
         332 333 353 366 372 375 376  
                 477  
412                  )),                  )),
413    #       join
414    #       ctcp_version
415    #       connected snotice ctcp_action ping notice mode part quit
416    #       001 002 003 004 005
417    #       250 251 252 253 254 265 266
418    #       332 333 353 366 372 375 376
419    #       477
420      _child => sub {},      _child => sub {},
421      _default => sub {      _default => sub {
422        printf "%s: session %s caught an unhandled %s event.\n",        printf "%s: session %s caught an unhandled %s event.\n",
# Line 289  POE::Session->create Line 488  POE::Session->create
488     },     },
489    );    );
490    
491    # tags support
492    
493    my $cloud = HTML::TagCloud->new;
494    
495    =head2 add_tag
496    
497     add_tag( id => 42, message => 'irc message' );
498    
499    =cut
500    
501    sub add_tag {
502            my $arg = {@_};
503    
504            return unless ($arg->{id} && $arg->{message});
505    
506            my $m = $arg->{message};
507            from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
508    
509            while ($m =~ s#$tag_regex##s) {
510                    my $tag = $1;
511                    next if (! $tag || $tag =~ m/https?:/i);
512                    push @{ $tags->{$tag} }, $arg->{id};
513                    #warn "+tag $tag: $arg->{id}\n";
514                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
515            }
516    }
517    
518    =head2 seed_tags
519    
520    Read all tags from database and create in-memory cache for tags
521    
522    =cut
523    
524    sub seed_tags {
525            my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
526            $sth->execute;
527            while (my $row = $sth->fetchrow_hashref) {
528                    add_tag( %$row );
529            }
530    
531            foreach my $tag (keys %$tags) {
532                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
533            }
534    }
535    
536    seed_tags;
537    
538    # http server
539    
540    my $httpd = POE::Component::Server::HTTP->new(
541            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
542            ContentHandler => { '/' => \&root_handler },
543            Headers        => { Server => 'irc-logger' },
544    );
545    
546    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
547    my $escape_re  = join '|' => keys %escape;
548    
549    my $style = <<'_END_OF_STYLE_';
550    p { margin: 0; padding: 0.1em; }
551    .time, .channel { color: #808080; font-size: 60%; }
552    .date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; }
553    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
554    .message { color: #000000; font-size: 100%; }
555    .search { float: right; }
556    .col-0 { background: #ffff66 }
557    .col-1 { background: #a0ffff }
558    .col-2 { background: #99ff99 }
559    .col-3 { background: #ff9999 }
560    .col-4 { background: #ff66ff }
561    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
562    a:hover.tag { border: 1px solid #eee }
563    _END_OF_STYLE_
564    
565    my $max_color = 4;
566    
567    my %nick_enumerator;
568    
569    sub root_handler {
570            my ($request, $response) = @_;
571            $response->code(RC_OK);
572            $response->content_type("text/html; charset=$ENCODING");
573    
574            my $q;
575    
576            if ( $request->method eq 'POST' ) {
577                    $q = new CGI::Simple( $request->content );
578            } elsif ( $request->uri =~ /\?(.+)$/ ) {
579                    $q = new CGI::Simple( $1 );
580            } else {
581                    $q = new CGI::Simple;
582            }
583    
584            my $search = $q->param('search') || $q->param('grep') || '';
585    
586            $response->content(
587                    qq{<html><head><title>$NICK</title><style type="text/css">$style} .
588                    $cloud->css .
589                    qq{</style></head><body>} .
590                    qq{
591                    <form method="post" class="search" action="/">
592                    <input type="text" name="search" value="$search" size="10">
593                    <input type="submit" value="search">
594                    </form>
595                    } .
596                    $cloud->html(500) .
597                    qq{<p>} .
598                    join("</p><p>",
599                            get_from_log(
600                                    limit => $q->param('last') || 100,
601                                    search => $search || undef,
602                                    tag => $q->param('tag') || undef,
603                                    fmt => {
604                                            date => '<hr size="1" style="clear: both;"/><div class="date">%s</div> ',
605                                            time => '<span class="time">%s</span> ',
606                                            time_channel => '<span class="channel">%s %s</span> ',
607                                            nick => '%s:&nbsp;',
608                                            me_nick => '***%s&nbsp;',
609                                            message => '<span class="message">%s</span>',
610                                    },
611                                    filter => {
612                                            message => sub {
613                                                    my $m = shift || return;
614                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
615                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
616                                                    $m =~ s#$tag_regex#<a href="?tag=$1" class="tag">$1</a>#g;
617                                                    return $m;
618                                            },
619                                            nick => sub {
620                                                    my $n = shift || return;
621                                                    if (! $nick_enumerator{$n})  {
622                                                            my $max = scalar keys %nick_enumerator;
623                                                            $nick_enumerator{$n} = $max + 1;
624                                                    }
625                                                    return '<span class="nick col-' .
626                                                            ( $nick_enumerator{$n} % $max_color ) .
627                                                            '">' . $n . '</span>';
628                                            },
629                                    },
630                            )
631                    ) .
632                    qq{</p></body></html>}
633            );
634            return RC_OK;
635    }
636    
637  POE::Kernel->run;  POE::Kernel->run;

Legend:
Removed from v.9  
changed lines
  Added in v.33

  ViewVC Help
Powered by ViewVC 1.1.26