--- trunk/irc-logger.pl 2006/05/20 10:30:45 26 +++ trunk/irc-logger.pl 2006/06/25 16:37:39 36 @@ -18,13 +18,17 @@ ## CONFIG +my $HOSTNAME = `hostname`; + my $NICK = 'irc-logger'; +$NICK .= '-dev' if ($HOSTNAME =~ m/llin/); my $CONNECT = {Server => 'irc.freenode.net', Nick => $NICK, Ircname => "try /msg $NICK help", }; my $CHANNEL = '#razmjenavjestina'; +$CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/); my $IRC_ALIAS = "log"; my %FOLLOWS = @@ -36,6 +40,7 @@ my $DSN = 'DBI:Pg:dbname=' . $NICK; my $ENCODING = 'ISO-8859-2'; +my $TIMESTAMP = '%Y-%m-%d %H:%M:%S'; ## END CONFIG @@ -44,10 +49,12 @@ use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP); use HTTP::Status; use DBI; -use Encode qw/from_to/; +use Encode qw/from_to is_utf8/; use Regexp::Common qw /URI/; use CGI::Simple; - +use HTML::TagCloud; +use POSIX qw/strftime/; +use HTML::CalendarMonthSimple; my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; @@ -82,6 +89,9 @@ values (?,?,?,?) }); +my $tags; +my $tag_regex = '\b([\w-_]+)//'; + =head2 get_from_log my @messages = get_from_log( @@ -113,8 +123,6 @@ sub get_from_log { my $args = {@_}; - $args->{limit} ||= 10; - $args->{fmt} ||= { date => '[%s] ', time => '{%s} ', @@ -146,8 +154,10 @@ my $sql = $context ? $sql_context : $sql_message; $sql .= " where message ilike ? or nick ilike ? " if ($args->{search}); + $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} }); + $sql .= " where date(time) = ? " if ($args->{date}); $sql .= " order by log.time desc"; - $sql .= " limit " . $args->{limit}; + $sql .= " limit " . $args->{limit} if ($args->{limit}); my $sth = $dbh->prepare( $sql ); if (my $search = $args->{search}) { @@ -155,6 +165,12 @@ $search =~ s/\s+$//; $sth->execute( ( '%' . $search . '%' ) x 2 ); warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n"; + } elsif (my $tag = $args->{tag}) { + $sth->execute(); + warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n"; + } elsif (my $date = $args->{date}) { + $sth->execute($date); + warn "found ", $sth->rows, " messages for date $date ", $context || '', "\n"; } else { $sth->execute(); } @@ -199,19 +215,29 @@ } } + # sprintf which can take coderef as first parametar + sub cr_sprintf { + my $fmt = shift || return; + if (ref($fmt) eq 'CODE') { + $fmt->(@_); + } else { + sprintf($fmt, @_); + } + } + foreach my $row (@rows) { $row->{time} =~ s#\.\d+##; my $msg = ''; - $msg = sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date}); + $msg = cr_sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date}); my $t = $row->{time}; if ($last_row->{channel} ne $row->{channel}) { - $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel}); + $msg .= cr_sprintf($args->{fmt}->{time_channel}, $t, $row->{channel}); } else { - $msg .= sprintf($args->{fmt}->{time}, $t); + $msg .= cr_sprintf($args->{fmt}->{time}, $t); } my $append = 1; @@ -228,19 +254,19 @@ $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE'); - $msg .= sprintf( $fmt, $nick ); + $msg .= cr_sprintf( $fmt, $nick ); $append = 0; } $args->{fmt}->{message} ||= '%s'; if (ref($args->{filter}->{message}) eq 'CODE') { - $msg .= sprintf($args->{fmt}->{message}, + $msg .= cr_sprintf($args->{fmt}->{message}, $args->{filter}->{message}->( $row->{message} ) ); } else { - $msg .= sprintf($args->{fmt}->{message}, $row->{message}); + $msg .= cr_sprintf($args->{fmt}->{message}, $row->{message}); } if ($append && @msgs) { @@ -261,8 +287,21 @@ POE::Component::IRC->new($IRC_ALIAS); -POE::Session->create - (inline_states => +=head2 save_message + + save_message($channel,$me,$nick,$msg); + +=cut + +sub save_message { + my ($channel,$me,$nick,$msg) = @_; + $me ||= 0; + $sth->execute($channel, $me, $nick, $msg); + add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), + message => $msg); +} + +POE::Session->create( inline_states => {_start => sub { $_[KERNEL]->post($IRC_ALIAS => register => 'all'); $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); @@ -283,7 +322,7 @@ from_to($msg, 'UTF-8', $ENCODING); print "$channel: <$nick> $msg\n"; - $sth->execute($channel, 0, $nick, $msg); + save_message($channel, 0, $nick, $msg); }, irc_ctcp_action => sub { my $kernel = $_[KERNEL]; @@ -294,7 +333,7 @@ from_to($msg, 'UTF-8', $ENCODING); print "$channel ***$nick $msg\n"; - $sth->execute($channel, 1, $nick, $msg); + save_message($channel, 1, $nick, $msg); }, irc_msg => sub { my $kernel = $_[KERNEL]; @@ -384,30 +423,13 @@ # warn "## indetify $NICK\n"; # $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); # }, - irc_372 => sub { - print "MOTD: ", $_[ARG1], "\n"; - }, - irc_snotice => sub { - print "(server notice): ", $_[ARG0], "\n"; - }, - (map - { - ;"irc_$_" => sub { }} - qw( - )), -# join -# ctcp_version -# connected snotice ctcp_action ping notice mode part quit -# 001 002 003 004 005 -# 250 251 252 253 254 265 266 -# 332 333 353 366 372 375 376 -# 477 _child => sub {}, _default => sub { - printf "%s: session %s caught an unhandled %s event.\n", - scalar localtime(), $_[SESSION]->ID, $_[ARG0]; - print "The $_[ARG0] event was given these parameters: ", - join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n"; + printf "%s #%s %s %s\n", + strftime($TIMESTAMP,localtime()), $_[SESSION]->ID, $_[ARG0], + ref($_[ARG1]) eq "ARRAY" ? join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] }) : + $_[ARG1] ? $_[ARG1] : + ""; 0; # false for signals }, my_add => sub { @@ -473,6 +495,53 @@ }, ); +# tags support + +my $cloud = HTML::TagCloud->new; + +=head2 add_tag + + add_tag( id => 42, message => 'irc message' ); + +=cut + +sub add_tag { + my $arg = {@_}; + + return unless ($arg->{id} && $arg->{message}); + + my $m = $arg->{message}; + from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m)); + + while ($m =~ s#$tag_regex##s) { + my $tag = $1; + next if (! $tag || $tag =~ m/https?:/i); + push @{ $tags->{$tag} }, $arg->{id}; + #warn "+tag $tag: $arg->{id}\n"; + $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1); + } +} + +=head2 seed_tags + +Read all tags from database and create in-memory cache for tags + +=cut + +sub seed_tags { + my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' }); + $sth->execute; + while (my $row = $sth->fetchrow_hashref) { + add_tag( %$row ); + } + + foreach my $tag (keys %$tags) { + $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1); + } +} + +seed_tags; + # http server my $httpd = POE::Component::Server::HTTP->new( @@ -487,7 +556,7 @@ my $style = <<'_END_OF_STYLE_'; p { margin: 0; padding: 0.1em; } .time, .channel { color: #808080; font-size: 60%; } -.date { float: right; background: #404040; color: #e0e0e0; font-size: 120%; padding: 0.5em; border-top: 1px dashed #e0e0e0; } +.date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; } .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; } .message { color: #000000; font-size: 100%; } .search { float: right; } @@ -496,6 +565,9 @@ .col-2 { background: #99ff99 } .col-3 { background: #ff9999 } .col-4 { background: #ff66ff } +a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none } +a:hover.tag { border: 1px solid #eee } +hr { border: 1px dashed #ccc; height: 1px; clear: both; } _END_OF_STYLE_ my $max_color = 4; @@ -519,20 +591,55 @@ my $search = $q->param('search') || $q->param('grep') || ''; - $response->content( - qq{$NICK -
+ my $html = + qq{$NICK} . + qq{ +
-

} . - join("

", + $cloud->html(500) . + qq{

}; + if ($request->url =~ m#/history#) { + my $sth = $dbh->prepare(qq{ + select date(time) as date,count(*) as nr + from log + group by date(time) + order by date(time) desc + }); + $sth->execute(); + my ($l_yyyy,$l_mm) = (0,0); + my $cal; + while (my $row = $sth->fetchrow_hashref) { + # this is probably PostgreSQL specific, expects ISO date + my ($yyyy,$mm,$dd) = split(/-/, $row->{date}); + if ($yyyy != $l_yyyy || $mm != $l_mm) { + $html .= $cal->as_HTML() if ($cal); + $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy); + $cal->border(2); + ($l_yyyy,$l_mm) = ($yyyy,$mm); + } + $cal->setcontent($dd, qq{ + $row->{nr} + }); + } + $html .= $cal->as_HTML() if ($cal); + + } else { + $html .= join("

", get_from_log( - limit => $q->param('last') || 100, - search => $q->param('search') || $q->param('grep') || undef, + limit => $q->param('last') || $q->param('date') ? undef : 100, + search => $search || undef, + tag => $q->param('tag') || undef, + date => $q->param('date') || undef, fmt => { - date => '

%s
', + date => sub { + my $date = shift || return; + qq{
$date
'}; + }, time => '%s ', time_channel => '%s %s ', nick => '%s: ', @@ -544,6 +651,7 @@ my $m = shift || return; $m =~ s/($escape_re)/$escape{$1}/gs; $m =~ s#($RE{URI}{HTTP})#$1#gs; + $m =~ s#$tag_regex#$1#g; return $m; }, nick => sub { @@ -558,9 +666,15 @@ }, }, ) - ) . - qq{

} - ); + ); + } + + $html .= qq{

+
+

See history of all messages.

+ }; + + $response->content( $html ); return RC_OK; }