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

Legend:
Removed from v.10  
changed lines
  Added in v.30

  ViewVC Help
Powered by ViewVC 1.1.26