Commit Diff


commit - e12c3d6c1d3836c88da14cf59054950f3b53ed64
commit + ff0d12a109d43481f4538dec7dc10749c488449a
blob - ce2a03efb3fece41b60fb4e1812609abc90e636a
blob + 05eb6b7cba0f37f0a97b84ad82c318f937d6e78a
--- crybot.pl
+++ crybot.pl
@@ -8,6 +8,7 @@ use feature qw(say state);
 use autodie qw(:socket :io);
 
 use Socket qw(AF_INET PF_INET SOCK_STREAM inet_aton inet_ntoa sockaddr_in);
+use IO::Select;
 use IO::Socket::SSL qw(debug4);
 use Digest::MD5 qw(md5_hex);
 use IP::Country::Fast;
@@ -16,10 +17,13 @@ use Net::DNS;
 use HTML::Entities qw(decode_entities);
 use LWP::Simple qw(get $ua);
 use HTTP::Tiny;
-use JSON::PP qw(decode_json);
+use JSON::PP qw(decode_json encode_json);
 use URI::Escape qw(uri_escape);
 use MIME::Base64 qw(encode_base64);
 use Encode qw(decode);
+use Time::HiRes qw(time);
+use File::Spec;
+use FindBin qw($Bin);
 
 binmode STDOUT, ':encoding(UTF-8)';
 binmode STDERR, ':encoding(UTF-8)';
@@ -41,10 +45,35 @@ my %config = (
     debug    => $ENV{CRYBOT_DEBUG}    // 0,
     sasl_user => $ENV{CRYBOT_SASL_USER},
     sasl_pass => $ENV{CRYBOT_SASL_PASS},
+    feed_poll_interval => $ENV{CRYBOT_FEED_INTERVAL} // 60,
+    feed_state_file    => $ENV{CRYBOT_FEED_STATE}    // 'crybot-feed-state.json',
+    feed_sources       => [
+        {
+            key   => 'articles',
+            label => $ENV{CRYBOT_ARTICLE_LABEL} // 'Article',
+            url   => $ENV{CRYBOT_ARTICLE_FEED}   // 'https://www.Cryogenix.org/library/feed.rss',
+        },
+        {
+            key   => 'forums',
+            label => $ENV{CRYBOT_FORUM_LABEL} // 'Forum',
+            url   => $ENV{CRYBOT_FORUM_FEED}   // 'https://www.Cryogenix.org/forum/feed.rss',
+        },
+    ],
 );
 
 $config{channels} = [ uniq( $config{channel}, '#cryogenix', '#cryogenix' ) ];
 $config{silence}  = uc $config{silence};
