/[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 14 by dpavlin, Sun Mar 12 14:36:12 2006 UTC revision 34 by dpavlin, Sat Jun 24 22:57:26 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 $HOSTNAME = `hostname`;
22    
23  my $NICK = 'irc-logger';  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';  my $ENCODING = 'ISO-8859-2';
43    my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
44    
45  ## END CONFIG  ## END CONFIG
46    
# Line 44  my $ENCODING = 'ISO-8859-2'; Line 49  my $ENCODING = 'ISO-8859-2';
49  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
50  use HTTP::Status;  use HTTP::Status;
51  use DBI;  use DBI;
52  use Encode qw/from_to/;  use Encode qw/from_to is_utf8/;
53    use Regexp::Common qw /URI/;
54    use CGI::Simple;
55    use HTML::TagCloud;
56    use POSIX qw/strftime/;
57    
58  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
59    
60  =for SQL schema  eval {
61            $dbh->do(qq{ select count(*) from log });
62    };
63    
64    if ($@) {
65            warn "creating database table in $DSN\n";
66            $dbh->do(<<'_SQL_SCHEMA_');
67    
 $dbh->do(qq{  
68  create table log (  create table log (
69          id serial,          id serial,
70          time timestamp default now(),          time timestamp default now(),
71          channel text not null,          channel text not null,
72            me boolean default false,
73          nick text not null,          nick text not null,
74          message text not null,          message text not null,
75          primary key(id)          primary key(id)
# Line 65  create index log_time on log(time); Line 79  create index log_time on log(time);
79  create index log_channel on log(channel);  create index log_channel on log(channel);
80  create index log_nick on log(nick);  create index log_nick on log(nick);
81    
82  });  _SQL_SCHEMA_
83    }
 =cut  
84    
85  my $sth = $dbh->prepare(qq{  my $sth = $dbh->prepare(qq{
86  insert into log  insert into log
87          (channel, nick, message)          (channel, me, nick, message)
88  values (?,?,?)  values (?,?,?,?)
89  });  });
90    
91    my $tags;
92    my $tag_regex = '\b([\w-_]+)//';
93    
94  =head2 get_from_log  =head2 get_from_log
95    
96   my @messages = get_from_log(   my @messages = get_from_log(
# Line 84  values (?,?,?) Line 100  values (?,?,?)
100                  time => '{%s} ',                  time => '{%s} ',
101                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
102                  nick => '%s: ',                  nick => '%s: ',
103                    me_nick => '***%s ',
104                  message => '%s',                  message => '%s',
105          },          },
106            filter => {
107                    message => sub {
108                            # modify message content
109                            return shift;
110                    }
111            },
112            context => 5,
113   );   );
114    
115    Order is important. Fields are first passed through C<filter> (if available) and
116    then throgh C<< sprintf($fmt->{message}, $message >> if available.
117    
118    C<context> defines number of messages around each search hit for display.
119    
120  =cut  =cut
121    
122  sub get_from_log {  sub get_from_log {
# Line 96  sub get_from_log { Line 125  sub get_from_log {
125          $args->{limit} ||= 10;          $args->{limit} ||= 10;
126    
127          $args->{fmt} ||= {          $args->{fmt} ||= {
128                    date => '[%s] ',
129                  time => '{%s} ',                  time => '{%s} ',
130                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
131                  nick => '%s: ',                  nick => '%s: ',
132                    me_nick => '***%s ',
133                  message => '%s',                  message => '%s',
134          };          };
135    
136          my $sql = qq{          my $sql_message = qq{
137                  select                  select
138                          time::date as date,                          time::date as date,
139                          time::time as time,                          time::time as time,
140                          channel,                          channel,
141                            me,
142                          nick,                          nick,
143                          message                          message
144                  from log                  from log
145          };          };
146          $sql .= " where message ilike ? " if ($args->{search});  
147            my $sql_context = qq{
148                    select
149                            id
150                    from log
151            };
152    
153            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
154    
155            my $sql = $context ? $sql_context : $sql_message;
156    
157            $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
158            $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });
159          $sql .= " order by log.time desc";          $sql .= " order by log.time desc";
160          $sql .= " limit " . $args->{limit};          $sql .= " limit " . $args->{limit};
161    
162          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
163          if ($args->{search}) {          if (my $search = $args->{search}) {
164                  $sth->execute( $args->{search} );                  $search =~ s/^\s+//;
165                    $search =~ s/\s+$//;
166                    $sth->execute( ( '%' . $search . '%' ) x 2 );
167                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
168            } elsif (my $tag = $args->{tag}) {
169                    $sth->execute();
170                    warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n";
171          } else {          } else {
172                  $sth->execute();                  $sth->execute();
173          }          }
# Line 134  sub get_from_log { Line 184  sub get_from_log {
184                  unshift @rows, $row;                  unshift @rows, $row;
185          }          }
186    
187          my @msgs;          my @msgs = (
188                    "Showing " . ($#rows + 1) . " messages..."
189            );
190    
191            if ($context) {
192                    my @ids = @rows;
193                    @rows = ();
194    
195                    my $last_to = 0;
196    
197                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
198                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
199                            my $id = $row_id->{id} || die "can't find id in row";
200            
201                            my ($from, $to) = ($id - $context, $id + $context);
202                            $from = $last_to if ($from < $last_to);
203                            $last_to = $to;
204                            $sth->execute( $from, $to );
205    
206                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
207    
208                            while (my $row = $sth->fetchrow_hashref) {
209                                    push @rows, $row;
210                            }
211    
212                    }
213            }
214    
215          foreach my $row (@rows) {          foreach my $row (@rows) {
216    
217                  $row->{time} =~ s#\.\d+##;                  $row->{time} =~ s#\.\d+##;
218    
                 my $t;  
                 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});  
                 $t .= $row->{time};  
   
