/[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 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';  my $ENCODING = 'ISO-8859-2';
39    
# Line 45  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 65  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 84  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   );   );
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 99  sub get_from_log { Line 116  sub get_from_log {
116                  time => '{%s} ',                  time => '{%s} ',
117                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
118                  nick => '%s: ',                  nick => '%s: ',
119                    me_nick => '***%s ',
120                  message => '%s',                  message => '%s',
121          };          };
122    
# Line 107  sub get_from_log { Line 125  sub get_from_log {
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 117  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 134  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 155  sub get_from_log { Line 177  sub get_from_log {
177                  my $append = 1;                  my $append = 1;
178    
179                  if ($last_row->{nick} ne $row->{nick}) {                  if ($last_row->{nick} ne $row->{nick}) {
180                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                          # 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                            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;                          $append = 0;
189                  }                  }
190    
191                  $msg .= sprintf($args->{fmt}->{message}, $row->{message});                  $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) {                  if ($append && @msgs) {
203                          $msgs[$#msgs] .= " " . $msg;                          $msgs[$#msgs] .= " " . $msg;
# Line 201  POE::Session->create Line 239  POE::Session->create
239                  from_to($msg, 'UTF-8', $ENCODING);                  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];
# Line 252  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, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
307                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 385  my $httpd = POE::Component::Server::HTTP Line 434  my $httpd = POE::Component::Server::HTTP
434          Headers        => { Server => 'irc-logger' },          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_';  my $style = <<'_END_OF_STYLE_';
441    p { margin: 0; padding: 0.1em; }
442  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
443  .nick { color: #0000ff; font-size: 80%; }  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
444  .message { color: #000000; font-size: 100%; }  .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_  _END_OF_STYLE_
452    
453    my $max_color = 4;
454    
455    my %nick_enumerator;
456    
457  sub root_handler {  sub root_handler {
458          my ($request, $response) = @_;          my ($request, $response) = @_;
459          $response->code(RC_OK);          $response->code(RC_OK);
460          $response->content_type("text/html; charset=$ENCODING");          $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(          $response->content(
475                  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>
476                  "irc-logger url: " . $request->uri . '<br/>' .                  <form method="post" class="search">
477                  join("<br/>",                  <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(                          get_from_log(
484                                  limit => 100,                                  limit => $q->param('limit') || 100,
485                                    search => $q->param('search') || $q->param('grep') || undef,
486                                  fmt => {                                  fmt => {
487                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
488                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
489                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
490                                            me_nick => '***%s&nbsp;',
491                                          message => '<span class="message">%s</span>',                                          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{</body></html>}                  qq{</p></body></html>}
514          );          );
515          return RC_OK;          return RC_OK;
516  }  }

Legend:
Removed from v.14  
changed lines
  Added in v.20

  ViewVC Help
Powered by ViewVC 1.1.26