/[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 11 by dpavlin, Thu Mar 2 00:52:22 2006 UTC revision 20 by dpavlin, Tue Mar 14 17:17:53 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/;
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   );   );
104    
105    Order is important. Fields are first passed through C<filter> (if available) and
106    then throgh C<< sprintf($fmt->{message}, $message >> if available.
107    
108  =cut  =cut
109    
110  sub get_from_log {  sub get_from_log {
# Line 86  sub get_from_log { Line 112  sub get_from_log {
112    
113          $args->{limit} ||= 10;          $args->{limit} ||= 10;
114    
115            $args->{fmt} ||= {
116                    time => '{%s} ',
117                    time_channel => '{%s %s} ',
118                    nick => '%s: ',
119                    me_nick => '***%s ',
120                    message => '%s',
121            };
122    
123          my $sql = qq{          my $sql = qq{
124                  select                  select
125                          time::date as date,                          time::date as date,
126                          time::time as time,                          time::time as time,
127                          channel,                          channel,
128                            me,
129                          nick,                          nick,
130                          message                          message
131                  from log                  from log
# Line 101  sub get_from_log { Line 136  sub get_from_log {
136    
137          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
138          if ($args->{search}) {          if ($args->{search}) {
139                  $sth->execute( $args->{search} );                  $sth->execute( '%' . $args->{search} . '%' );
140                    warn "search for '$args->{search}' returned ", $sth->rows, " results\n";
141          } else {          } else {
142                  $sth->execute();                  $sth->execute();
143          }          }
# Line 118  sub get_from_log { Line 154  sub get_from_log {
154                  unshift @rows, $row;                  unshift @rows, $row;
155          }          }
156    
157          my @msgs;          my @msgs = (
158                    "Showing " . ($#rows + 1) . " messages..."
159            );
160    
161          foreach my $row (@rows) {          foreach my $row (@rows) {
162    
# Line 130  sub get_from_log { Line 168  sub get_from_log {
168    
169                  my $msg = '';                  my $msg = '';
170    
171                  $msg .= "($t";                  if ($last_row->{channel} ne $row->{channel}) {
172                  $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
173                  $msg .= ") ";                  } else {
174                            $msg .= sprintf($args->{fmt}->{time}, $t);
175                    }
176    
177                  $msg .= $row->{nick} . ': '  if ($last_row->{nick} ne $row->{nick});                  my $append = 1;
178    
179                  $msg .= $row->{message};                  if ($last_row->{nick} ne $row->{nick}) {
180                            # obfu way to find format for me_nick if needed or fallback to default
181                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
182                            $fmt ||= '%s';
183    
184                  push @msgs, $msg;                          my $nick = $row->{nick};
185                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
186    
187                            $msg .= sprintf( $fmt, $nick );
188                            $append = 0;
189                    }
190    
191                    $args->{fmt}->{message} ||= '%s';
192                    if (ref($args->{filter}->{message}) eq 'CODE') {
193                            $msg .= sprintf($args->{fmt}->{message},
194                                    $args->{filter}->{message}->(
195                                            $row->{message}
196                                    )
197                            );
198                    } else {
199                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
200                    }
201    
202                    if ($append && @msgs) {
203                            $msgs[$#msgs] .= " " . $msg;
204                    } else {
205                            push @msgs, $msg;
206                    }
207    
208                  $last_row = $row;                  $last_row = $row;
209          }          }
# Line 171  POE::Session->create Line 236  POE::Session->create
236                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
237                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
238    
239                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
240    
241                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
242                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
243        },
244        irc_ctcp_action => sub {
245                    my $kernel = $_[KERNEL];
246                    my $nick = (split /!/, $_[ARG0])[0];
247                    my $channel = $_[ARG1]->[0];
248                    my $msg = $_[ARG2];
249    
250                    from_to($msg, 'UTF-8', $ENCODING);
251    
252                    print "$channel ***$nick $msg\n";
253                    $sth->execute($channel, 1, $nick, $msg);
254      },      },
255          irc_msg => sub {          irc_msg => sub {
256                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
257                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
258                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
259                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
260    
261                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
262                  my @out;                  my @out;
# Line 215  POE::Session->create Line 291  POE::Session->create
291    
292                          foreach my $res (get_from_log( limit => $1 )) {                          foreach my $res (get_from_log( limit => $1 )) {
293                                  print "last: $res\n";                                  print "last: $res\n";
294                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
295                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
296                          }                          }
297    
# Line 225  POE::Session->create Line 301  POE::Session->create
301    
302                          my $what = $2;                          my $what = $2;
303    
304                          foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {                          foreach my $res (get_from_log( limit => 20, search => $what )) {
305                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
306                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
307                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
308                          }                          }
309    
# Line 237  POE::Session->create Line 313  POE::Session->create
313    
314                  if ($res) {                  if ($res) {
315                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
316                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
317                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
318                  }                  }
319    
# Line 350  POE::Session->create Line 426  POE::Session->create
426     },     },
427    );    );
428    
429    # http server
430    
431    my $httpd = POE::Component::Server::HTTP->new(
432            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
433            ContentHandler => { '/' => \&root_handler },
434            Headers        => { Server => 'irc-logger' },
435    );
436    
437    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
438    my $escape_re  = join '|' => keys %escape;
439    
440    my $style = <<'_END_OF_STYLE_';
441    p { margin: 0; padding: 0.1em; }
442    .time, .channel { color: #808080; font-size: 60%; }
443    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
444    .message { color: #000000; font-size: 100%; }
445    .search { float: right; }
446    .col-0 { background: #ffff66 }
447    .col-1 { background: #a0ffff }
448    .col-2 { background: #99ff99 }
449    .col-3 { background: #ff9999 }
450    .col-4 { background: #ff66ff }
451    _END_OF_STYLE_
452    
453    my $max_color = 4;
454    
455    my %nick_enumerator;
456    
457    sub root_handler {
458            my ($request, $response) = @_;
459            $response->code(RC_OK);
460            $response->content_type("text/html; charset=$ENCODING");
461    
462            my $q;
463    
464            if ( $request->method eq 'POST' ) {
465                    $q = new CGI::Simple( $request->content );
466            } elsif ( $request->uri =~ /\?(.+)$/ ) {
467                    $q = new CGI::Simple( $1 );
468            } else {
469                    $q = new CGI::Simple;
470            }
471    
472            my $search = $q->param('search') || $q->param('grep') || '';
473    
474            $response->content(
475                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
476                    <form method="post" class="search">
477                    <input type="text" name="search" value="$search" size="10">
478                    <input type="submit" value="search">
479                    </form>
480                    <p>
481                    } .
482                    join("</p><p>",
483                            get_from_log(
484                                    limit => $q->param('limit') || 100,
485                                    search => $q->param('search') || $q->param('grep') || undef,
486                                    fmt => {
487                                            time => '<span class="time">%s</span> ',
488                                            time_channel => '<span class="channel">%s %s</span> ',
489                                            nick => '%s:&nbsp;',
490                                            me_nick => '***%s&nbsp;',
491                                            message => '<span class="message">%s</span>',
492                                    },
493                                    filter => {
494                                            message => sub {
495                                                    my $m = shift || return;
496                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
497                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
498                                                    return $m;
499                                            },
500                                            nick => sub {
501                                                    my $n = shift || return;
502                                                    if (! $nick_enumerator{$n})  {
503                                                            my $max = scalar keys %nick_enumerator;
504                                                            $nick_enumerator{$n} = $max + 1;
505                                                    }
506                                                    return '<span class="nick col-' .
507                                                            ( $nick_enumerator{$n} % $max_color ) .
508                                                            '">' . $n . '</span>';
509                                            },
510                                    },
511                            )
512                    ) .
513                    qq{</p></body></html>}
514            );
515            return RC_OK;
516    }
517    
518  POE::Kernel->run;  POE::Kernel->run;
Legend:
Removed from v.11  
changed lines
  Added in v.20
  ViewVC Help
Powered by ViewVC 1.1.26