/[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 12 by dpavlin, Sun Mar 12 13:33:20 2006 UTC revision 25 by dpavlin, Sat May 20 10:12:19 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  =head2 get_from_log
# Line 77  values (?,?,?) Line 87  values (?,?,?)
87   my @messages = get_from_log(   my @messages = get_from_log(
88          limit => 42,          limit => 42,
89          search => '%what to stuff in ilike%',          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  =cut
112    
113  sub get_from_log {  sub get_from_log {
# Line 86  sub get_from_log { Line 115  sub get_from_log {
115    
116          $args->{limit} ||= 10;          $args->{limit} ||= 10;
117    
118          my $sql = qq{          $args->{fmt} ||= {
119                    time => '{%s} ',
120                    time_channel => '{%s %s} ',
121                    nick => '%s: ',
122                    me_nick => '***%s ',
123                    message => '%s',
124            };
125    
126            my $sql_message = qq{
127                  select                  select
128                          time::date as date,                          time::date as date,
129                          time::time as time,                          time::time as time,
130                          channel,                          channel,
131                            me,
132                          nick,                          nick,
133                          message                          message
134                  from log                  from log
135          };          };
136          $sql .= " where message ilike ? " if ($args->{search});  
137            my $sql_context = qq{
138                    select
139                            id
140                    from log
141            };
142    
143            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
144    
145            my $sql = $context ? $sql_context : $sql_message;
146    
147            $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
148          $sql .= " order by log.time desc";          $sql .= " order by log.time desc";
149          $sql .= " limit " . $args->{limit};          $sql .= " limit " . $args->{limit};
150    
151          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
152          if ($args->{search}) {          if (my $search = $args->{search}) {
153                  $sth->execute( $args->{search} );                  $search =~ s/^\s+//;
154                    $search =~ s/\s+$//;
155                    $sth->execute( ( '%' . $search . '%' ) x 2 );
156                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
157          } else {          } else {
158                  $sth->execute();                  $sth->execute();
159          }          }
# Line 118  sub get_from_log { Line 170  sub get_from_log {
170                  unshift @rows, $row;                  unshift @rows, $row;
171          }          }
172    
173          my @msgs;          my @msgs = (
174                    "Showing " . ($#rows + 1) . " messages..."
175            );
176    
177            if ($context) {
178                    my @ids = @rows;
179                    @rows = ();
180    
181                    my $last_to = 0;
182    
183                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
184                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
185                            my $id = $row_id->{id} || die "can't find id in row";
186            
187                            my ($from, $to) = ($id - $context, $id + $context);
188                            $from = $last_to if ($from < $last_to);
189                            $last_to = $to;
190                            $sth->execute( $from, $to );
191    
192                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
193    
194                            while (my $row = $sth->fetchrow_hashref) {
195                                    push @rows, $row;
196                            }
197    
198                    }
199            }
200    
201          foreach my $row (@rows) {          foreach my $row (@rows) {
202    
# Line 130  sub get_from_log { Line 208  sub get_from_log {
208    
209                  my $msg = '';                  my $msg = '';
210    
211                  $msg .= "{$t";                  if ($last_row->{channel} ne $row->{channel}) {
212                  $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
213                  $msg .= "} ";                  } else {
214                            $msg .= sprintf($args->{fmt}->{time}, $t);
215                    }
216    
217                  my $append = 1;                  my $append = 1;
218    
219                  if ($last_row->{nick} ne $row->{nick}) {                  my $nick = $row->{nick};
220                          $msg .= $row->{nick} . ': ';                  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;                          $append = 0;
233                  }                  }
234    
235                  $msg .= $row->{message};                  $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) {                  if ($append && @msgs) {
247                          $msgs[$#msgs] .= " " . $msg;                          $msgs[$#msgs] .= " " . $msg;
# Line 180  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;                  my @out;
# Line 224  POE::Session->create Line 335  POE::Session->create
335    
336                          foreach my $res (get_from_log( limit => $1 )) {                          foreach my $res (get_from_log( limit => $1 )) {
337                                  print "last: $res\n";                                  print "last: $res\n";
338                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
339                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
340                          }                          }
341    
342                          $res = '';                          $res = '';
343    
344                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
345    
346                          my $what = $2;                          my $what = $2;
347    
348                          foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {                          foreach my $res (get_from_log(
349                                            limit => 20,
350                                            search => $what,
351                                    )) {
352                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
353                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
354                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
355                          }                          }
356    
# Line 246  POE::Session->create Line 360  POE::Session->create
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    
# Line 359  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    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
491    .message { color: #000000; font-size: 100%; }
492    .search { float: right; }
493    .col-0 { background: #ffff66 }
494    .col-1 { background: #a0ffff }
495    .col-2 { background: #99ff99 }
496    .col-3 { background: #ff9999 }
497    .col-4 { background: #ff66ff }
498    _END_OF_STYLE_
499    
500    my $max_color = 4;
501    
502    my %nick_enumerator;
503    
504    sub root_handler {
505            my ($request, $response) = @_;
506            $response->code(RC_OK);
507            $response->content_type("text/html; charset=$ENCODING");
508    
509            my $q;
510    
511            if ( $request->method eq 'POST' ) {
512                    $q = new CGI::Simple( $request->content );
513            } elsif ( $request->uri =~ /\?(.+)$/ ) {
514                    $q = new CGI::Simple( $1 );
515            } else {
516                    $q = new CGI::Simple;
517            }
518    
519            my $search = $q->param('search') || $q->param('grep') || '';
520    
521            $response->content(
522                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
523                    <form method="post" class="search">
524                    <input type="text" name="search" value="$search" size="10">
525                    <input type="submit" value="search">
526                    </form>
527                    <p>
528                    } .
529                    join("</p><p>",
530                            get_from_log(
531                                    limit => $q->param('last') || 100,
532                                    search => $q->param('search') || $q->param('grep') || undef,
533                                    fmt => {
534                                            time => '<span class="time">%s</span> ',
535                                            time_channel => '<span class="channel">%s %s</span> ',
536                                            nick => '%s:&nbsp;',
537                                            me_nick => '***%s&nbsp;',
538                                            message => '<span class="message">%s</span>',
539                                    },
540                                    filter => {
541                                            message => sub {
542                                                    my $m = shift || return;
543                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
544                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
545                                                    return $m;
546                                            },
547                                            nick => sub {
548                                                    my $n = shift || return;
549                                                    if (! $nick_enumerator{$n})  {
550                                                            my $max = scalar keys %nick_enumerator;
551                                                            $nick_enumerator{$n} = $max + 1;
552                                                    }
553                                                    return '<span class="nick col-' .
554                                                            ( $nick_enumerator{$n} % $max_color ) .
555                                                            '">' . $n . '</span>';
556                                            },
557                                    },
558                            )
559                    ) .
560                    qq{</p></body></html>}
561            );
562            return RC_OK;
563    }
564    
565  POE::Kernel->run;  POE::Kernel->run;

Legend:
Removed from v.12  
changed lines
  Added in v.25

  ViewVC Help
Powered by ViewVC 1.1.26