+$config{feed_poll_interval} =
+  ($config{feed_poll_interval} && $config{feed_poll_interval} =~ /^\d+$/)
+  ? 0 + $config{feed_poll_interval}
+  : 60;
+$config{feed_sources} =
+  [ grep { defined $_->{url} && length $_->{url} } @{ $config{feed_sources} // [] } ];
+$config{feed_state_file} ||= 'crybot-feed-state.json';
+if ( $config{feed_state_file} !~ m{^/} ) {
+    $config{feed_state_file} = File::Spec->catfile( $Bin, $config{feed_state_file} );
+}
+$config{feed_state} = load_feed_state( $config{feed_state_file} );
 
 $ua->agent('Cryogenix IRC Bot');
 $ua->timeout(5);
@@ -219,11 +248,45 @@ sub join_channels {
 
 sub event_loop {
     my ( $sock, $config ) = @_;
-    while ( my $raw = <$sock> ) {
-        chomp $raw;
-        $raw =~ s/\r$//;
-        debug_log( $config, "<< $raw" );
-        handle_line( $sock, $config, $raw );
+    my $selector = IO::Select->new($sock);
+    my $have_feeds = @{ $config->{feed_sources} // [] } ? 1 : 0;
+    my $next_poll  = time;
+
+    while (1) {
+        my $now = time;
+
+        if ( $have_feeds && $now >= $next_poll ) {
+            eval { poll_feeds( $sock, $config ); };
+            warn "Feed poll failed: $@" if $@;
+            $next_poll = $now + $config->{feed_poll_interval};
+        }
+
+        my @ready;
+        if ( $have_feeds ) {
+            my $timeout = $next_poll - $now;
+            if ( $timeout <= 0 ) {
+                @ready = $selector->can_read(0);
+            }
+            else {
+                @ready = $selector->can_read($timeout);
+            }
+        }
+        else {
+            @ready = $selector->can_read;
+        }
+
+        if (@ready) {
+            my $raw = <$sock>;
+            last unless defined $raw;
+            chomp $raw;
+            $raw =~ s/\r$//;
+            debug_log( $config, "<< $raw" );
+            handle_line( $sock, $config, $raw );
+        }
+
+        if ( !@ready && !$have_feeds ) {
+            next;
+        }
     }
 }
 
@@ -324,6 +387,120 @@ sub handle_channel_text {
     }
 }
 
+sub poll_feeds {
+    my ( $sock, $config ) = @_;
+    return unless @{ $config->{feed_sources} // [] };
+
+    my $state       = $config->{feed_state} //= {};
+    my $send_output = $config->{silence} eq 'NO';
+    my $state_changed = 0;
+
+    for my $feed ( @{ $config->{feed_sources} } ) {
+        my $feed_url = $feed->{url};
+        next unless $feed_url;
+
+        debug_log( $config, "[feed] polling $feed_url" );
+        my $body = http_get(
+            $feed_url,
+            'Accept' => 'application/rss+xml, application/xml;q=0.9,*/*;q=0.8',
+            max_bytes => 256 * 1024
+        );
+
+        unless ( defined $body ) {
+            debug_log( $config, "[feed] no response from $feed_url" );
+            next;
+        }
+
+        my @items = parse_rss_items($body);
+        next unless @items;
+
+        my $key       = $feed->{key} // $feed_url;
+        my $last_guid = $state->{$key}{last_guid};
+
+        unless ( defined $last_guid ) {
+            my $initial = $items[0];
+            my $guid    = $initial->{guid} // $initial->{link};
+            if ($guid) {
+                $state->{$key}{last_guid} = $guid;
+                $state_changed = 1;
+            }
+            next;
+        }
+
+        my @announce;
+        for my $item (@items) {
+            my $guid = $item->{guid} // $item->{link};
+            next unless $guid;
+            last if defined $last_guid && $guid eq $last_guid;
+            push @announce, $item;
+        }
+
+        next unless @announce;
+        @announce = reverse @announce;
+
+        for my $item (@announce) {
+            my $guid = $item->{guid} // $item->{link};
+            if ($guid) {
+                $state->{$key}{last_guid} = $guid;
+                $state_changed = 1;
+            }
+
+            next unless $send_output;
+
+            my $title = $item->{title} // '(untitled)';
+            my $link  = $item->{link}  // $guid;
+            my $label = $feed->{label} // 'Update';
+            my $message = sprintf '[%s] %s - %s', $label, $title, $link;
+
+            for my $chan ( @{ $config->{channels} // [] } ) {
+                next unless $chan;
+                irc_print( $sock, "PRIVMSG $chan :$message" );
+            }
+        }
+    }
+
+    save_feed_state( $config->{feed_state_file}, $state )
+      if $state_changed;
+}
+
+sub parse_rss_items {
+    my ($xml) = @_;
+    return unless defined $xml;
+
+    my @items;
+    while ( $xml =~ m{<item\b[^>]*>(.*?)</item>}gsi ) {
+        my $chunk = $1 // next;
+        my %item;
+        $item{title}   = _rss_value( $chunk, 'title' );
+        $item{link}    = _rss_value( $chunk, 'link' );
+        $item{guid}    = _rss_value( $chunk, 'guid' );
+        $item{pubDate} = _rss_value( $chunk, 'pubDate' );
+
+        $item{guid} ||= $item{link};
+        push @items, \%item if $item{guid};
+    }
+
+    return @items;
+}
+
+sub _rss_value {
+    my ( $xml, $tag ) = @_;
+    return unless defined $xml && defined $tag;
+
+    if ( $xml =~ m{<$tag\b[^>]*>(.*?)</$tag>}is ) {
+        my $value = $1 // '';
+        $value =~ s{<!\[CDATA\[(.*?)\]\]>}{$1}gs;
+        $value =~ s/^\s+|\s+$//g;
+        $value = decode_entities($value);
+        $value =~ s/\s{2,}/ /g;
+        $value =~ s/[\r\n\t]+/ /g;
+        $value =~ s/^\s+|\s+$//g;
+        return length $value ? $value : undef;
+    }
+
+    return;
+}
+
 sub cmd_banner {
     my ( $sock, $config, $nick, $target, $args, $is_private ) = @_;
     my ( $host, $port ) = split /\s+/, $args;
@@ -722,6 +899,60 @@ sub uniq {
     return grep { defined $_ && !$seen{ lc $_ }++ } @items;
 }
 
+sub load_feed_state {
+    my ($path) = @_;
+    return {} unless defined $path && length $path;
+    return {} unless -e $path;
+
+    my $json = eval {
+        open my $fh, '<:encoding(UTF-8)', $path;
+        local $/;
+        my $content = <$fh>;
+        close $fh;
+        $content;
+    };
+    if ($@) {
+        warn "Failed to load feed state from $path: $@";
+        return {};
+    }
+    return {} unless defined $json && length $json;
+
+    my $data = eval { decode_json($json) };
+    if ($@ || ref $data ne 'HASH' ) {
+        warn "Feed state in $path is invalid JSON: $@";
+        return {};
+    }
+
+    return $data;
+}
+
+sub save_feed_state {
+    my ( $path, $state ) = @_;
+    return unless defined $path && length $path;
+    return unless defined $state && ref $state eq 'HASH';
+
+    my $json = eval { encode_json($state) };
+    if ($@) {
+        warn "Failed to encode feed state: $@";
+        return;
+    }
+
+    my $tmp = "$path.tmp";
+    my $ok  = eval {
+        open my $fh, '>:encoding(UTF-8)', $tmp;
+        print {$fh} $json;
+        close $fh;
+        1;
+    };
+
+    if ( !$ok || $@ ) {
+        warn "Failed to write feed state to $tmp: $@";
+        return;
+    }
+
+    rename $tmp, $path or warn "Failed to move $tmp to $path: $!";
+}
+
 sub http_client {
     state $client = HTTP::Tiny->new(
         agent        => 'Cryogenix IRC Bot',