219                  my $msg = '';                  my $msg = '';
220    
221                    $msg = sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
222                    my $t = $row->{time};
223    
224                  if ($last_row->{channel} ne $row->{channel}) {                  if ($last_row->{channel} ne $row->{channel}) {
225                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
226                  } else {                  } else {
# Line 154  sub get_from_log { Line 229  sub get_from_log {
229    
230                  my $append = 1;                  my $append = 1;
231    
232                  if ($last_row->{nick} ne $row->{nick}) {                  my $nick = $row->{nick};
233                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                  if ($nick =~ s/^_*(.*?)_*$/$1/) {
234                            $row->{nick} = $nick;
235                    }
236    
237                    if ($last_row->{nick} ne $nick) {
238                            # obfu way to find format for me_nick if needed or fallback to default
239                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
240                            $fmt ||= '%s';
241    
242                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
243    
244                            $msg .= sprintf( $fmt, $nick );
245                          $append = 0;                          $append = 0;
246                  }                  }
247    
248                  $msg .= sprintf($args->{fmt}->{message}, $row->{message});                  $args->{fmt}->{message} ||= '%s';
249                    if (ref($args->{filter}->{message}) eq 'CODE') {
250                            $msg .= sprintf($args->{fmt}->{message},
251                                    $args->{filter}->{message}->(
252                                            $row->{message}
253                                    )
254                            );
255                    } else {
256                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
257                    }
258    
259                  if ($append && @msgs) {                  if ($append && @msgs) {
260                          $msgs[$#msgs] .= " " . $msg;                          $msgs[$#msgs] .= " " . $msg;
# Line 179  my $SEND_QUEUE;                 # cache Line 274  my $SEND_QUEUE;                 # cache
274    
275  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
276    
277  POE::Session->create  POE::Session->create( inline_states =>
   (inline_states =>  
278     {_start => sub {           {_start => sub {      
279                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
280                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
# Line 201  POE::Session->create Line 295  POE::Session->create
295                  from_to($msg, 'UTF-8', $ENCODING);                  from_to($msg, 'UTF-8', $ENCODING);
296    
297                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
298                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
299                    add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
300                            message => $msg);
301        },
302        irc_ctcp_action => sub {
303                    my $kernel = $_[KERNEL];
304                    my $nick = (split /!/, $_[ARG0])[0];
305                    my $channel = $_[ARG1]->[0];
306                    my $msg = $_[ARG2];
307    
308                    from_to($msg, 'UTF-8', $ENCODING);
309    
310                    print "$channel ***$nick $msg\n";
311                    $sth->execute($channel, 1, $nick, $msg);
312                    add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
313                            message => $msg);
314      },      },
315          irc_msg => sub {          irc_msg => sub {
316                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 248  POE::Session->create Line 357  POE::Session->create
357    
358                          $res = '';                          $res = '';
359    
360                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
361    
362                          my $what = $2;                          my $what = $2;
363    
364                          foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {                          foreach my $res (get_from_log(
365                                            limit => 20,
366                                            search => $what,
367                                    )) {
368                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
369                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
370                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 288  POE::Session->create Line 400  POE::Session->create
400  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
401  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
402  #       },  #       },
         irc_372 => sub {  
                 print "MOTD: ", $_[ARG1], "\n";  
         },  
         irc_snotice => sub {  
                 print "(server notice): ", $_[ARG0], "\n";  
         },  
     (map  
      {  
        ;"irc_$_" => sub { }}  
      qw(  
                 )),  
 #       join  
 #       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  
403      _child => sub {},      _child => sub {},
404      _default => sub {      _default => sub {
405        printf "%s: session %s caught an unhandled %s event.\n",                  printf "%s #%s %s %s\n",
406          scalar localtime(), $_[SESSION]->ID, $_[ARG0];                          strftime($TIMESTAMP,localtime()), $_[SESSION]->ID, $_[ARG0],
407        print "The $_[ARG0] event was given these parameters: ",                          ref($_[ARG1]) eq "ARRAY"        ?       join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] })     :
408          join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";                          $_[ARG1]                                        ?       $_[ARG1]                                        :
409                            "";
410        0;                        # false for signals        0;                        # false for signals
411      },      },
412      my_add => sub {      my_add => sub {
# Line 377  POE::Session->create Line 472  POE::Session->create
472     },     },
473    );    );
474    
475    # tags support
476    
477    my $cloud = HTML::TagCloud->new;
478    
479    =head2 add_tag
480    
481     add_tag( id => 42, message => 'irc message' );
482    
483    =cut
484    
485    sub add_tag {
486            my $arg = {@_};
487    
488            return unless ($arg->{id} && $arg->{message});
489    
490            my $m = $arg->{message};
491            from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
492    
493            while ($m =~ s#$tag_regex##s) {
494                    my $tag = $1;
495                    next if (! $tag || $tag =~ m/https?:/i);
496                    push @{ $tags->{$tag} }, $arg->{id};
497                    #warn "+tag $tag: $arg->{id}\n";
498                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
499            }
500    }
501    
502    =head2 seed_tags
503    
504    Read all tags from database and create in-memory cache for tags
505    
506    =cut
507    
508    sub seed_tags {
509            my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
510            $sth->execute;
511            while (my $row = $sth->fetchrow_hashref) {
512                    add_tag( %$row );
513            }
514    
515            foreach my $tag (keys %$tags) {
516                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
517            }
518    }
519    
520    seed_tags;
521    
522  # http server  # http server
523    
524  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
# Line 385  my $httpd = POE::Component::Server::HTTP Line 527  my $httpd = POE::Component::Server::HTTP
527          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
528  );  );
529    
530    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
531    my $escape_re  = join '|' => keys %escape;
532    
533  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
534    p { margin: 0; padding: 0.1em; }
535  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
536  .nick { color: #0000ff; font-size: 80%; }  .date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; }
537    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
538  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
539    .search { float: right; }
540    .col-0 { background: #ffff66 }
541    .col-1 { background: #a0ffff }
542    .col-2 { background: #99ff99 }
543    .col-3 { background: #ff9999 }
544    .col-4 { background: #ff66ff }
545    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
546    a:hover.tag { border: 1px solid #eee }
547  _END_OF_STYLE_  _END_OF_STYLE_
548    
549    my $max_color = 4;
550    
551    my %nick_enumerator;
552    
553  sub root_handler {  sub root_handler {
554          my ($request, $response) = @_;          my ($request, $response) = @_;
555          $response->code(RC_OK);          $response->code(RC_OK);
556          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=$ENCODING");
557    
558            my $q;
559    
560            if ( $request->method eq 'POST' ) {
561                    $q = new CGI::Simple( $request->content );
562            } elsif ( $request->uri =~ /\?(.+)$/ ) {
563                    $q = new CGI::Simple( $1 );
564            } else {
565                    $q = new CGI::Simple;
566            }
567    
568            my $search = $q->param('search') || $q->param('grep') || '';
569    
570          $response->content(          $response->content(
571                  qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .
572                  "irc-logger url: " . $request->uri . '<br/>' .                  $cloud->css .
573                  join("<br/>",                  qq{</style></head><body>} .
574                    qq{
575                    <form method="post" class="search" action="/">
576                    <input type="text" name="search" value="$search" size="10">
577                    <input type="submit" value="search">
578                    </form>
579                    } .
580                    $cloud->html(500) .
581                    qq{<p>} .
582                    join("</p><p>",
583                          get_from_log(                          get_from_log(
584                                  limit => 100,                                  limit => $q->param('last') || 100,
585                                    search => $search || undef,
586                                    tag => $q->param('tag') || undef,
587                                  fmt => {                                  fmt => {
588                                            date => '<hr size="1" style="clear: both;"/><div class="date">%s</div> ',
589                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
590                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
591                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
592                                            me_nick => '***%s&nbsp;',
593                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
594                                  },                                  },
595                                    filter => {
596                                            message => sub {
597                                                    my $m = shift || return;
598                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
599                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
600                                                    $m =~ s#$tag_regex#<a href="?tag=$1" class="tag">$1</a>#g;
601                                                    return $m;
602                                            },
603                                            nick => sub {
604                                                    my $n = shift || return;
605                                                    if (! $nick_enumerator{$n})  {
606                                                            my $max = scalar keys %nick_enumerator;
607                                                            $nick_enumerator{$n} = $max + 1;
608                                                    }
609                                                    return '<span class="nick col-' .
610                                                            ( $nick_enumerator{$n} % $max_color ) .
611                                                            '">' . $n . '</span>';
612                                            },
613                                    },
614                          )                          )
615                  ) .                  ) .
616                  qq{</body></html>}                  qq{</p></body></html>}
617          );          );
618          return RC_OK;          return RC_OK;
619  }  }
Legend:
Removed from v.14  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.26