minimal working version

1 files changed, 154 insertions, 0 deletions

diff --git a/meta.pl b/meta.pl
new file mode 100644
index 0000000..81c76d3
--- /dev/null
+++ b/meta.pl
@@ -0,0 +1,154 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+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();
+
+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)],
+        },
+    );
+    $recent=$recent->{hits}{hits};
+    return $recent;
+}
+
+sub get_changelog_diff {
+    my ($release) = @_;
+
+    my $dist_name = $release->{distribution};
+    my $release_name = $release->{name};
+    my $release_author = $release->{author};
+    my $release_date = $release->{date};
+    my $prev_release = $api->post(
+        'release/_search',
+        {
+            size => 1,
+            from => 0,
+            query => {
+                filtered => {
+                    query  => {
+                        range => { date => {
+                            to => $release_date,
+                            include_upper => 0,
+                        } },
+                    },
+                    filter => {
+                        and => [ {
+                            term => {
+                                'release.distribution' => $dist_name,
+                            },
+                        } ]
+                    }
+                }
+            },
+            sort => [ { date => 'desc' } ],
+            fields => [qw(name author)],
+        },
+    );
+    ($prev_release)=@{$prev_release->{hits}{hits}};
+
+    return if !$prev_release;
+
+    my $prev_release_name = $prev_release->{fields}{name};
+    my $prev_release_author = $prev_release->{fields}{author};
+    my $files = $api->post(
+        'file/_search',
+        {
+            size => 30,
+            query => {
+                filtered => {
+                    query => { match_all => {} },
+                    filter => {
+                        and => [
+                            { term => { level => 0 } },
+                            { term => { release => $release_name } },
+                            {
+                                or => [
+                                    { prefix => { name => 'Change' } },
+                                    { prefix => { name => 'change' } },
+                                    { prefix => { name => 'CHANGE' } },
+                                ],
+                            },
+                        ],
+                    },
+                },
+            },
+            fields => [qw(name)],
+        }
+    );
+
+    my ($changelog_name) = grep {
+        /^change(s|log)$/i
+    } map { $_->{fields}{name} } @{$files->{hits}{hits}};
+
+    return unless $changelog_name;
+    my $this_changelog = $api->ua->get(
+        join '/',$api->base_url,'source',
+        $release_author,$release_name,$changelog_name
+    )->{content};
+    my $prev_changelog = $api->ua->get(
+        join '/',$api->base_url,'source',
+        $prev_release_author,$prev_release_name,$changelog_name
+    )->{content};
+
+    my $diff = diff \$prev_changelog,\$this_changelog;
+
+    return $diff;
+}
+
+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,$diff) = @_;
+
+    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} ) );
+    $e->content( sprintf '<p>%s</p><pre>%s</pre>',
+                 escape_html($release->{abstract}),
+                 escape_html($diff//'') );
+    return $e;
+}
+
+my $recent = get_recent_releases();
+my $feed = build_feed();
+
+for my $rel (@{$recent}) {
+    my $release = $rel->{fields};
+
+    my $diff = get_changelog_diff($release);
+
+    $feed->add_entry(build_entry($release,$diff));
+}
+
+print $feed->as_xml;