--- trunk/irc-logger.pl 2006/03/13 16:43:18 16 +++ trunk/irc-logger.pl 2006/03/26 01:01:10 23 @@ -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'; @@ -51,13 +51,19 @@ 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) @@ -67,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 @@ -86,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 { @@ -105,26 +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}) { - warn "search for '$args->{search}' returned ", $sth->rows, " results\n"; - $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(); } @@ -145,6 +174,30 @@ "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) { $row->{time} =~ s#\.\d+##; @@ -163,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} ) ); @@ -218,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]; @@ -265,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 ); @@ -402,14 +479,26 @@ 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); @@ -437,18 +526,32 @@ } . join("

", get_from_log( - limit => $q->param('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 . ''; + }, }, ) ) .