/[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 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 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 86  values (?,?,?) Line 93  values (?,?,?)
93                  nick => '%s: ',                  nick => '%s: ',
94                  message => '%s',                  message => '%s',
95          },          },
96            message_filter => sub {
97                    # modify message content
98                    return shift;
99            }
100   );   );
101    
102  =cut  =cut
# Line 117  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 134  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 159  sub get_from_log { Line 173  sub get_from_log {
173                          $append = 0;                          $append = 0;
174                  }                  }
175    
176                  $msg .= sprintf($args->{fmt}->{message}, $row->{message});                  if (ref($args->{message_filter}) eq 'CODE') {
177                            $msg .= sprintf($args->{fmt}->{message},
178                                    $args->{message_filter}->(
179                                            $row->{message}
180                                    )
181                            );
182                    } else {
183                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
184                    }
185    
186                  if ($append && @msgs) {                  if ($append && @msgs) {
187                          $msgs[$#msgs] .= " " . $msg;                          $msgs[$#msgs] .= " " . $msg;
# Line 201  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 252  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 385  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> ',
464                                          nick => '<span class="nick">%s:</span> ',                                          nick => '<span class="nick">%s:</span> ',
465                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
466                                  },                                  },
467                                    message_filter => sub {
468                                            my $m = shift || return;
469                                            $m =~ s/($escape_re)/$escape{$1}/gs;
470                                            $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
471                                            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.14  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26