使用Perl构建Reddit机器人

2015年2月9日 by David Farrell

今年我的一个目标就是更多地发布关于Perl subreddit 的链接。我通常擅长链接PerlTricks的文章，但不擅长链接其他内容。这很遗憾，因为有很多活跃的Perl博客（我知道至少有25-30个）。

一个忙碌的Perl subreddit 对社区有好处；/r/perl 上的更多链接应该会导致更多访问者，以及subreddit上的更多活动等等 - 一个良性循环。所以，我创建了一个机器人来自动发布链接。在这篇文章中，我将向您展示我是如何做到这一点的。

Reddit API

您需要Reddit账户才能使用API。我喜欢使用 Reddit::Client，因为它工作良好，有良好的文档，并维护会话缓存。这是一个用于向Reddit发布链接的子程序

use warnings;
use strict;
use Reddit::Client;

sub post_reddit_link
{
    my ($title, $url, $subreddit) = @_; 

    my $reddit       = Reddit::Client->new(
        session_file => 'logs/session_data.json',
        user_agent   => 'perly_bot/v0.01',
    );  

    unless ( $reddit->is_logged_in ) { 
        $reddit->login( $ENV{REDDIT_USERNAME}, 
                        $ENV{REDDIT_PASSWORD} );
        $reddit->save_session();
    }   
    
    $reddit->submit_link(
            subreddit => $subreddit,
            title     => $title,
            url       => $url
    );
}

代码应该是相当容易理解的。《post_reddit_link》子程序接受三个参数：要发布到subreddit的名称、帖子的标题和链接的URL。它初始化一个新的Reddit::Client对象，传递会话文件路径和调用Reddit API时要使用的用户代理字符串。会话文件只是用于存储会话cookie的缓存。

接下来，子程序检查$reddit对象是否有活动会话，如果没有，将触发登录请求。我喜欢将凭据存储在环境变量中：这样，代码和任何配置文件都可以托管在公共仓库中，而不会将您的登录详情与任何人共享。最后一部分代码调用submit_link方法来将链接发布到Reddit API。

这段代码在理想情况下应该会工作，但如果出现问题怎么办？例如，Reddit对链接发布施加了限制：相同的链接不能两次发布到同一个subreddit，代理域名被禁止，且链接不能过于频繁地发布。为了捕获错误信息，我将submit_link方法包裹在try/catch块中。

use warnings;
use strict;
use Reddit::Client;
use Try::Tiny;
use Time::Piece;

open my $ERROR_LOG, '>>', 'logs/error.log' or die $!;

sub post_reddit_link
{
    my ($title, $url, $subreddit) = @_; 

    my $reddit       = Reddit::Client->new(
        session_file => 'logs/session_data.json',
        user_agent   => 'perly_bot/v0.01',
    );  

    unless ( $reddit->is_logged_in ) { 
        $reddit->login( $ENV{REDDIT_USERNAME}, 
                        $ENV{REDDIT_PASSWORD} );
        $reddit->save_session();
    }   
    
    try {
        $reddit->submit_link(
            subreddit => $subreddit,
            title     => $title,
            url       => $url
        );
    } catch {
        log_error("Error posting $title $url $_");
    };
}

sub log_error
{
    my $datetime = localtime;
    say $ERROR_LOG $datetime_now->datetime . "\t$_[0]";
}

除了try/catch之外，我还添加了一个log_error子程序，它将错误信息写入错误日志。

读取博客源

现在，我有一个用于向Reddit发布链接的子程序，我需要一个方法来监控博客源并发布新文章的链接。大多数博客通过RSS或atom数据提供源数据，例如 blogs.perl.org 使用atom。我可以使用 HTTP::Tiny 和 XML::Atom::Client 来监控这个源。

use XML::Atom::Client;
use HTTP::Tiny;

sub check_feed
{
    my ($url) = @_;

    my $ua = HTTP::Tiny->new;
    my $response = $ua->get($url);
    if ( $response->{success} )
    {
        my $posts = 
          XML::Atom::Feed->new( Stream => \$response->{content} );

        foreach my $post ( $posts->entries )
        {
            post_reddit_link(
                $post->title,
                $post->link->href,
                'perl'
            );
        }
    }
    else
    {
        log_error(
"Error requesting $url. $response->{status} $response->{reason}"
        );
    }
}

