--- trunk/bin/irc-logger.pl 2008/03/12 18:14:57 117 +++ trunk/bin/irc-logger.pl 2008/03/14 17:44:23 129 @@ -2,7 +2,7 @@ use strict; $|++; -use POE qw(Component::IRC Component::Server::HTTP); +use POE qw(Component::IRC Component::Server::HTTP Component::Client::HTTP); use HTTP::Status; use DBI; use Regexp::Common qw /URI/; @@ -18,6 +18,7 @@ use Carp qw/confess/; use XML::Feed; use DateTime::Format::Flexible; +use Encode; =head1 NAME @@ -47,6 +48,8 @@ ## CONFIG +my $debug = 0; + my $irc_config = { nick => 'irc-logger', server => 'irc.freenode.net', @@ -75,7 +78,7 @@ my @channels = ( $CHANNEL ); -warn "# config = ", dump( $irc_config ), $/; +warn "## config = ", dump( $irc_config ) if $debug; my $NICK = $irc_config->{nick} or die "no nick?"; @@ -106,6 +109,7 @@ GetOptions( 'import-dircproxy:s' => \$import_dircproxy, 'log:s' => \$log_path, + 'debug!' => \$debug, ); #$SIG{__DIE__} = sub { @@ -118,6 +122,7 @@ open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n"; + # HTML formatters my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -600,7 +605,7 @@ $a->{me} ||= 0; $a->{time} ||= strftime($TIMESTAMP,localtime()); - _log + _log "ARCHIVE", $a->{channel}, " ", $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", " " . $a->{message}; @@ -650,18 +655,34 @@ my $_stat; +POE::Component::Client::HTTP->spawn( + Alias => 'rss-fetch', + Timeout => 30, +); + +=head2 rss_parse_xml + + rss_parse_xml({ + url => 'http://www.example.com/rss', + send_rss_msgs => 42, + }); -sub rss_fetch { - my ($args) = @_; +=cut + +sub rss_parse_xml { + my ($kernel,$args) = @_; + + warn "## rss_parse_xml ",dump( @_ ) if $debug; # how many messages to send out when feed is seen for the first time? - my $send_rss_msgs = 1; + my $send_rss_msgs = $args->{send_rss_msgs}; + $send_rss_msgs = 1 if ! defined $send_rss_msgs; - _log "RSS fetch", $args->{url}; + warn "## RSS fetch first $send_rss_msgs items from", $args->{url} if $debug; - my $feed = XML::Feed->parse(URI->new( $args->{url} )); + my $feed = XML::Feed->parse( \$args->{xml} ); if ( ! $feed ) { - _log("can't fetch RSS ", $args->{url}); + _log "can't fetch RSS ", $args->{url}, XML::Feed->errstr; return; } @@ -671,8 +692,10 @@ for my $entry ($feed->entries) { $total++; + my $seen_times = $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++; # seen allready? - next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0; + warn "## $seen_times ",$entry->id if $debug; + next if $seen_times > 0; sub prefix { my ($txt,$var) = @_; @@ -701,21 +724,23 @@ if ( my $tags = $entry->category ) { $tags =~ s!^\s+!!; $tags =~ s!\s*$! !; - $tags =~ s!\s+!// !g; + $tags =~ s!,?\s+!// !g; $msg .= prefix( ' ' , $tags ); } - if ( $args->{kernel} && $send_rss_msgs ) { + if ( $seen_times == 0 && $send_rss_msgs ) { $send_rss_msgs--; if ( ! $args->{private} ) { # FIXME bug! should be save_message -# save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg ); - $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' ); + save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg ); +# $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' ); } my ( $type, $to ) = ( 'notice', $args->{channel} ); ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private}; - _log(">> $type $to", $msg); - $args->{kernel}->post( $irc => $type => $to, $msg ); + + _log(">> RSS $type to $to:", $msg); + $kernel->post( $irc => $type => $to => $msg ); + $updates++; } } @@ -725,29 +750,37 @@ $sql .= qq{where id = } . $args->{id}; eval { $dbh->do( $sql ) }; - _log "RSS got $total items of which $updates new"; + _log "RSS $updates/$total new items from", $args->{url}; return $updates; } sub rss_fetch_all { - my $kernel = shift; + my ( $kernel, $send_rss_msgs ) = @_; + warn "## rss_fetch_all -- send_rss_msgs: $send_rss_msgs\n" if $debug; my $sql = qq{ select id, url, name, channel, nick, private from feeds where active is true }; # limit to newer feeds only if we are not sending messages out - $sql .= qq{ and last_update + delay < now() } if $kernel; + $sql .= qq{ and last_update + delay < now() } if defined ( $_stat->{rss}->{fetch} ); my $sth = $dbh->prepare( $sql ); $sth->execute(); warn "# ",$sth->rows," active RSS feeds\n"; my $count = 0; while (my $row = $sth->fetchrow_hashref) { - $row->{kernel} = $kernel if $kernel; - $count += rss_fetch( $row ); + $row->{send_rss_msgs} = $send_rss_msgs if defined $send_rss_msgs; + $_stat->{rss}->{fetch}->{ $row->{url} } = $row; + $kernel->post( + 'rss-fetch', + 'request', + 'rss_response', + HTTP::Request->new( GET => $row->{url} ), + ); + warn "## queued rss-fetch ", dump( $row ) if $debug; } - return "OK, fetched $count posts from " . $sth->rows . " feeds"; + return "OK, scheduled " . $sth->rows . " feeds for refresh"; } @@ -755,16 +788,13 @@ my $kernel = shift; $_stat->{rss}->{last_poll} ||= time(); my $dt = time() - $_stat->{rss}->{last_poll}; - warn "## rss_check_updates $dt > $rss_min_delay\n"; if ( $dt > $rss_min_delay ) { + warn "## rss_check_updates $dt > $rss_min_delay\n"; $_stat->{rss}->{last_poll} = time(); _log rss_fetch_all( $kernel ); } } -# seed rss seen cache so we won't send out all items on startup -_log rss_fetch_all; - POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->post( $irc => register => 'all' ); @@ -775,11 +805,13 @@ my $poco_object = $sender->get_heap(); _log "connected to",$poco_object->server_name(); $kernel->post( $sender => join => $_ ) for @channels; + # seen RSS cache, so don't send out messages + _log rss_fetch_all( $kernel, 0 ); undef; }, - irc_255 => sub { # server is done blabbing - $_[KERNEL]->post( $irc => join => $CHANNEL); - }, +# irc_255 => sub { # server is done blabbing +# $_[KERNEL]->post( $irc => join => $CHANNEL); +# }, irc_public => sub { my $kernel = $_[KERNEL]; my $nick = (split /!/, $_[ARG0])[0]; @@ -829,6 +861,7 @@ my $nick = (split /!/, $_[ARG0])[0]; my $msg = $_[ARG2]; my $channel = $_[ARG1]->[0]; + warn "# ARG = ",dump( @_[ARG0,ARG1,ARG2] ) if $debug; my $res = "unknown command '$msg', try /msg $NICK help!"; my @out; @@ -972,7 +1005,7 @@ my $sql = { add => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) }, -# remove => qq{ delete from feeds where url = ? and name = ? }, + remove => qq{ delete from feeds where url = ? and nick = ? }, start => qq{ update feeds set active = true where url = ? }, stop => qq{ update feeds set active = false where url = ? }, clean => qq{ update feeds set last_update = now() - delay where url = ? }, @@ -985,13 +1018,18 @@ my @data = ( $url ); if ( $command eq 'add' ) { push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 ); + } elsif ( $command eq 'remove' ) { + push @data, $nick; } warn "## $command SQL $q with ",dump( @data ),"\n"; eval { $sth->execute( @data ) }; if ($@) { $res = "ERROR: $@"; } else { - $res = "OK, RSS executed $command " . ( $sub ? "-$sub" : '' ) ."on $channel url $url"; + $res = "OK, RSS executed $command" . + ( $sub ? "-$sub " : ' ' ) . + ( $channel ? "on $channel " : '' ) . + "url $url"; if ( $command eq 'clean' ) { my $seen = $_stat->{rss}->{seen} || die "no seen?"; my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)"; @@ -1003,6 +1041,8 @@ _log "RSS removed seen $c $url $link"; } } + } elsif ( $command eq 'add' ) { + rss_fetch_all( $_[KERNEL] ); } } } else { @@ -1012,7 +1052,7 @@ # this makes sense because we didn't catch rss-clean http://... before! $_stat->{rss} = undef; $dbh->do( qq{ update feeds set last_update = now() - delay } ); - $res = "OK, cleaned RSS cache"; + $res = rss_fetch_all( $_[KERNEL] ); } if ($res) { @@ -1073,7 +1113,7 @@ _log ">> registreted, so IDENTIFY"; $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" ); } else { - warn "## ignore $m\n"; + warn "## ignore $m\n" if $debug; } }, irc_snotice => sub { @@ -1092,6 +1132,19 @@ ""; 0; # false for signals }, + rss_response => sub { + my ($request_packet, $response_packet) = @_[ARG0, ARG1]; + my $request_object = $request_packet->[0]; + my $response_object = $response_packet->[0]; + + my $row = delete( $_stat->{rss}->{fetch}->{ $request_object->uri } ); + if ( $row ) { + $row->{xml} = $response_object->content; + rss_parse_xml( $_[KERNEL], $row ); + } else { + warn "## can't find rss->fetch for ", $request_object->uri; + } + }, }, ); @@ -1370,7 +1423,7 @@

See history of all messages.

}; - $response->content( $html ); + $response->content( decode('utf-8',$html) ); warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n"; return RC_OK; }