/[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 8 by dpavlin, Wed Mar 1 22:42:21 2006 UTC revision 26 by dpavlin, Sat May 20 10:30:45 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 $NICK = 'irc-logger';
22  my $CONNECT =  my $CONNECT =
23    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
24     Nick => $NICK,     Nick => $NICK,
# 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/;
48    use Regexp::Common qw /URI/;
49    use CGI::Simple;
50    
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    =head2 get_from_log
86    
87     my @messages = get_from_log(
88            limit => 42,
89            search => '%what to stuff in ilike%',
90            fmt => {
91                    time => '{%s} ',
92                    time_channel => '{%s %s} ',
93                    nick => '%s: ',
94                    me_nick => '***%s ',
95                    message => '%s',
96            },
97            filter => {
98                    message => sub {
99                            # modify message content
100                            return shift;
101                    }
102            },
103            context => 5,
104     );
105    
106    Order is important. Fields are first passed through C<filter> (if available) and
107    then throgh C<< sprintf($fmt->{message}, $message >> if available.
108    
109    C<context> defines number of messages around each search hit for display.
110    
111    =cut
112    
113    sub get_from_log {
114            my $args = {@_};
115    
116            $args->{limit} ||= 10;
117    
118            $args->{fmt} ||= {
119                    date => '[%s] ',
120                    time => '{%s} ',
121                    time_channel => '{%s %s} ',
122                    nick => '%s: ',
123                    me_nick => '***%s ',
124                    message => '%s',
125            };
126    
127            my $sql_message = qq{
128                    select
129                            time::date as date,
130                            time::time as time,
131                            channel,
132                            me,
133                            nick,
134                            message
135                    from log
136            };
137    
138            my $sql_context = qq{
139                    select
140                            id
141                    from log
142            };
143    
144            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
145    
146            my $sql = $context ? $sql_context : $sql_message;
147    
148            $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
149            $sql .= " order by log.time desc";
150            $sql .= " limit " . $args->{limit};
151    
152            my $sth = $dbh->prepare( $sql );
153            if (my $search = $args->{search}) {
154                    $search =~ s/^\s+//;
155                    $search =~ s/\s+$//;
156                    $sth->execute( ( '%' . $search . '%' ) x 2 );
157                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
158            } else {
159                    $sth->execute();
160            }
161            my $last_row = {
162                    date => '',
163                    time => '',
164                    channel => '',
165                    nick => '',
166            };
167    
168            my @rows;
169    
170            while (my $row = $sth->fetchrow_hashref) {
171                    unshift @rows, $row;
172            }
173    
174            my @msgs = (
175                    "Showing " . ($#rows + 1) . " messages..."
176            );
177    
178            if ($context) {
179                    my @ids = @rows;
180                    @rows = ();
181    
182                    my $last_to = 0;
183    
184                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
185                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
186                            my $id = $row_id->{id} || die "can't find id in row";
187            
188                            my ($from, $to) = ($id - $context, $id + $context);
189                            $from = $last_to if ($from < $last_to);
190                            $last_to = $to;
191                            $sth->execute( $from, $to );
192    
193                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
194    
195                            while (my $row = $sth->fetchrow_hashref) {
196                                    push @rows, $row;
197                            }
198    
199                    }
200            }
201    
202            foreach my $row (@rows) {
203    
204                    $row->{time} =~ s#\.\d+##;
205    
206                    my $msg = '';
207    
208                    $msg = sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
209                    my $t = $row->{time};
210    
211                    if ($last_row->{channel} ne $row->{channel}) {
212                            $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
213                    } else {
214                            $msg .= sprintf($args->{fmt}->{time}, $t);
215                    }
216    
217                    my $append = 1;
218    
219                    my $nick = $row->{nick};
220                    if ($nick =~ s/^_*(.*?)_*$/$1/) {
221                            $row->{nick} = $nick;
222                    }
223    
224                    if ($last_row->{nick} ne $nick) {
225                            # obfu way to find format for me_nick if needed or fallback to default
226                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
227                            $fmt ||= '%s';
228    
229                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
230    
231                            $msg .= sprintf( $fmt, $nick );
232                            $append = 0;
233                    }
234    
235                    $args->{fmt}->{message} ||= '%s';
236                    if (ref($args->{filter}->{message}) eq 'CODE') {
237                            $msg .= sprintf($args->{fmt}->{message},
238                                    $args->{filter}->{message}->(
239                                            $row->{message}
240                                    )
241                            );
242                    } else {
243                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
244                    }
245    
246                    if ($append && @msgs) {
247                            $msgs[$#msgs] .= " " . $msg;
248                    } else {
249                            push @msgs, $msg;
250                    }
251    
252                    $last_row = $row;
253            }
254    
255            return @msgs;
256    }
257    
258    
259  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
260  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
# Line 84  POE::Session->create Line 267  POE::Session->create
267                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
268                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
269      },      },
270      irc_255 => sub {            # server is done blabbing      irc_255 => sub {    # server is done blabbing
271                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
272                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
273                  $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
274  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
275                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
276      },      },
277      irc_public => sub {      irc_public => sub {
278                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 96  POE::Session->create Line 280  POE::Session->create
280                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
281                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
282    
283                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
284    
285                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
286                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
287        },
288        irc_ctcp_action => sub {
289                    my $kernel = $_[KERNEL];
290                    my $nick = (split /!/, $_[ARG0])[0];
291                    my $channel = $_[ARG1]->[0];
292                    my $msg = $_[ARG2];
293    
294                    from_to($msg, 'UTF-8', $ENCODING);
295    
296                    print "$channel ***$nick $msg\n";
297                    $sth->execute($channel, 1, $nick, $msg);
298      },      },
299          irc_msg => sub {          irc_msg => sub {
300                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
301                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
302                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
303                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
304    
305                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
306                    my @out;
307    
308                  print "<< $msg\n";                  print "<< $msg\n";
309    
310                  if ($msg =~ m/^help/i) {                  if ($msg =~ m/^help/i) {
311    
312                          $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";
313    
314                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
315    
316                            print ">> /msg $1 $2\n";
317                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
318                            $res = '';
319    
320                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
321    
# Line 131  POE::Session->create Line 333  POE::Session->create
333                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
334                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
335    
336                          my $nr = $1 || 10;                          foreach my $res (get_from_log( limit => $1 )) {
337                                    print "last: $res\n";
338                          my $sth = $dbh->prepare(qq{                                  from_to($res, $ENCODING, 'UTF-8');
339                                  select                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
                                         time::date as date,  
                                         time::time as time,  
                                         channel,  
                                         nick,  
                                         message  
                                 from log order by 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;  
340                          }                          }
341    
342                          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};  
343    
344                                  push @msgs, $msg;                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
345    
346                                  $last_row = $row;                          my $what = $2;
                         }  
347    
348                          foreach my $res (@msgs) {                          foreach my $res (get_from_log(
349                                  print "last: $res\n";                                          limit => 20,
350                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                          search => $what,
351                                    )) {
352                                    print "search [$what]: $res\n";
353                                    from_to($res, $ENCODING, 'UTF-8');
354                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
355                          }                          }
356    
357                          $res = '';                          $res = '';
358    
359                  }                  }
360    
361                  if ($res) {                  if ($res) {
362                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
363                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
364                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
365                  }                  }
366    
367          },          },
368            irc_477 => sub {
369                    print "# irc_477: ",$_[ARG1], "\n";
370                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
371            },
372          irc_505 => sub {          irc_505 => sub {
373          print "# irc_505: ",$_[ARG1], "\n";                  print "# irc_505: ",$_[ARG1], "\n";
374                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
375                  warn "## register $NICK\n";  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
376    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
377          },          },
378          irc_registered => sub {          irc_registered => sub {
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
379                  warn "## indetify $NICK\n";                  warn "## indetify $NICK\n";
380                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
381            },
382    #       irc_433 => sub {
383    #               print "# irc_433: ",$_[ARG1], "\n";
384    #               warn "## indetify $NICK\n";
385    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
386    #       },
387            irc_372 => sub {
388                    print "MOTD: ", $_[ARG1], "\n";
389            },
390            irc_snotice => sub {
391                    print "(server notice): ", $_[ARG0], "\n";
392          },          },
393      (map      (map
394       {       {
395         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
396       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  
397                  )),                  )),
398    #       join
399    #       ctcp_version
400    #       connected snotice ctcp_action ping notice mode part quit
401    #       001 002 003 004 005
402    #       250 251 252 253 254 265 266
403    #       332 333 353 366 372 375 376
404    #       477
405      _child => sub {},      _child => sub {},
406      _default => sub {      _default => sub {
407        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 473  POE::Session->create
473     },     },
474    );    );
475    
476    # http server
477    
478    my $httpd = POE::Component::Server::HTTP->new(
479            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
480            ContentHandler => { '/' => \&root_handler },
481            Headers        => { Server => 'irc-logger' },
482    );
483    
484    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
485    my $escape_re  = join '|' => keys %escape;
486    
487    my $style = <<'_END_OF_STYLE_';
488    p { margin: 0; padding: 0.1em; }
489    .time, .channel { color: #808080; font-size: 60%; }
490    .date { float: right; background: #404040; color: #e0e0e0; font-size: 120%; padding: 0.5em; border-top: 1px dashed #e0e0e0; }
491    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
492    .message { color: #000000; font-size: 100%; }
493    .search { float: right; }
494    .col-0 { background: #ffff66 }
495    .col-1 { background: #a0ffff }
496    .col-2 { background: #99ff99 }
497    .col-3 { background: #ff9999 }
498    .col-4 { background: #ff66ff }
499    _END_OF_STYLE_
500    
501    my $max_color = 4;
502    
503    my %nick_enumerator;
504    
505    sub root_handler {
506            my ($request, $response) = @_;
507            $response->code(RC_OK);
508            $response->content_type("text/html; charset=$ENCODING");
509    
510            my $q;
511    
512            if ( $request->method eq 'POST' ) {
513                    $q = new CGI::Simple( $request->content );
514            } elsif ( $request->uri =~ /\?(.+)$/ ) {
515                    $q = new CGI::Simple( $1 );
516            } else {
517                    $q = new CGI::Simple;
518            }
519    
520            my $search = $q->param('search') || $q->param('grep') || '';
521    
522            $response->content(
523                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
524                    <form method="post" class="search">
525                    <input type="text" name="search" value="$search" size="10">
526                    <input type="submit" value="search">
527                    </form>
528                    <p>
529                    } .
530                    join("</p><p>",
531                            get_from_log(
532                                    limit => $q->param('last') || 100,
533                                    search => $q->param('search') || $q->param('grep') || undef,
534                                    fmt => {
535                                            date => '<hr size="1"/><div class="date">%s</div> ',
536                                            time => '<span class="time">%s</span> ',
537                                            time_channel => '<span class="channel">%s %s</span> ',
538                                            nick => '%s:&nbsp;',
539                                            me_nick => '***%s&nbsp;',
540                                            message => '<span class="message">%s</span>',
541                                    },
542                                    filter => {
543                                            message => sub {
544                                                    my $m = shift || return;
545                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
546                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
547                                                    return $m;
548                                            },
549                                            nick => sub {
550                                                    my $n = shift || return;
551                                                    if (! $nick_enumerator{$n})  {
552                                                            my $max = scalar keys %nick_enumerator;
553                                                            $nick_enumerator{$n} = $max + 1;
554                                                    }
555                                                    return '<span class="nick col-' .
556                                                            ( $nick_enumerator{$n} % $max_color ) .
557                                                            '">' . $n . '</span>';
558                                            },
559                                    },
560                            )
561                    ) .
562                    qq{</p></body></html>}
563            );
564            return RC_OK;
565    }
566    
567  POE::Kernel->run;  POE::Kernel->run;

Legend:
Removed from v.8  
changed lines
  Added in v.26

  ViewVC Help
Powered by ViewVC 1.1.26