--- trunk/irc-logger.pl 2006/03/02 00:52:22 11 +++ trunk/irc-logger.pl 2006/03/14 17:17:53 20 @@ -33,26 +33,37 @@ ERROR => "/var/log/apache/error.log", ); -my $DSN = 'DBI:Pg:dbname=irc-logger'; +my $DSN = 'DBI:Pg:dbname=' . $NICK; + +my $ENCODING = 'ISO-8859-2'; ## END CONFIG -use POE qw(Component::IRC Wheel::FollowTail); +use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP); +use HTTP::Status; use DBI; use Encode qw/from_to/; +use Regexp::Common qw /URI/; +use CGI::Simple; my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; -=for SQL schema +eval { + $dbh->do(qq{ select count(*) from log }); +}; + +if ($@) { + warn "creating database table in $DSN\n"; + $dbh->do(<<'_SQL_SCHEMA_'); -$dbh->do(qq{ create table log ( id serial, time timestamp default now(), channel text not null, + me boolean default false, nick text not null, message text not null, primary key(id) @@ -62,14 +73,13 @@ create index log_channel on log(channel); create index log_nick on log(nick); -}); - -=cut +_SQL_SCHEMA_ +} my $sth = $dbh->prepare(qq{ insert into log - (channel, nick, message) -values (?,?,?) + (channel, me, nick, message) +values (?,?,?,?) }); =head2 get_from_log @@ -77,8 +87,24 @@ my @messages = get_from_log( limit => 42, search => '%what to stuff in ilike%', + fmt => { + time => '{%s} ', + time_channel => '{%s %s} ', + nick => '%s: ', + me_nick => '***%s ', + message => '%s', + }, + filter => { + message => sub { + # modify message content + return shift; + } + } ); +Order is important. Fields are first passed through C (if available) and +then throgh C<< sprintf($fmt->{message}, $message >> if available. + =cut sub get_from_log { @@ -86,11 +112,20 @@ $args->{limit} ||= 10; + $args->{fmt} ||= { + time => '{%s} ', + time_channel => '{%s %s} ', + nick => '%s: ', + me_nick => '***%s ', + message => '%s', + }; + my $sql = qq{ select time::date as date, time::time as time, channel, + me, nick, message from log @@ -101,7 +136,8 @@ my $sth = $dbh->prepare( $sql ); if ($args->{search}) { - $sth->execute( $args->{search} ); + $sth->execute( '%' . $args->{search} . '%' ); + warn "search for '$args->{search}' returned ", $sth->rows, " results\n"; } else { $sth->execute(); } @@ -118,7 +154,9 @@ unshift @rows, $row; } - my @msgs; + my @msgs = ( + "Showing " . ($#rows + 1) . " messages..." + ); foreach my $row (@rows) { @@ -130,15 +168,42 @@ my $msg = ''; - $msg .= "($t"; - $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel}); - $msg .= ") "; + if ($last_row->{channel} ne $row->{channel}) { + $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel}); + } else { + $msg .= sprintf($args->{fmt}->{time}, $t); + } - $msg .= $row->{nick} . ': ' if ($last_row->{nick} ne $row->{nick}); + my $append = 1; - $msg .= $row->{message}; + if ($last_row->{nick} ne $row->{nick}) { + # obfu way to find format for me_nick if needed or fallback to default + my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick}; + $fmt ||= '%s'; - push @msgs, $msg; + my $nick = $row->{nick}; + $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE'); + + $msg .= sprintf( $fmt, $nick ); + $append = 0; + } + + $args->{fmt}->{message} ||= '%s'; + if (ref($args->{filter}->{message}) eq 'CODE') { + $msg .= sprintf($args->{fmt}->{message}, + $args->{filter}->{message}->( + $row->{message} + ) + ); + } else { + $msg .= sprintf($args->{fmt}->{message}, $row->{message}); + } + + if ($append && @msgs) { + $msgs[$#msgs] .= " " . $msg; + } else { + push @msgs, $msg; + } $last_row = $row; } @@ -171,16 +236,27 @@ my $channel = $_[ARG1]->[0]; my $msg = $_[ARG2]; - from_to($msg, 'UTF-8', 'ISO-8859-2'); + from_to($msg, 'UTF-8', $ENCODING); print "$channel: <$nick> $msg\n"; - $sth->execute($channel, $nick, $msg); + $sth->execute($channel, 0, $nick, $msg); + }, + irc_ctcp_action => sub { + my $kernel = $_[KERNEL]; + my $nick = (split /!/, $_[ARG0])[0]; + my $channel = $_[ARG1]->[0]; + my $msg = $_[ARG2]; + + from_to($msg, 'UTF-8', $ENCODING); + + print "$channel ***$nick $msg\n"; + $sth->execute($channel, 1, $nick, $msg); }, irc_msg => sub { my $kernel = $_[KERNEL]; my $nick = (split /!/, $_[ARG0])[0]; my $msg = $_[ARG2]; - from_to($msg, 'UTF-8', 'ISO-8859-2'); + from_to($msg, 'UTF-8', $ENCODING); my $res = "unknown command '$msg', try /msg $NICK help!"; my @out; @@ -215,7 +291,7 @@ foreach my $res (get_from_log( limit => $1 )) { print "last: $res\n"; - from_to($res, 'ISO-8859-2', 'UTF-8'); + from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -225,9 +301,9 @@ my $what = $2; - foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) { + foreach my $res (get_from_log( limit => 20, search => $what )) { print "search [$what]: $res\n"; - from_to($res, 'ISO-8859-2', 'UTF-8'); + from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -237,7 +313,7 @@ if ($res) { print ">> [$nick] $res\n"; - from_to($res, 'ISO-8859-2', 'UTF-8'); + from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -350,4 +426,93 @@ }, ); +# http server + +my $httpd = POE::Component::Server::HTTP->new( + Port => $NICK =~ m/-dev/ ? 8001 : 8000, + ContentHandler => { '/' => \&root_handler }, + Headers => { Server => 'irc-logger' }, +); + +my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); +my $escape_re = join '|' => keys %escape; + +my $style = <<'_END_OF_STYLE_'; +p { margin: 0; padding: 0.1em; } +.time, .channel { color: #808080; font-size: 60%; } +.nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; } +.message { color: #000000; font-size: 100%; } +.search { float: right; } +.col-0 { background: #ffff66 } +.col-1 { background: #a0ffff } +.col-2 { background: #99ff99 } +.col-3 { background: #ff9999 } +.col-4 { background: #ff66ff } +_END_OF_STYLE_ + +my $max_color = 4; + +my %nick_enumerator; + +sub root_handler { + my ($request, $response) = @_; + $response->code(RC_OK); + $response->content_type("text/html; charset=$ENCODING"); + + my $q; + + if ( $request->method eq 'POST' ) { + $q = new CGI::Simple( $request->content ); + } elsif ( $request->uri =~ /\?(.+)$/ ) { + $q = new CGI::Simple( $1 ); + } else { + $q = new CGI::Simple; + } + + my $search = $q->param('search') || $q->param('grep') || ''; + + $response->content( + qq{$NICK + +

+ } . + join("

", + get_from_log( + limit => $q->param('limit') || 100, + search => $q->param('search') || $q->param('grep') || undef, + fmt => { + time => '%s ', + time_channel => '%s %s ', + nick => '%s: ', + me_nick => '***%s ', + message => '%s', + }, + filter => { + message => sub { + my $m = shift || return; + $m =~ s/($escape_re)/$escape{$1}/gs; + $m =~ s#($RE{URI}{HTTP})#$1#gs; + return $m; + }, + nick => sub { + my $n = shift || return; + if (! $nick_enumerator{$n}) { + my $max = scalar keys %nick_enumerator; + $nick_enumerator{$n} = $max + 1; + } + return '' . $n . ''; + }, + }, + ) + ) . + qq{

} + ); + return RC_OK; +} + POE::Kernel->run;