这段代码声明了一个名为check_feed的子程序，它接受一个URL作为参数。它使用HTTP::Tiny获取URL内容，如果成功，遍历atom源中的每篇博客文章，对每篇文章调用post_reddit_link。目前，这段代码将导致问题。我们只想发布与Perl subreddit相关的、新的内容，但这段代码将发布由源URL返回的每篇博客文章的链接。

为了检查相关内容，我可以使用正则表达式与关键词进行匹配。如果文本包含“Perl”或“CPAN”等单词，我假设它是Perl相关的。这是正则表达式

#  must contain a Perl keyword to be considered relevant
my $looks_perly = qr/\b(?:perl|cpan|cpanminus|moose|metacpan|modules?)\b/i;

为了过滤掉陈旧的内容，我需要为发布内容的新鲜程度设置一个阈值。然后，我可以从博客文章的发布日期中减去当前日期时间，以查看发布日期是否超过了我的阈值。我将24小时作为我的阈值

use Time::Piece;
use Time::Seconds;

my $datetime_post = 
  Time::Piece->strptime($post->published, '%Y-%m-%dT%H:%M:%SZ');
my $datetime_now = localtime;

if ( $datetime_post > $datetime_now - ONE_DAY )
{
   ...
}

此代码使用Time::Piece中的strptime函数来提取帖子的发布日期时间。然后，它将帖子的日期时间与当前日期时间减去24小时进行比较（“ONE_DAY”是一个由Time::Seconds导出的24小时的常量）。

总结

将所有这些放在一起，代码看起来是这样的

use warnings;
use strict;
use Reddit::Client;
use Try::Tiny;
use Time::Piece;
use Time::Seconds;
use XML::Atom::Client;
use HTTP::Tiny;

open my $ERROR_LOG, '>>', 'logs/error.log' or die $!;

#  must contain a Perl keyword to be considered relevant
my $looks_perly = qr/\b(?:perl|cpan|cpanminus|moose|metacpan|modules?)\b/i;

# post links for new posts on blogs.perl.org
check_feed('http://blogs.perl.org/atom.xml');

sub post_reddit_link
{
    my ($title, $url, $subreddit) = @_;

    my $reddit       = Reddit::Client->new(
        session_file => 'logs/session_data.json',
        user_agent   => 'perly_bot/v0.01',
    );

    unless ( $reddit->is_logged_in ) {
        $reddit->login( $ENV{REDDIT_USERNAME},
                        $ENV{REDDIT_PASSWORD} );
        $reddit->save_session();
    }

    try {
        $reddit->submit_link(
            subreddit => $subreddit,
            title     => $title,
            url       => $url
        );
    } catch {
        log_error("Error posting $title $url $_");
    };
}

sub log_error
{
    my $datetime = localtime;
    say $ERROR_LOG $datetime->datetime . "\t$_[0]";
}

sub check_feed
{
    my ($url) = @_;

    my $ua = HTTP::Tiny->new;
    my $response = $ua->get($url);

    if ( $response->{success} )
    {
        my $posts =
          XML::Atom::Feed->new( Stream => \$response->{content} );

        foreach my $post ( $posts->entries )
        {
            my $datetime_post =
              Time::Piece->strptime($post->published, '%Y-%m-%dT%H:%M:%SZ');
            my $datetime_now = localtime;

            # if fresh post and contains Perl keyword
            if (   $datetime_post > $datetime_now - ONE_DAY
                && $post->summary =~ $looks_perly)
            {
                post_reddit_link(
                    $post->title,
                    $post->link->href,
                    'perl'
                );
            }
        }
    }
    else
    {
        log_error(
"Error requesting $url. $response->{status} $response->{reason}"
        );
    }
}

运行此脚本时，将检查blogs.perl.org上的新帖子，并将它们提交到/r/perl。

可以使用此脚本做更多的事情：例如，它只支持atom源，但许多博客源使用RSS。必须将检查的URL硬编码到脚本中——最好从可配置的列表中获取它们。最后，没有URL缓存，所以运行此脚本两次将导致它尝试将相同的链接提交到Reddit两次。有关解决这些问题及更多问题的扩展示例，请查看我的Perly-Bot GitHub 仓库。

本文最初发布在PerlTricks.com上。

标签

web