#!/usr/bin/perl -w ########################################### # pm2irc - Scrape perlmonks.com and post # new questions to #pmnewestnodes ########################################### use strict; use Bot::BasicBot; use HTML::TreeBuilder; use URI::URL; use CGI qw(a); use Cache::FileCache; use HTTP::Request::Common; use Log::Log4perl qw(:easy); use POE; use POE::Component::Client::HTTP; use XML::Simple; our $CHANNEL = "#pm2irc"; our $USER = "pm2irc"; our $FETCH_INTERVAL = 600; our $BASE_URL = "http://perlmonks.com/?node_id="; # RSS feed our $FETCH_URL = "${BASE_URL}30175"; Log::Log4perl->easy_init($INFO); our $cache = new Cache::FileCache({ namespace => "pm2irc", }); my $Bot = Bot::BasicBot->new( server => 'irc.freenode.net', channels => [$CHANNEL], nick => $USER, ); DEBUG "Setting up pm2irc POE components"; POE::Component::Client::HTTP->spawn( Alias => "ua", Timeout => 60, ); POE::Session->create( inline_states => { _start => sub { # Wait 20 secs before the first post $poe_kernel->delay('http_start', 20); }, http_start => sub { DEBUG "Fetching url $FETCH_URL"; $poe_kernel->post("ua", "request", "http_ready", GET $FETCH_URL); $poe_kernel->delay('http_start', $FETCH_INTERVAL); }, http_ready => sub { DEBUG "http_ready $FETCH_URL"; my $resp= $_[ARG1]->[0]; if($resp->is_success()) { pm_update($resp->content()); } else { ERROR "Can't fetch $FETCH_URL: ", $resp->message(); } }, } ); DEBUG "The dance begins ..."; $Bot->run(); ########################################### sub pm_update { ########################################### my($html_text) = @_; if(my @nws = latest_news($html_text)) { for(@nws) { INFO "Sending '$_' to channel"; $Bot->say(channel => $CHANNEL, body => "$_", ); } } } ########################################### sub latest_news { ########################################### my($xml_string) = @_; my $max_node; my $saved = $cache->get("max-node"); $saved = 0 unless defined $saved; my @aimtext = (); my $data = XMLin($xml_string); for my $node (@{ $data->{NODE} }) { next unless $node->{nodetype}; next unless $node->{nodetype} =~ /perlquestion|monkdiscussion/; $node->{content} =~ s/\n//g; if($node->{node_id} > $saved) { INFO "New node $node->{content} ($node->{node_id})"; unshift @aimtext, "$node->{content} " . "${BASE_URL}$node->{node_id}"; } $max_node = $node->{node_id} if !defined $max_node or $max_node < $node->{node_id}; } $cache->set("max-node", $max_node) if $saved < $max_node; return @aimtext; }