gistfile1.txt

package CPANFailures::Bot;
use Any::Moose;

use Carp;
use DateTime::Format::Mail;
use Digest::SHA1 qw/sha1_hex/;
use Email::Simple;
use LWP::UserAgent;
use Net::NNTP;
use Net::Twitter;

use CPANFailures::Models;

has host => (
    is      => 'rw',
    isa     => 'Str',
    default => 'nntp.perl.org',
);

has group => (
    is      => 'rw',
    isa     => 'Str',
    default => 'perl.cpan.testers',
);

has interval => (
    is      => 'rw',
    isa     => 'Int',
    default => 30,
);

has nntp => (
    is      => 'rw',
    isa     => 'Net::NNTP',
    lazy    => 1,
    default => sub {
        my $self = shift;
        Net::NNTP->new(
            Host    => $self->host,
            Timeout => $self->timeout,
            $self->debug ? (Debug => 1) : (),
        );
    },
);

has twitter => (
    is      => 'rw',
    isa     => 'Net::Twitter::Lite',
    lazy    => 1,
    default => sub {
        my $conf = models('conf')->{twitter}
            or die qq[Required twitter account info in config];

        Net::Twitter->new(%$conf);
    },
);

has cache => (
    is      => 'rw',
    isa     => 'Cache::Cache',
    lazy    => 1,
    default => sub {
        models('cache')
    },
);

has ua => (
    is      => 'rw',
    isa     => 'LWP::UserAgent',
    lazy    => 1,
    default => sub {
        my $ua = LWP::UserAgent->new;
        $ua->env_proxy;
        $ua;
    },
);

has timeout => (
    is      => 'rw',
    isa     => 'Int',
    default => 120,
);

has debug => (
    is      => 'rw',
    isa     => 'Bool',
    default => 0,
);

no Any::Moose;

sub run {
    my $self = shift;

    while (1) {
        $self->check_updates;
        sleep $self->interval;
    }
}

sub check_updates {
    my $self = shift;

    my $nntp = $self->nntp;
    my (undef, undef, $last) = $nntp->group( $self->group );

    unless ($last) {
        carp qq[Can't get group last message for "$self->{group}"];
        return;
    }

    my $cache_key    = 'daemon::nntp::last';
    my $last_checked = $self->cache->get($cache_key);

    unless ($last_checked) {
        $self->cache->set( $cache_key => $last );
        return;
    }

    if ($last_checked < $last) {
        $nntp->nntpstat($last_checked)
            or croak qq[Can't set current article to "$last_checked"];

        while (my $next_id = $nntp->next) {
            my $article = Email::Simple->new(join '', @{ $nntp->article($next_id) });
            my $info = $self->parse_article($article);

            warn "Updating $info->{title} - $info->{link}" if $self->debug;
            eval { $self->twitter->update("$info->{title} - $info->{link}") };
            warn $@ if $@;

            $self->cache->set( $cache_key => $info->{id} );
        }
    }
}

sub parse_article {
    my ($self, $article) = @_;

    my $info = {
        title => $article->header('Subject'),
        xref  => $article->header('Xref'),
    };

    my ($article_id) = $info->{xref} =~ /perl\.cpan\.testers:(\d+)/;
    $info->{id} = $article_id;

    my ($dist) = $info->{title} =~ /^\w+\s+(\S+)\s+/;
    $info->{dist} = $dist;

    my $dt;
    eval {
        $dt = DateTime::Format::Mail->parse_datetime($article->header('Date'));
    };
    if ($@) {
        carp qq[Date parse error for "$article_id": $@];
    }

    if ($dt) {
        $info->{link} = sprintf(
            'http://www.nntp.perl.org/group/perl.cpan.testers/%04d/%02d/msg%d.html',
            $dt->year, $dt->month, $article_id,
        );
    }

    if ($dist) {
        $info->{author} = $self->get_author($dist);
    }

    $info;
}

sub get_author {
    my ($self, $dist) = @_;

    my $content = $self->http_get("http://search.cpan.org/dist/$dist") or return;
    my ($cpan_id) = $content =~ m!<a href="/src/([^/]+)!;

    return $cpan_id;
}

sub http_get {
    my ($self, $url) = @_;

    my $cache_key = 'daemon::ua::' . sha1_hex($url);
    my $cache = $self->cache->get($cache_key);
    return $cache if $cache;

    my $res = $self->ua->get($url);
    if ($res->is_success) {
        my $content = $res->content;
        $self->cache->set( $cache_key => $content );
        return $content;
    }

    carp 'http request failed: ' . $res->status_line . ' for ' . $res->request->uri;
    return;
}

__PACKAGE__->meta->make_immutable;

__END__