/[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 13 by dpavlin, Sun Mar 12 14:19:00 2006 UTC revision 23 by dpavlin, Sun Mar 26 01:01:10 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    
# Line 43  use POE qw(Component::IRC Wheel::FollowT Line 45  use POE qw(Component::IRC Wheel::FollowT
45  use HTTP::Status;  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 63  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 82  values (?,?,?) Line 91  values (?,?,?)
91                  time => '{%s} ',                  time => '{%s} ',
92                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
93                  nick => '%s: ',                  nick => '%s: ',
94                    me_nick => '***%s ',
95                  message => '%s',                  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 97  sub get_from_log { Line 119  sub get_from_log {
119                  time => '{%s} ',                  time => '{%s} ',
120                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
121                  nick => '%s: ',                  nick => '%s: ',
122                    me_nick => '***%s ',
123                  message => '%s',                  message => '%s',
124          };          };
125    
126          my $sql = qq{          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    
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 ? " if ($args->{search});          $sql .= " where message 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 . '%' );
156                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
157          } else {          } else {
158                  $sth->execute();                  $sth->execute();
159          }          }
# Line 132  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 152  sub get_from_log { Line 216  sub get_from_log {
216    
217                  my $append = 1;                  my $append = 1;
218    
219                  if ($last_row->{nick} ne $row->{nick}) {                  my $nick = $row->{nick};
220                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                  $nick =~ s/^_*(.*?)_*$/$1/;
221            
222                    if ($last_row->{nick} ne $nick) {
223                            # obfu way to find format for me_nick if needed or fallback to default
224                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
225                            $fmt ||= '%s';
226    
227                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
228    
229                            $msg .= sprintf( $fmt, $nick );
230                          $append = 0;                          $append = 0;
231                  }                  }
232    
233                  $msg .= sprintf($args->{fmt}->{message}, $row->{message});                  $args->{fmt}->{message} ||= '%s';
234                    if (ref($args->{filter}->{message}) eq 'CODE') {
235                            $msg .= sprintf($args->{fmt}->{message},
236                                    $args->{filter}->{message}->(
237                                            $row->{message}
238                                    )
239                            );
240                    } else {
241                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
242                    }
243    
244                  if ($append && @msgs) {                  if ($append && @msgs) {
245                          $msgs[$#msgs] .= " " . $msg;                          $msgs[$#msgs] .= " " . $msg;
# Line 196  POE::Session->create Line 278  POE::Session->create
278                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
279                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
280    
281                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
282    
283                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
284                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
285        },
286        irc_ctcp_action => sub {
287                    my $kernel = $_[KERNEL];
288                    my $nick = (split /!/, $_[ARG0])[0];
289                    my $channel = $_[ARG1]->[0];
290                    my $msg = $_[ARG2];
291    
292                    from_to($msg, 'UTF-8', $ENCODING);
293    
294                    print "$channel ***$nick $msg\n";
295                    $sth->execute($channel, 1, $nick, $msg);
296      },      },
297          irc_msg => sub {          irc_msg => sub {
298                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
299                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
300                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
301                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
302    
303                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
304                  my @out;                  my @out;
# Line 240  POE::Session->create Line 333  POE::Session->create
333    
334                          foreach my $res (get_from_log( limit => $1 )) {                          foreach my $res (get_from_log( limit => $1 )) {
335                                  print "last: $res\n";                                  print "last: $res\n";
336                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
337                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
338                          }                          }
339    
340                          $res = '';                          $res = '';
341    
342                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
343    
344                          my $what = $2;                          my $what = $2;
345    
346                          foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {                          foreach my $res (get_from_log(
347                                            limit => 20,
348                                            search => $what,
349                                    )) {
350                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
351                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
352                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
353                          }                          }
354    
# Line 262  POE::Session->create Line 358  POE::Session->create
358    
359                  if ($res) {                  if ($res) {
360                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
361                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
362                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
363                  }                  }
364    
# Line 378  POE::Session->create Line 474  POE::Session->create
474  # http server  # http server
475    
476  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
477          Port => 8000,          Port => $NICK =~ m/-dev/ ? 8001 : 8000,
478          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
479          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
480  );  );
481    
482    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
483    my $escape_re  = join '|' => keys %escape;
484    
485  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
486    p { margin: 0; padding: 0.1em; }
487  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
488  .nick { color: #0000ff; font-size: 80%; }  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
489  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
490    .search { float: right; }
491    .col-0 { background: #ffff66 }
492    .col-1 { background: #a0ffff }
493    .col-2 { background: #99ff99 }
494    .col-3 { background: #ff9999 }
495    .col-4 { background: #ff66ff }
496  _END_OF_STYLE_  _END_OF_STYLE_
497    
498    my $max_color = 4;
499    
500    my %nick_enumerator;
501    
502  sub root_handler {  sub root_handler {
503          my ($request, $response) = @_;          my ($request, $response) = @_;
504          $response->code(RC_OK);          $response->code(RC_OK);
505          $response->content_type('text/html');          $response->content_type("text/html; charset=$ENCODING");
506    
507            my $q;
508    
509            if ( $request->method eq 'POST' ) {
510                    $q = new CGI::Simple( $request->content );
511            } elsif ( $request->uri =~ /\?(.+)$/ ) {
512                    $q = new CGI::Simple( $1 );
513            } else {
514                    $q = new CGI::Simple;
515            }
516    
517            my $search = $q->param('search') || $q->param('grep') || '';
518    
519          $response->content(          $response->content(
520                  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</style></head><body>
521                  "irc-logger url: " . $request->uri . '<br/>' .                  <form method="post" class="search">
522                  join("<br/>",                  <input type="text" name="search" value="$search" size="10">
523                    <input type="submit" value="search">
524                    </form>
525                    <p>
526                    } .
527                    join("</p><p>",
528                          get_from_log(                          get_from_log(
529                                  limit => 100,                                  limit => $q->param('last') || 100,
530                                    search => $q->param('search') || $q->param('grep') || undef,
531                                  fmt => {                                  fmt => {
532                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
533                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
534                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
535                                            me_nick => '***%s&nbsp;',
536                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
537                                  },                                  },
538                                    filter => {
539                                            message => sub {
540                                                    my $m = shift || return;
541                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
542                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
543                                                    return $m;
544                                            },
545                                            nick => sub {
546                                                    my $n = shift || return;
547                                                    if (! $nick_enumerator{$n})  {
548                                                            my $max = scalar keys %nick_enumerator;
549                                                            $nick_enumerator{$n} = $max + 1;
550                                                    }
551                                                    return '<span class="nick col-' .
552                                                            ( $nick_enumerator{$n} % $max_color ) .
553                                                            '">' . $n . '</span>';
554                                            },
555                                    },
556                          )                          )
557                  ) .                  ) .
558                  qq{</body></html>}                  qq{</p></body></html>}
559          );          );
560          return RC_OK;          return RC_OK;
561  }  }

Legend:
Removed from v.13  
changed lines
  Added in v.23

  ViewVC Help
Powered by ViewVC 1.1.26