/[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 18 by dpavlin, Mon Mar 13 17:07:40 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';  my $ENCODING = 'ISO-8859-2';
43    
# Line 44  my $ENCODING = 'ISO-8859-2'; Line 48  my $ENCODING = 'ISO-8859-2';
48  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
49  use HTTP::Status;  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/;  use Regexp::Common qw /URI/;
53  use CGI::Simple;  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 67  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  =head2 get_from_log
93    
94   my @messages = get_from_log(   my @messages = get_from_log(
# Line 86  values (?,?,?) Line 98  values (?,?,?)
98                  time => '{%s} ',                  time => '{%s} ',
99                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
100                  nick => '%s: ',                  nick => '%s: ',
101                    me_nick => '***%s ',
102                  message => '%s',                  message => '%s',
103          },          },
104          message_filter => sub {          filter => {
105                  # modify message content                  message => sub {
106                  return shift;                          # 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  =cut
119    
120  sub get_from_log {  sub get_from_log {
# Line 102  sub get_from_log { Line 123  sub get_from_log {
123          $args->{limit} ||= 10;          $args->{limit} ||= 10;
124    
125          $args->{fmt} ||= {          $args->{fmt} ||= {
126                    date => '[%s] ',
127                  time => '{%s} ',                  time => '{%s} ',
128                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
129                  nick => '%s: ',                  nick => '%s: ',
130                    me_nick => '***%s ',
131                  message => '%s',                  message => '%s',
132          };          };
133    
134          my $sql = qq{          my $sql_message = qq{
135                  select                  select
136                          time::date as date,                          time::date as date,
137                          time::time as time,                          time::time as time,
138                          channel,                          channel,
139                            me,
140                          nick,                          nick,
141                          message                          message
142                  from log                  from log
143          };          };
144          $sql .= " where message ilike ? " if ($args->{search});  
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";          $sql .= " order by log.time desc";
158          $sql .= " limit " . $args->{limit};          $sql .= " limit " . $args->{limit};
159    
160          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
161          if ($args->{search}) {          if (my $search = $args->{search}) {
162                  $sth->execute( '%' . $args->{search} . '%' );                  $search =~ s/^\s+//;
163                  warn "search for '$args->{search}' returned ", $sth->rows, " results\n";                  $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 {          } else {
170                  $sth->execute();                  $sth->execute();
171          }          }
# Line 145  sub get_from_log { Line 186  sub get_from_log {
186                  "Showing " . ($#rows + 1) . " messages..."                  "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) {          foreach my $row (@rows) {
214    
215                  $row->{time} =~ s#\.\d+##;                  $row->{time} =~ s#\.\d+##;
216    
                 my $t;  
                 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});  
                 $t .= $row->{time};  
   
217                  my $msg = '';                  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}) {                  if ($last_row->{channel} ne $row->{channel}) {
223                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
224                  } else {                  } else {
# Line 163  sub get_from_log { Line 227  sub get_from_log {
227    
228                  my $append = 1;                  my $append = 1;
229    
230                  if ($last_row->{nick} ne $row->{nick}) {                  my $nick = $row->{nick};
231                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                  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;                          $append = 0;
244                  }                  }
245    
246                  if (ref($args->{message_filter}) eq 'CODE') {                  $args->{fmt}->{message} ||= '%s';
247                    if (ref($args->{filter}->{message}) eq 'CODE') {
248                          $msg .= sprintf($args->{fmt}->{message},                          $msg .= sprintf($args->{fmt}->{message},
249                                  $args->{message_filter}->(                                  $args->{filter}->{message}->(
250                                          $row->{message}                                          $row->{message}
251                                  )                                  )
252                          );                          );
# Line 218  POE::Session->create Line 294  POE::Session->create
294                  from_to($msg, 'UTF-8', $ENCODING);                  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];
# Line 265  POE::Session->create Line 356  POE::Session->create
356    
357                          $res = '';                          $res = '';
358    
359                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
360    
361                          my $what = $2;                          my $what = $2;
362    
363                          foreach my $res (get_from_log( limit => 20, search => $what )) {                          foreach my $res (get_from_log(
364                                            limit => 20,
365                                            search => $what,
366                                    )) {
367                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
368                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
369                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 394  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  # http server
539    
540  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
# Line 408  my $escape_re  = join '|' => keys %escap Line 549  my $escape_re  = join '|' => keys %escap
549  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
550  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
551  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
552  .nick { color: #0000ff; font-size: 80%; }  .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%; }  .message { color: #000000; font-size: 100%; }
555  .search { float: right; }  .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_  _END_OF_STYLE_
564    
565    my $max_color = 4;
566    
567    my %nick_enumerator;
568    
569  sub root_handler {  sub root_handler {
570          my ($request, $response) = @_;          my ($request, $response) = @_;
571          $response->code(RC_OK);          $response->code(RC_OK);
# Line 431  sub root_handler { Line 584  sub root_handler {
584          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
585    
586          $response->content(          $response->content(
587                  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} .
588                  <form method="post" class="search">                  $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">                  <input type="text" name="search" value="$search" size="10">
593                  <input type="submit" value="search">                  <input type="submit" value="search">
594                  </form>                  </form>
                 <p>  
595                  } .                  } .
596                    $cloud->html(500) .
597                    qq{<p>} .
598                  join("</p><p>",                  join("</p><p>",
599                          get_from_log(                          get_from_log(
600                                  limit => $q->param('limit') || 100,                                  limit => $q->param('last') || 100,
601                                  search => $q->param('search') || $q->param('grep') || undef,                                  search => $search || undef,
602                                    tag => $q->param('tag') || undef,
603                                  fmt => {                                  fmt => {
604                                            date => '<hr size="1" style="clear: both;"/><div class="date">%s</div> ',
605                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
606                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
607                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
608                                            me_nick => '***%s&nbsp;',
609                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
610                                  },                                  },
611                                  message_filter => sub {                                  filter => {
612                                          my $m = shift || return;                                          message => sub {
613                                          $m =~ s/($escape_re)/$escape{$1}/gs;                                                  my $m = shift || return;
614                                          $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;                                                  $m =~ s/($escape_re)/$escape{$1}/gs;
615                                          return $m;                                                  $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                  ) .                  ) .
Legend:
Removed from v.18  
changed lines
  Added in v.33
  ViewVC Help
Powered by ViewVC 1.1.26