--- trunk/bin/irc-logger.pl 2007/12/07 12:51:55 69 +++ trunk/bin/irc-logger.pl 2007/12/16 18:37:04 70 @@ -58,6 +58,10 @@ my $sleep_on_error = 5; +my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000; +my $http_hostname = `hostname`; +chomp( $http_hostname ); + ## END CONFIG @@ -77,6 +81,8 @@ use Data::Dump qw/dump/; use DateTime::Format::ISO8601; use Carp qw/confess/; +use XML::Feed; +use DateTime::Format::Flexible; my $use_twitter = 1; eval { require Net::Twitter; }; @@ -99,6 +105,48 @@ print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/; } +# HTML formatters + +my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); +my $escape_re = join '|' => keys %escape; + +my $tag_regex = '\b([\w-_]+)//'; + +my %nick_enumerator; +my $max_color = 0; + +my $filter = { + message => sub { + my $m = shift || return; + + # protect HTML from wiki modifications + sub e { + my $t = shift; + return 'uri_unescape{' . uri_escape($t) . '}'; + } + + $m =~ s/($escape_re)/$escape{$1}/gs; + $m =~ s#($RE{URI}{HTTP})#e(qq{$1})#egs || + $m =~ s#\/(\w+)\/#$1#gs; + $m =~ s#$tag_regex#e(qq{$1})#egs; + $m =~ s#\*(\w+)\*#$1#gs; + $m =~ s#_(\w+)_#$1#gs; + + $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs; + 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 . ''; + }, +}; + my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; my $sql_schema = { @@ -198,7 +246,6 @@ my $tags; -my $tag_regex = '\b([\w-_]+)//'; =head2 get_from_log @@ -431,10 +478,13 @@ =head2 add_tag - add_tag( id => 42, message => 'irc message' ); + add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] ); =cut +my $last_x_tags = 5; +my @last_tags; + sub add_tag { my $arg = {@_}; @@ -443,13 +493,23 @@ my $m = $arg->{message}; from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m)); + my @tags; + 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); + push @tags, $tag; + + } + + if ( @tags ) { + shift @last_tags if $#last_tags == $last_x_tags; + push @last_tags, { tags => [ @tags ], %$arg }; } + } =head2 seed_tags @@ -459,7 +519,7 @@ =cut sub seed_tags { - my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' }); + my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' }); $sth->execute; while (my $row = $sth->fetchrow_hashref) { add_tag( %$row ); @@ -479,7 +539,7 @@ channel => '#foobar', me => 0, nick => 'dpavlin', - msg => 'test message', + message => 'test message', time => '2006-06-25 18:57:18', ); @@ -491,19 +551,19 @@ sub save_message { my $a = {@_}; + confess "have msg" if $a->{msg}; $a->{me} ||= 0; $a->{time} ||= strftime($TIMESTAMP,localtime()); _log $a->{channel}, " ", $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", - " " . $a->{msg}; + " " . $a->{message}; - from_to($a->{msg}, 'UTF-8', $ENCODING); + from_to($a->{message}, 'UTF-8', $ENCODING); - $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time}); - add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), - message => $a->{msg}); + $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time}); + add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a ); } @@ -528,7 +588,7 @@ channel => $CHANNEL, me => $me, nick => $nick, - msg => $msg, + message => $msg, time => $dt->ymd . " " . $dt->hms, ) if ($nick !~ m/^-/); @@ -570,7 +630,7 @@ my $channel = $_[ARG1]->[0]; my $msg = $_[ARG2]; - save_message( channel => $channel, me => 0, nick => $nick, msg => $msg); + save_message( channel => $channel, me => 0, nick => $nick, message => $msg); meta( $nick, $channel, 'last-msg', $msg ); }, irc_ctcp_action => sub { @@ -579,7 +639,7 @@ my $channel = $_[ARG1]->[0]; my $msg = $_[ARG2]; - save_message( channel => $channel, me => 1, nick => $nick, msg => $msg); + save_message( channel => $channel, me => 1, nick => $nick, message => $msg); if ( $use_twitter ) { if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) { @@ -852,14 +912,11 @@ # http server my $httpd = POE::Component::Server::HTTP->new( - Port => $NICK =~ m/-dev/ ? 8001 : 8000, + Port => $http_port, 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%; } @@ -881,7 +938,7 @@ .month { border: 0px; width: 100%; } _END_OF_STYLE_ -my $max_color = 4; +$max_color = 0; my @cols = qw( #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99 @@ -891,19 +948,15 @@ #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff ); -$max_color = 0; foreach my $c (@cols) { $style .= ".col-${max_color} { background: $c }\n"; $max_color++; } warn "defined $max_color colors for users...\n"; -my %nick_enumerator; - sub root_handler { my ($request, $response) = @_; $response->code(RC_OK); - $response->content_type("text/html; charset=$ENCODING"); my $q; @@ -917,6 +970,47 @@ my $search = $q->param('search') || $q->param('grep') || ''; + if ($request->url =~ m#/(rss|atom)#) { + my $type = uc($1); + my $url = "http://$http_hostname:$http_port"; + + $response->content_type("application/$type+xml"); + + my $html = ''; + warn "create $type feed from ",dump( @last_tags ); + + my $feed = XML::Feed->new( $type ); + + $feed->title( "last $last_x_tags from $CHANNEL" ); + $feed->link( "http://$http_hostname:$http_port" ); + $feed->description( "collects messages which have tags// in them" ); + + foreach my $m ( @last_tags ) { + warn dump( $m ); + #my $tags = join(' ', @{$m->{tags}} ); + my $feed_entry = XML::Feed::Entry->new($type); + $feed_entry->title( $m->{nick} . '@' . $m->{time} ); + $feed_entry->author( $m->{nick} ); +# $feed_entry->link( ); + $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) ); + $feed_entry->summary( +# $filter->{nick}->( $m->{nick} ) . +# '' . $m->{nick} . ' ' . + $filter->{message}->( $m->{message} ) + ); + $feed->add_entry( $feed_entry ); + } + + $response->content( $feed->as_xml ); + return RC_OK; + } + + if ( $@ ) { + warn "$@"; + } + + $response->content_type("text/html; charset=$ENCODING"); + my $html = qq{$NICK