More post Test::Aggregate tweaks.

metacpan · Apr 24, 2016 · 045cd33 · mickeyn · Apr 26, 2016 · oalders
1 parent 6fc0e45
commit 045cd33
Show file tree

Hide file tree

Showing 9 changed files with 99 additions and 86 deletions.
diff --git a/lib/MetaCPAN/Model/Release.pm b/lib/MetaCPAN/Model/Release.pm
@@ -1,6 +1,9 @@
 package MetaCPAN::Model::Release;
 
+use Moose;
+
 use v5.10;
+
 use CPAN::DistnameInfo ();
 use CPAN::Meta         ();
 use DateTime           ();
@@ -10,11 +13,10 @@ use MetaCPAN::Model::Archive;
 use MetaCPAN::Types qw(ArrayRef AbsFile Str);
 use MetaCPAN::Util ();
 use Module::Metadata 1.000012 ();    # Improved package detection.
-use Moose;
 use MooseX::StrictConstructor;
 use Path::Class ();
 use Parse::PMFile;
-use Try::Tiny;
+use Try::Tiny qw( catch try );
 
 with 'MetaCPAN::Role::Logger';
 

diff --git a/lib/MetaCPAN/Pod/Renderer.pm b/lib/MetaCPAN/Pod/Renderer.pm
@@ -1,9 +1,6 @@
 package MetaCPAN::Pod::Renderer;
 
-use strict;
-use warnings;
-
-use Moose;
+use MetaCPAN::Moose;
 
 use MetaCPAN::Pod::XHTML;
 use MetaCPAN::Types qw( Uri );
@@ -45,7 +42,7 @@ sub html_renderer {
     $parser->html_header('');
     $parser->index(1);
     $parser->no_errata_section(1);
-    $parser->_set_perldoc_url_prefix( $self->perldoc_url_prefix );
+    $parser->perldoc_url_prefix( $self->perldoc_url_prefix );
 
     return $parser;
 }
@@ -92,5 +89,5 @@ sub _generic_render {
     return $output;
 }
 
-__PACKAGE__->meta->make_immutable();
+__PACKAGE__->meta->make_immutable;
 1;
diff --git a/lib/MetaCPAN/Server.pm b/lib/MetaCPAN/Server.pm
@@ -1,13 +1,11 @@
 package MetaCPAN::Server;
 
-use strict;
-use warnings;
+use Moose;
 
 ## no critic (Modules::RequireEndWithOne)
 
 use CatalystX::RoleApplicator;
 use File::Temp qw( tempdir );
-use Moose;
 use Plack::Middleware::ReverseProxy;
 use Plack::Middleware::ServerStatus::Lite;
 
@@ -115,5 +113,9 @@ if ( $ENV{PLACK_ENV} && $ENV{PLACK_ENV} eq 'development' ) {
     );
 }
 
+sub to_app {
+    return $app;
+}
+
 # Let's be explicit because implicit returns can be confusing
 return $app;
diff --git a/t/document/file.t b/t/document/file.t
@@ -531,7 +531,7 @@ use strict;
 Foo - mymodule1 abstract
 POD
 
