/[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 11 by dpavlin, Thu Mar 2 00:52:22 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';
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                    message => '%s',
95            },
96            message_filter => sub {
97                    # modify message content
98                    return shift;
99            }
100   );   );
101    
102  =cut  =cut
# Line 86  sub get_from_log { Line 106  sub get_from_log {
106    
107          $args->{limit} ||= 10;          $args->{limit} ||= 10;
108    
109            $args->{fmt} ||= {
110                    time => '{%s} ',
111                    time_channel => '{%s %s} ',
112                    nick => '%s: ',
113                    message => '%s',
114            };
115    
116          my $sql = qq{          my $sql = qq{
117                  select                  select
118                          time::date as date,                          time::date as date,
# Line 101  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 118  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 130  sub get_from_log { Line 160  sub get_from_log {
160    
161                  my $msg = '';                  my $msg = '';
162    
163                  $msg .= "($t";                  if ($last_row->{channel} ne $row->{channel}) {
164                  $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
165                  $msg .= ") ";                  } else {
166                            $msg .= sprintf($args->{fmt}->{time}, $t);
167                    }
168    
169                    my $append = 1;
170    
171                  $msg .= $row->{nick} . ': '  if ($last_row->{nick} ne $row->{nick});                  if ($last_row->{nick} ne $row->{nick}) {
172                            $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});
173                            $append = 0;
174                    }
175    
176                  $msg .= $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                  push @msgs, $msg;                  if ($append && @msgs) {
187                            $msgs[$#msgs] .= " " . $msg;
188                    } else {
189                            push @msgs, $msg;
190                    }
191    
192                  $last_row = $row;                  $last_row = $row;
193          }          }
# Line 171  POE::Session->create Line 220  POE::Session->create
220                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
221                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
222    
223                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  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];
241                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
242                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
243                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
244    
245                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
246                  my @out;                  my @out;
# Line 215  POE::Session->create Line 275  POE::Session->create
275    
276                          foreach my $res (get_from_log( limit => $1 )) {                          foreach my $res (get_from_log( limit => $1 )) {
277                                  print "last: $res\n";                                  print "last: $res\n";
278                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
279                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
280                          }                          }
281    
# Line 225  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, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
291                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
292                          }                          }
293    
# Line 237  POE::Session->create Line 297  POE::Session->create
297    
298                  if ($res) {                  if ($res) {
299                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
300                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
301                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
302                  }                  }
303    
# Line 350  POE::Session->create Line 410  POE::Session->create
410     },     },
411    );    );
412    
413    # http server
414    
415    my $httpd = POE::Component::Server::HTTP->new(
416            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
417            ContentHandler => { '/' => \&root_handler },
418            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_';
425    p { margin: 0; padding: 0.1em; }
426    .time, .channel { color: #808080; font-size: 60%; }
427    .nick { color: #0000ff; font-size: 80%; }
428    .message { color: #000000; font-size: 100%; }
429    .search { float: right; }
430    _END_OF_STYLE_
431    
432    sub root_handler {
433            my ($request, $response) = @_;
434            $response->code(RC_OK);
435            $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(
450                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
451                    <form method="post" class="search">
452                    <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(
459                                    limit => $q->param('limit') || 100,
460                                    search => $q->param('search') || $q->param('grep') || undef,
461                                    fmt => {
462                                            time => '<span class="time">%s</span> ',
463                                            time_channel => '<span class="channel">%s %s</span> ',
464                                            nick => '<span class="nick">%s:</span> ',
465                                            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{</p></body></html>}
476            );
477            return RC_OK;
478    }
479    
480  POE::Kernel->run;  POE::Kernel->run;
Legend:
Removed from v.11  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26