/[irc-logger]/trunk/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/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 15 by dpavlin, Mon Mar 13 12:56:26 2006 UTC revision 19 by dpavlin, Mon Mar 13 21:02:16 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';  my $NICK = 'irc-logger-dev';
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';  my $ENCODING = 'ISO-8859-2';
39    
# Line 46  use HTTP::Status; Line 46  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/;  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 66  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 122  sub get_from_log { Line 128  sub get_from_log {
128    
129          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
130          if ($args->{search}) {          if ($args->{search}) {
131                  $sth->execute( $args->{search} );                  $sth->execute( '%' . $args->{search} . '%' );
132                    warn "search for '$args->{search}' returned ", $sth->rows, " results\n";
133          } else {          } else {
134                  $sth->execute();                  $sth->execute();
135          }          }
# Line 139  sub get_from_log { Line 146  sub get_from_log {
146                  unshift @rows, $row;                  unshift @rows, $row;
147          }          }
148    
149          my @msgs;          my @msgs = (
150                    "Showing " . ($#rows + 1) . " messages..."
151            );
152    
153          foreach my $row (@rows) {          foreach my $row (@rows) {
154    
# Line 214  POE::Session->create Line 223  POE::Session->create
223                  from_to($msg, 'UTF-8', $ENCODING);                  from_to($msg, 'UTF-8', $ENCODING);
224    
225                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
226                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
227        },
228        irc_ctcp_action => sub {
229                    my $kernel = $_[KERNEL];
230                    my $nick = (split /!/, $_[ARG0])[0];
231                    my $channel = $_[ARG1]->[0];
232                    my $msg = $_[ARG2];
233    
234                    from_to($msg, 'UTF-8', $ENCODING);
235    
236                    print "$channel ***$nick $msg\n";
237                    $sth->execute($channel, 1, $nick, $msg);
238      },      },
239          irc_msg => sub {          irc_msg => sub {
240                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 265  POE::Session->create Line 285  POE::Session->create
285    
286                          my $what = $2;                          my $what = $2;
287    
288                          foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {                          foreach my $res (get_from_log( limit => 20, search => $what )) {
289                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
290                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
291                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 398  my $httpd = POE::Component::Server::HTTP Line 418  my $httpd = POE::Component::Server::HTTP
418          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
419  );  );
420    
421    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
422    my $escape_re  = join '|' => keys %escape;
423    
424  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
425    p { margin: 0; padding: 0.1em; }
426  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
427  .nick { color: #0000ff; font-size: 80%; }  .nick { color: #0000ff; font-size: 80%; }
428  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
429    .search { float: right; }
430  _END_OF_STYLE_  _END_OF_STYLE_
431    
432  sub root_handler {  sub root_handler {
433          my ($request, $response) = @_;          my ($request, $response) = @_;
434          $response->code(RC_OK);          $response->code(RC_OK);
435          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=$ENCODING");
436    
437            my $q;
438    
439            if ( $request->method eq 'POST' ) {
440                    $q = new CGI::Simple( $request->content );
441            } elsif ( $request->uri =~ /\?(.+)$/ ) {
442                    $q = new CGI::Simple( $1 );
443            } else {
444                    $q = new CGI::Simple;
445            }
446    
447            my $search = $q->param('search') || $q->param('grep') || '';
448    
449          $response->content(          $response->content(
450                  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>
451                  "irc-logger url: " . $request->uri . '<br/>' .                  <form method="post" class="search">
452                  join("<br/>",                  <input type="text" name="search" value="$search" size="10">
453                    <input type="submit" value="search">
454                    </form>
455                    <p>
456                    } .
457                    join("</p><p>",
458                          get_from_log(                          get_from_log(
459                                  limit => 100,                                  limit => $q->param('limit') || 100,
460                                    search => $q->param('search') || $q->param('grep') || undef,
461                                  fmt => {                                  fmt => {
462                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
463                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 422  sub root_handler { Line 466  sub root_handler {
466                                  },                                  },
467                                  message_filter => sub {                                  message_filter => sub {
468                                          my $m = shift || return;                                          my $m = shift || return;
469                                            $m =~ s/($escape_re)/$escape{$1}/gs;
470                                          $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;                                          $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
471                                          return $m;                                          return $m;
472                                  },                                  },
473                          )                          )
474                  ) .                  ) .
475                  qq{</body></html>}                  qq{</p></body></html>}
476          );          );
477          return RC_OK;          return RC_OK;
478  }  }
Legend:
Removed from v.15  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26