De-spaghettify DistSource <-> PostProcessor / Fix TODO issue finder

- Move all TODO issue checks to METAChecker postprocessor
    - Lets us avoid duplicating the checks in each dist source
    - Fixes false positives MANIFEST issue
- Make MANIFEST TODO check only applicable to `cpan` dist source as it's a bit
    silly to tell users they need to create useless files in their repos
- Add TODO check for version being set to `*` which we now deem invalid
- Do not use author from GitHub URL if missing from META; hosting != authorship
- Move all Travis and AppVeyor logic entirely into corresponding postprocessors

lib/ModulesPerl6/DbBuilder/Dist/PostProcessor/AppVeyor.pm

@@ -19,8 +19,14 @@ sub process {
         and not $dist->{_builder}{is_fresh} and not $ENV{FULL_REBUILD}
         and not ($dist->{appveyor_status}//'') =~ /\A(unknown|pending)\z/;
 
-    unless ( $dist->{_builder}{has_appveyor} ) {
-        delete $dist->{appveyor_status}; # toss cached status
+    my $has_appveyor = ($dist->{_builder}{files} || [])->@*
+        ? (grep $_->{name} =~ /\A \.? appveyor\.yml \z/x,
+            $dist->{_builder}{files}->@*)
+        : ($dist->{appveyor_status}
+            and $dist->{appveyor_status} ne 'not set up');
+
+    unless ($has_appveyor) {
+        delete $dist->{appveyor_status}; # toss cached AppVeyor status, if any
         return;
     }
 

lib/ModulesPerl6/DbBuilder/Dist/PostProcessor/METAChecker.pm

@@ -4,6 +4,7 @@ use strictures 2;
 use base 'ModulesPerl6::DbBuilder::Dist::PostProcessor';
 
 use Mojo::UserAgent;
+use Mojo::Util qw/b64_decode/;
 use ModulesPerl6::DbBuilder::Log;
 use experimental 'postderef';
 
@@ -16,58 +17,107 @@ sub process {
     my $self = shift;
     my $dist = $self->_dist;
 
-    my $repo_url = 'https://github.com/'
-        . join '/', grep length, @{ $dist->{_builder} }{qw/repo_user  repo/};
-
-    if ( $repo_url eq $dist->{url} ) {
-        log info => "dist source URL is same as META repo URL ($repo_url)";
-        return;
-    }
-
-    my $code = Mojo::UserAgent->new( max_redirects => 5 )
-        ->get( $dist->{url} )->res->code;
+    $self->_check_meta_url($dist);
+    $self->_check_todo_problems($dist);
 
-    log +( $code == 200 ? 'info' : 'error' ),
-        "HTTP $code when accessing dist source URL ($dist->{url})";
+    return 1;
+}
 
-    return unless $dist->{_builder}{is_fresh};
+sub _check_todo_problems {
+    my ($self, $dist) = @_;
 
     my @problems;
-    unless ($dist->{_builder}{has_manifest}) {
-        push @problems, problem "dist has no MANIFEST file", 3;
-    }
-
-    if ($dist->{_builder}{no_author_set}) {
-        push @problems, problem "dist has no author(s) specified", 3;
+    if (my @files = ($dist->{_builder}{files} || [])->@*) {
+        push @problems, $self->_check_todo_problem_readme($dist, \@files);
+        push @problems, problem 'dist has no MANIFEST file', 3
+            if $dist->{dist_source} eq 'cpan'
+                and not grep $_ eq 'MANIFEST', @files;
     }
-
-    if ($dist->{_builder}{has_no_readme}) {
-        push @problems, problem "dist has no readme", 1;
+    else {
+        # If we're here that can mean the dist was processed in abridged,
+        # cached mode; pick existing readme/manifest problems from cached
+        # data, if we got 'em in it
+        @problems = grep $_->{problem} =~ /\b(README|MANIFEST)\b/,
+            ($dist->{problems} || [])->@*;
     }
 
-    if ($dist->{_builder}{mentions_old_tools}) {
-        push @problems, problem "dist mentions discouraged tools (panda, ufo etc.) in the readme", 2;
-    }
+    push @problems, $self->_check_todo_problem_author($dist);
 
     length $dist->{ $_ }
         or push @problems, problem "required `$_` field is missing", 5
     for qw/perl  name  version  description  provides/;
 
-    push @problems, problem "dist does not have any tags", 1
-        unless @{ $dist->{tags} };
+    push @problems, problem 'dist does not have any tags', 1
+        unless $dist->{tags}->@*;
 
     if ($dist->{version}) {
         push @problems, problem "dist has `*` version (it's invalid)", 5
             if $dist->{version} eq '*';
     }
     else {
-        push @problems, problem "dist does not have a version set", 5
-            unless $dist->{version} and $dist->{version} ne '*';
+        push @problems, problem 'dist does not have a version set', 5;
     }
 
     $dist->{problems} = \@problems;
+}
 
-    return 1;
+sub _check_todo_problem_author {
+    my ($self, $dist) = @_;
+
+    my $author = $dist->{author} // $dist->{authors};
+    $author = $author->[0] if ref $author eq 'ARRAY';
+
+    return if length $author;
+    problem "dist has no author(s) specified", 3
+}
+
+sub _check_todo_problem_readme {
+    my ($self, $dist, $files) = @_;
+
+    my ($readme) = grep $_->{name} =~ /^README/, @$files
+        or return problem 'dist has no README', 1;
+
+    my $content = eval {
+        Mojo::UserAgent->new( max_redirects => 5 )
+            ->get( $readme->{url} )->result->json
+    };
+    if ($@) {
+        log error => "Failed to fetch README content from $readme->{url}: $@";
+        return;
+    }
+
+    # TODO XXX: the JSON+decode step is valid for GitHub, but
+    # if other dist sources are taught to provide READMEs, they
+    # may have other mechanism that will need to be taken care of
+    # here. You can use $dist->{dist_source} to find out which
+    # dist source the dist came from.
+
+    # Possible encodings are 'utf-8' and 'base64', per
+    # https://developer.github.com/v3/git/blobs/#parameters
+    $content = $content->{encoding} eq 'base64'
+        ? (b64_decode $content->{content})
+        :             $content->{content};
+
+    return unless $content =~ /\b(panda|ufo)\b/;
+    problem 'dist mentions discouraged tools (panda or ufo) in the README', 2
+}
+
+sub _check_meta_url {
+    my ($self, $dist) = @_;
+
+    my $repo_url = 'https://github.com/'
+        . join '/', grep length, @{ $dist->{_builder} }{qw/repo_user  repo/};
+
+    if ( $repo_url eq $dist->{url} ) {
+        log info => "dist source URL is same as META repo URL ($repo_url)";
+        return;
+    }
+
+    my $code = Mojo::UserAgent->new( max_redirects => 5 )
+        ->get( $dist->{url} )->res->code;
+
+    log +( $code == 200 ? 'info' : 'error' ),
+        "HTTP $code when accessing dist source URL ($dist->{url})";
 }
 
 1;

lib/ModulesPerl6/DbBuilder/Dist/PostProcessor/TravisCI.pm

@@ -19,8 +19,12 @@ sub process {
         and not $dist->{_builder}{is_fresh} and not $ENV{FULL_REBUILD}
         and not ($dist->{travis_status}//'') =~ /\A(unknown|pending)\z/;
 
-    unless ( $dist->{_builder}{has_travis} ) {
-        delete $dist->{travis_status}; # toss cached Travis status
+    my $has_travis = ($dist->{_builder}{files} || [])->@*
+        ? (grep $_->{name} eq '.travis.yml', $dist->{_builder}{files}->@*)
+        : ($dist->{travis_status} and $dist->{travis_status} ne 'not set up');
+
+    unless ($has_travis) {
+        delete $dist->{travis_status}; # toss cached Travis status, if any
         return;
     }
 
@@ -31,7 +35,7 @@ sub process {
         Mojo::UserAgent->new( max_redirects => 5 )->get(
             "https://api.travis-ci.org/repos/$user/$repo/builds"
             => { Accept => 'application/vnd.travis-ci.2+json' }
-        )->res->json->{builds}->@*;
+        )->result->json->{builds}->@*;
     }; if ( $@ ) { log error => "Error fetching travis status: $@"; return; }
 
     $dist->{travis_status} = $self->_get_travis_status( @builds );

lib/ModulesPerl6/DbBuilder/Dist/Source.pm

@@ -175,15 +175,8 @@ sub _save_logo {
 
 sub _get_author {
     my ( $self, $dist ) = @_;
-    my $author = $dist->{author} // $dist->{authors};
+    my $author = $dist->{author} // $dist->{authors} // 'N/A';
     $author = $author->[0] if ref $author eq 'ARRAY';
-    unless ($author) {
-        # assume the github user/org name as the author,
-        # but note the lack of proper authorship as a problem
-        ($author) = $dist->{url} =~ m{github\.com/([^/]+)/};
-        $dist->{_builder}{no_author_set} = 1;
-    }
-
     return $author;
 }
 

lib/ModulesPerl6/DbBuilder/Dist/Source/GitHub.pm

@@ -82,17 +82,10 @@ sub load {
     } // 0;
 
     # no new commits and we have cached results that will do just fine
-    if ( $dist->{date_updated} eq $date_updated and not $ENV{FULL_REBUILD} ) {
-        $dist->{_builder}{has_travis} = 1 # reinstate cached travis status
-            unless $dist->{travis_status} eq 'not set up';
+    return $dist
+        if $dist->{date_updated} eq $date_updated and not $ENV{FULL_REBUILD};
 
-        $dist->{_builder}{has_appveyor} = 1 # reinstate cached appveyor status
-            unless $dist->{appveyor_status} eq 'not set up';
-
-        return $dist;
-    }
     $dist->{date_updated} = $date_updated;
-
     log info => 'Dist has new commits. Fetching more info.';
     $dist->{_builder}{is_fresh} = 1;
 
@@ -106,27 +99,10 @@ sub load {
         map $_->{size}, grep $_->{path} eq 'logotype/logo_32x32.png', @$tree
     );
 
-    # if you add {_builder} stuff, ensure it still maintains correct stuff when dist has
-    # no new commits and we bail out of this routine early.
-    # (see conditional a dozen of lines above that `reinstates` travis status for example)
-    $dist->{_builder}{has_appveyor}
-    = grep $_->{path} =~ /\A \.? appveyor\.yml \z/x, @$tree;
-
-    $dist->{_builder}{has_travis} = grep $_->{path} eq '.travis.yml', @$tree;
-    $dist->{_builder}{has_manifest} = grep $_->{path} eq 'MANIFEST', @$tree;
-    my ($readme) = grep { $_->{path} =~ /^README/ } @$tree;
-    if ($readme) {
-        my $repo_root = $self->_meta_url =~ s{[^/]+$}{}r;
-        my $tx = $self->_ua->get("$repo_root/$readme->{path}");
-        if ($tx->success) {
-            my $contents = $tx->res->body;
-            if ($contents =~ /panda|ufo/) {
-                $dist->{_builder}{mentions_old_tools} = 1;
-            }
-        }
-    } else {
-        $dist->{_builder}{has_no_readme} = 1;
-    }
+    $dist->{_builder}{files} = [
+        map +{ url => $_->{url}, name => $_->{path} },
+            grep $_->{type} eq 'blob', @$tree
+    ];
 
     return $dist;
 }