use strict;
use warnings;
use 5.012;
use MetaCPAN::API;
use Text::Diff;
use XML::Feed;
use DateTime::Format::ISO8601;
use DateTime;
use HTML::Escape 'escape_html';
my $api = MetaCPAN::API->new(
base_url => 'https://fastapi.metacpan.org/v1',
);
{package Release;
use Moose;
has [qw(distribution name author date abstract)] => (
is => 'ro',
);
around BUILDARGS => sub {
my ($orig,$class,$args) = @_;
if ($args->{fields}) {
$args = $args->{fields};
}
return $class->$orig($args);
};
sub get_previous_stable {
my ($self) = @_;
my $prev_release = $api->post(
'release/_search',
{
size => 1,
from => 0,
query => {
filtered => {
query => {
range => { date => {
to => $self->date,
include_upper => 0,
} },
},
filter => {
and => [
{ term => { 'distribution' => $self->distribution } },
{ term => { 'maturity' => 'released' } },
],
}
}
},
sort => [ { date => 'desc' } ],
fields => [qw(name author)],
},
);
($prev_release)=@{$prev_release->{hits}{hits}};
return unless $prev_release;
return ref($self)->new($prev_release);
}
sub get_changelog_file {
my ($self) = @_;
my $file_response;
eval {
$file_response = $api->fetch(
join '/','changes',
$self->author,$self->name,
);
};
return unless $file_response;
return $file_response->{content};
}
};
sub get_recent_releases {
my $now = DateTime->now;
my $yesterday = $now->clone->subtract(hours=>3);
my $recent = $api->post(
'release/_search',
{
size => 500,
from => 0,
query => {
range => { date => {
from => $yesterday->iso8601,
include_lower => 1,
} },
},
sort => [ { 'date' => { order => "desc" } } ],
fields => [qw(distribution name date author abstract)],
},
);
return map { Release->new($_) } @{$recent->{hits}{hits}//[]};
}
sub get_changelog_diff {
my ($release) = @_;
my $this_changelog = $release->get_changelog_file;
return {error=>'no changelog file'} unless $this_changelog;
$this_changelog =~ s/[\014]+//g;
my $prev_release = $release->get_previous_stable;
return {diff=>$this_changelog} if !$prev_release;
my $prev_changelog = $prev_release->get_changelog_file;
return {diff=>$this_changelog} unless $prev_changelog;
$prev_changelog =~ s/[\014]+//g;
my $diff = diff \$prev_changelog,\$this_changelog;
return {diff=>$diff} if $diff;
return {error=>'changelog not modified'};
}
sub build_feed {
my $feed = XML::Feed->new('Atom');
$feed->title('Recent CPAN uploads with Changelog diff');
$feed->link('http://metacpan.org');
return $feed;
}
sub build_entry {
my ($release) = @_;
my $e = XML::Feed::Entry->new('RSS');
$e->title( $release->name );
$e->link(
join( '/',
'http://metacpan.org', 'release',
$release->author, $release->name )
);
$e->author( $release->author );
$e->issued( DateTime::Format::ISO8601->parse_datetime( $release->date ) );
my $diff = get_changelog_diff($release);
my $content = sprintf '<p>%s</p>',
escape_html($release->abstract//'No abstract');
if (exists $diff->{diff}) {
$content .= sprintf '<pre>%s</pre>',
escape_html($diff->{diff});
}
else {
$content .= sprintf '<p>%s</p>',
escape_html($diff->{error});
}
$e->content($content);
return $e;
}
my $feed = build_feed();
my @recent = get_recent_releases();
for my $release (@recent) {
$feed->add_entry(build_entry($release));
}
print $feed->as_xml;
