add legacy JSON feed implementation

This will allow analysis.cpantesters.org to continue Fixes #19
cpan-testers · Sep 7, 2020 · e8542f1 · e8542f1
1 parent 2d5cac7
commit e8542f1
Show file tree

Hide file tree

Showing 3 changed files with 76 additions and 0 deletions.
diff --git a/lib/CPAN/Testers/Web.pm b/lib/CPAN/Testers/Web.pm
@@ -269,6 +269,10 @@ sub startup ( $app ) {
       ->name( 'legacy-view-report' )
       ->to( 'legacy#view_report' );
 
+    $r->get( '/legacy/distro/:letter/:dist' )
+      ->name( 'legacy-distro-feed' )
+      ->to( 'legacy#distro' );
+
     # Add a special route to show the main landing page, which is
     # replaced by a different page in beta mode
     if ( $app->mode eq 'beta' ) {

diff --git a/lib/CPAN/Testers/Web/Controller/Legacy.pm b/lib/CPAN/Testers/Web/Controller/Legacy.pm
@@ -11,6 +11,7 @@ our $VERSION = '0.001';
 use Mojo::Base 'Mojolicious::Controller';
 use CPAN::Testers::Web::Base;
 use JSON::MaybeXS qw( decode_json );
+use Mojo::Util qw( html_unescape );
 
 =method view_report
 
@@ -110,6 +111,47 @@ sub view_report( $c ) {
     );
 }
 
+=method distro
+
+This returns a JSON feed of all the distribution reports to be used by
+external services like analysis.cpantesters.org (via
+L<CPAN::Testers::ParseReport>).
+
+=cut
+
+sub distro( $c ) {
+    my $dist = $c->stash->{dist};
+    my $rs = $c->schema->perl5->resultset( 'Stats' )->search({
+        dist => $dist,
+    });
+    my @records;
+    while ( my $row = $rs->next ) {
+        push @records, {
+            status => uc $row->state,
+            state => $row->state,
+            guid => $row->guid,
+            dist => $row->dist,
+            distribution => $row->dist,
+            version => $row->version,
+            distversion => join( '-', $row->dist, $row->version ),
+            type => $row->type,
+            osname => $row->osname,
+            osvers => $row->osvers,
+            ostext => $OSNAME{ $row->osname },
+            perl => $row->perl,
+            platform => $row->platform,
+            uploadid => $row->uploadid,
+            tester => html_unescape( $row->tester ),
+            id => $row->id,
+            postdate => $row->postdate,
+            fulldate => $row->fulldate,
+            csspatch => ( $row->perl =~ /\b(RC\d+|patch)\b/ ? 'pat' : 'unp' ),
+            cssperl => ( $row->perl =~ /^5.(7|9|[1-9][13579])/ ? 'dev' : 'rel' ),
+        };
+    }
+    return $c->render( json => \@records );
+}
+
 sub _deserialize_metabase_report( $c, $row ) {
     use Data::FlexSerializer;
     use CPAN::Testers::Report;

diff --git a/t/controller/legacy.t b/t/controller/legacy.t
@@ -10,6 +10,7 @@ use CPAN::Testers::Web::Base 'Test';
 use CPAN::Testers::Schema;
 use CPAN::Testers::Web;
 use JSON::MaybeXS qw( decode_json encode_json );
+use DateTime;
 
 # Schema
 my $schema = CPAN::Testers::Schema->connect( 'dbi:SQLite::memory:', undef, undef, { ignore_version => 1 } );
@@ -54,6 +55,10 @@ my $other_metabase_user = $schema->resultset( 'MetabaseUser' )->create({
 my @reports;
 push @reports, $schema->resultset('TestReport')->create({
     id => 'd0ab4d36-3343-11e7-b830-917e22bfee97',
+    created => DateTime->new(
+        year => 2020, month => 1, day => 1,
+        hour => 0, minute => 0, second => 0,
+    ),
     report => {
         id => 'd0ab4d36-3343-11e7-b830-917e22bfee97',
         reporter => {
@@ -338,6 +343,31 @@ subtest 'view-report.cgi' => sub {
     };
 };
 
+subtest 'distro feed' => sub {
+    $t->get_ok( '/legacy/distro/S/Sorauta-SVN-AutoCommit.json' )->status_is( 200 )
+      ->json_is( '/0/status', 'FAIL' )
+      ->json_is( '/0/state', 'fail' )
+      ->json_is( '/0/guid', 'd0ab4d36-3343-11e7-b830-917e22bfee97' )
+      ->json_is( '/0/dist', 'Sorauta-SVN-AutoCommit' )
+      ->json_is( '/0/distribution', 'Sorauta-SVN-AutoCommit' )
+      ->json_is( '/0/version', '0.02' )
+      ->json_is( '/0/distversion', 'Sorauta-SVN-AutoCommit-0.02' )
+      ->json_is( '/0/type', 2 )
+      ->json_is( '/0/osname', 'linux' )
+      ->json_is( '/0/ostext', 'GNU/Linux' ) # %OSNAME map
+      ->json_is( '/0/osvers', '4.8.0-2-amd64' )
+      ->json_is( '/0/perl', '5.22.2' )
+      ->json_is( '/0/platform', 'x86_64-linux' )
+      ->json_is( '/0/csspatch', 'unp' )
+      ->json_is( '/0/cssperl', 'rel' ) # or 'dev'
+      ->json_is( '/0/postdate', '202001' )
+      ->json_is( '/0/fulldate', '202001010000' )
+      ->json_is( '/0/uploadid', '169497' )
+      ->json_is( '/0/tester', '"Andreas J. Koenig" <andreas.koenig.gmwojprw@franz.ak.mind.de>' )
+      ->json_is( '/0/id', $stats[0]->id )
+      ;
+};
+
 done_testing;
 
 # Code copied from CPAN::Testers::Backend::ProcessReports