-    no warnings 'redefine';
+    no warnings qw( once redefine );
 
     local *Pod::Text::parse_string_document = sub {
         die "# [fake pod error]\n";

diff --git a/t/lib/MetaCPAN/TestHelpers.pm b/t/lib/MetaCPAN/TestHelpers.pm
@@ -11,7 +11,7 @@ use MetaCPAN::Script::Runner;
 use Path::Class qw( dir );
 use Test::More;
 use Test::Routine::Util;
-use Try::Tiny qw( catch );
+use Try::Tiny qw( catch try );
 
 use base 'Exporter';
 our @EXPORT = qw(

diff --git a/t/lib/MetaCPAN/Tests/Model.pm b/t/lib/MetaCPAN/Tests/Model.pm
@@ -1,10 +1,11 @@
 package MetaCPAN::Tests::Model;
+
 use Test::Routine;
-use Test::More;
-use Try::Tiny;
 
 use MetaCPAN::Server::Test ();
 use MetaCPAN::Types qw( ArrayRef HashRef Str );
+use Test::More;
+use Try::Tiny qw( catch try );
 
 with qw(
     MetaCPAN::Tests::Extra

diff --git a/t/model/release.t b/t/model/release.t
@@ -1,10 +1,11 @@
 use strict;
 use warnings;
 
-use File::Temp;
+use File::Temp ();
 use LWP::Simple qw(getstore);
 use MetaCPAN::Model::Release;
 use MetaCPAN::Script::Runner;
+use MetaCPAN::TestHelpers qw( get_config );
 use Test::More;
 use Test::RequiresInternet( 'metacpan.org' => 'https' );
 
@@ -25,8 +26,4 @@ $release->set_logger_once;
 
 is $release->file, $archive_file->filename;
 
-# This isn't going to work without a lot more scaffolding passed into Release
-#my $files = $release->files();
-#is( @$files, 4, 'got all files from release' );
-
 done_testing();
diff --git a/t/server/controller/pod.t b/t/server/controller/pod.t
@@ -1,14 +1,21 @@
 use strict;
 use warnings;
 
-use MetaCPAN::Server::Test;
-use Path::Class qw(file);
+use Cpanel::JSON::XS ();
+use HTTP::Request::Common qw( GET );
+use MetaCPAN::Server ();
+use MetaCPAN::Server::App;
+use Path::Class qw(dir);
+use Plack::Test;
 use Test::More;
+use Try::Tiny qw( catch try );
 
-file(
-    MetaCPAN::Server->model('Source')->base_dir,
-    'DOY/Moose-0.02/Moose-0.02/binary.bin'
-)->openw->print( "\x00" x 10 );
+my $dir = dir( MetaCPAN::Server->model('Source')->base_dir,
+    'DOY/Moose-0.02/Moose-0.02' );
+$dir->mkpath;
+
+my $file = $dir->file('binary.bin');
+$file->openw->print( "\x00" x 10 );
 
 my %tests = (
 
@@ -21,82 +28,88 @@ my %tests = (
     '/pod/Pod::Pm'                     => 200,
 );
 
-test_psgi app, sub {
-    my $cb = shift;
-    while ( my ( $k, $v ) = each %tests ) {
-        ok( my $res = $cb->( GET $k), "GET $k" );
-        is( $res->code, $v, "code $v" );
-        is(
-            $res->header('content-type'),
-            $v == 200
-            ? 'text/html; charset=UTF-8'
-            : 'application/json; charset=utf-8',
-            'Content-type'
-        );
+my $app  = MetaCPAN::Server->new->to_app();
+my $test = Plack::Test->create($app);
 
-        if ( $k eq '/pod/Pod::Pm' ) {
-            like( $res->content, qr/Pod::Pm - abstract/, 'NAME section' );
-        }
-        elsif ( $v == 200 ) {
-            like( $res->content, qr/Moose - abstract/, 'NAME section' );
-            ok( $res = $cb->( GET "$k?content-type=text/plain" ),
-                'GET plain' );
-            is(
-                $res->header('content-type'),
-                'text/plain; charset=UTF-8',
-                'Content-type'
-            );
-        }
-        elsif ( $v == 404 ) {
-            like( $res->content, qr/Not found/, '404 correct error' );
-        }
+while ( my ( $k, $v ) = each %tests ) {
+    my $res = $test->request( GET $k);
+    ok( $res, "GET $k" );
+    is( $res->code, $v, "code $v" );
+    is(
+        $res->header('content-type'),
+        $v == 200
+        ? 'text/html; charset=UTF-8'
+        : 'application/json; charset=utf-8',
+        'Content-type'
+    );
 
-        my $ct = $k =~ /Moose[.]pm$/ ? '&content-type=text/x-pod' : q[];
-        ok( $res = $cb->( GET "$k?callback=foo$ct" ),
-            "GET $k with callback" );
-        is( $res->code, $v, "code $v" );
+    if ( $k eq '/pod/Pod::Pm' ) {
+        like( $res->content, qr/Pod::Pm - abstract/, 'NAME section' );
+    }
+    elsif ( $v == 200 ) {
+        like( $res->content, qr/Moose - abstract/, 'NAME section' );
+        $res = $test->request( GET "$k?content-type=text/plain" );
         is(
             $res->header('content-type'),
-            'text/javascript; charset=UTF-8',
+            'text/plain; charset=UTF-8',
             'Content-type'
         );
+    }
+    elsif ( $v == 404 ) {
+        like( $res->content, qr/Not found/, '404 correct error' );
+    }
+
+    my $ct = $k =~ /Moose[.]pm$/ ? '&content-type=text/x-pod' : q[];
+    $res = $test->request( GET "$k?callback=foo$ct" );
+    is( $res->code, $v, "code $v" );
+    is(
+        $res->header('content-type'),
+        'text/javascript; charset=UTF-8',
+        'Content-type'
+    );
+
+    ok( my ($function_args) = $res->content =~ /^\/\*\*\/foo\((.*)\)/s,
+        'callback included' );
+    my $js_data;
+    try {
+        $js_data
+            = Cpanel::JSON::XS->new->allow_blessed->allow_nonref->binary
+            ->decode($function_args);
+    };
+    ok( $js_data, 'decode json' );
+
+    if ( $v eq 200 ) {
 
-        ok( my ($function_args) = $res->content =~ /^\/\*\*\/foo\((.*)\)/s,
-            'callback included' );
-        ok( my $jsdata = JSON->new->allow_nonref->decode($function_args),
-            'decode json' );
-
-        if ( $v eq 200 ) {
-
-            if ($ct) {
-                like( $jsdata, qr{=head1 NAME}, 'POD body was JSON encoded' );
-            }
-            else {
-                like(
-                    $jsdata,
-                    qr{<h1 id="NAME">NAME</h1>},
-                    'HTML body was JSON encoded'
-                );
-            }
+        if ($ct) {
+            like( $js_data, qr{=head1 NAME}, 'POD body was JSON encoded' );
         }
         else {
-            ok( $jsdata->{message}, 'error response body was JSON encoded' );
+            like(
+                $js_data,
+                qr{<h1 id="NAME">NAME</h1>},
+                'HTML body was JSON encoded'
+            );
         }
     }
-};
-
-test_psgi app, sub {
-    my $cb = shift;
+    else {
+        ok( $js_data->{message}, 'error response body was JSON encoded' );
+    }
+}
 
-    my $res;
+{
     my $path = '/pod/BadPod';
-    ok( $res = $cb->( GET $path), "GET $path" );
+    my $res  = $test->request( GET $path );
+    ok( $res, "GET $path" );
     is( $res->code, 200, 'code 200' );
     unlike( $res->content, qr/<div[^>]*id="pod-errors"/,
         'no POD errors section' );
 
-    $path = '/pod/BadPod?show_errors=1';
-    ok( $res = $cb->( GET $path), "GET $path" );
+}
+
+{
+    my $path = '/pod/BadPod?show_errors=1';
+    my $res  = $test->request( GET $path);
+    ok( $res, "GET $path" );
     is( $res->code, 200, 'code 200' );
     like( $res->content, qr/<div[^>]*id="pod-errors"/,
         'got POD errors section' );
@@ -105,6 +118,6 @@ test_psgi app, sub {
     is( scalar(@err), 2, 'two parse errors listed ' );
     like( $err[0], qr/=head\b/, 'first error mentions =head' );
     like( $err[1], qr/C&lt;/,   'first error mentions C< ... >' );
-};
+}
 
 done_testing;
diff --git a/t/server/sanitize_query.t b/t/server/sanitize_query.t
@@ -4,6 +4,7 @@ use warnings;
 use MetaCPAN::Server::Test;
 use MetaCPAN::TestHelpers;
 use Test::More skip_all => 'Scripting is disabled';
+use Try::Tiny qw( catch try );
 use URI;
 
 sub uri {