--- trunk/irc-logger.pl 2006/03/13 12:56:26 15 +++ trunk/irc-logger.pl 2006/03/26 01:01:10 23 @@ -18,7 +18,7 @@ ## CONFIG -my $NICK = 'irc-logger'; +my $NICK = 'irc-logger-dev'; my $CONNECT = {Server => 'irc.freenode.net', Nick => $NICK, @@ -33,7 +33,7 @@ ERROR => "/var/log/apache/error.log", ); -my $DSN = 'DBI:Pg:dbname=irc-logger'; +my $DSN = 'DBI:Pg:dbname=' . $NICK; my $ENCODING = 'ISO-8859-2'; @@ -46,17 +46,24 @@ 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) @@ -66,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 @@ -85,14 +91,23 @@ time => '{%s} ', time_channel => '{%s %s} ', nick => '%s: ', + me_nick => '***%s ', message => '%s', }, - message_filter => sub { - # modify message content - return shift; - } + filter => { + message => sub { + # modify message content + return shift; + } + }, + context => 5, ); +Order is important. Fields are first passed through C (if available) and +then throgh C<< sprintf($fmt->{message}, $message >> if available. + +C defines number of messages around each search hit for display. + =cut sub get_from_log { @@ -104,25 +119,41 @@ time => '{%s} ', time_channel => '{%s %s} ', nick => '%s: ', + me_nick => '***%s ', message => '%s', }; - my $sql = qq{ + my $sql_message = qq{ select time::date as date, time::time as time, channel, + me, nick, message from log }; + + my $sql_context = qq{ + select + id + from log + }; + + my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /); + + my $sql = $context ? $sql_context : $sql_message; + $sql .= " where message ilike ? " if ($args->{search}); $sql .= " order by log.time desc"; $sql .= " limit " . $args->{limit}; my $sth = $dbh->prepare( $sql ); - if ($args->{search}) { - $sth->execute( $args->{search} ); + if (my $search = $args->{search}) { + $search =~ s/^\s+//; + $search =~ s/\s+$//; + $sth->execute( '%' . $search . '%' ); + warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n"; } else { $sth->execute(); } @@ -139,7 +170,33 @@ unshift @rows, $row; } - my @msgs; + my @msgs = ( + "Showing " . ($#rows + 1) . " messages..." + ); + + if ($context) { + my @ids = @rows; + @rows = (); + + my $last_to = 0; + + my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } ); + foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) { + my $id = $row_id->{id} || die "can't find id in row"; + + my ($from, $to) = ($id - $context, $id + $context); + $from = $last_to if ($from < $last_to); + $last_to = $to; + $sth->execute( $from, $to ); + + #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n"; + + while (my $row = $sth->fetchrow_hashref) { + push @rows, $row; + } + + } + } foreach my $row (@rows) { @@ -159,14 +216,24 @@ my $append = 1; - if ($last_row->{nick} ne $row->{nick}) { - $msg .= sprintf($args->{fmt}->{nick}, $row->{nick}); + my $nick = $row->{nick}; + $nick =~ s/^_*(.*?)_*$/$1/; + + if ($last_row->{nick} ne $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'; + + $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE'); + + $msg .= sprintf( $fmt, $nick ); $append = 0; } - if (ref($args->{message_filter}) eq 'CODE') { + $args->{fmt}->{message} ||= '%s'; + if (ref($args->{filter}->{message}) eq 'CODE') { $msg .= sprintf($args->{fmt}->{message}, - $args->{message_filter}->( + $args->{filter}->{message}->( $row->{message} ) ); @@ -214,7 +281,18 @@ 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]; @@ -261,11 +339,14 @@ $res = ''; - } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) { + } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) { 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, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); @@ -398,36 +479,83 @@ 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: #0000ff; font-size: 80%; } +.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} . - "irc-logger url: " . $request->uri . '
' . - join("
", + qq{$NICK + +

+ } . + join("

", get_from_log( - limit => 100, + limit => $q->param('last') || 100, + search => $q->param('search') || $q->param('grep') || undef, fmt => { time => '%s ', time_channel => '%s %s ', - nick => '%s: ', + nick => '%s: ', + me_nick => '***%s ', message => '%s', }, - message_filter => sub { - my $m = shift || return; - $m =~ s#($RE{URI}{HTTP})#$1#gs; - return $m; + 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{} + qq{

} ); return RC_OK; }