refactor this a bunch

1 files changed, 280 insertions, 142 deletions

diff --git a/bin/lint-dist b/bin/lint-dist
index a3fbffd..f006ca9 100755
--- a/bin/lint-dist
+++ b/bin/lint-dist
@@ -8,6 +8,279 @@ use Getopt::Long;
 use Parse::CPAN::Meta;
 use Parse::CPAN::Packages::Fast;
 
+my @checks = (
+    [
+        sub { 1 },
+        sub { !$_[0]->has_file('META.json') },
+        "No META.json file found, using META.yml"
+    ],
+    [
+        sub { 1 },
+        sub { !!grep { $_[0]->has_file($_) } qw(MYMETA.yml MYMETA.json) },
+        "MYMETA found in dist"
+    ],
+    [
+        sub { 1 },
+        sub {
+            my $main_module = 'lib/' . ($_[0]->name =~ s/-/\//gr) . '.pm';
+            $_[0]->read_file($main_module) =~ /search\.cpan\.org/;
+        },
+        "module docs link to s.c.o"
+    ],
+    [
+        sub { 1 },
+        sub { !$_[0]->has_meta_2 },
+        "not using META spec version 2"
+    ],
+    [
+        sub { $_[0]->has_meta_2 },
+        sub { !grep { $_ eq 'mit' } @{ $_[0]->meta->{license} } },
+        "not using the MIT license"
+    ],
+    [
+        sub { $_[0]->meta && !$_[0]->has_meta_2 },
+        sub { $_[0]->meta->{license} ne 'mit' },
+        "not using the MIT license"
+    ],
+    [
+        sub { $_[0]->has_meta_2 },
+        sub {
+            ($_[0]->meta->{resources}{bugtracker}{web} // '') !~ /github\.com/
+        },
+        "not using github issues"
+    ],
+    [
+        sub { $_[0]->meta && !$_[0]->has_meta_2 },
+        sub {
+            ($_[0]->meta->{resources}{bugtracker} // '') !~ /github\.com/
+        },
+        "not using github issues"
+    ],
+    [
+        sub { $_[0]->has_meta_2 },
+        sub {
+            ($_[0]->meta->{resources}{repository}{url} // '') !~ /github\.com/
+        },
+        "repository not on github"
+    ],
+    [
+        sub { $_[0]->meta && !$_[0]->has_meta_2 },
+        sub {
+            ($_[0]->meta->{resources}{repository} // '') !~ /github\.com/
+        },
+        "repository not on github"
+    ],
+    [
+        sub { $_[0]->has_meta_2 },
+        sub {
+            my $url = ($_[0]->meta->{resources}{repository}{url} // '');
+            my $dist_name = $_[0]->name;
+            $url !~ /\/\L$dist_name\.git$/;
+        },
+        "repository named incorrectly"
+    ],
+    [
+        sub { $_[0]->meta && !$_[0]->has_meta_2 },
+        sub {
+            my $url = ($_[0]->meta->{resources}{repository} // '');
+            my $dist_name = $_[0]->name;
+            $url !~ /\/\L$dist_name\.git$/;
+        },
+        "repository named incorrectly"
+    ],
+    [
+        sub { $_[0]->meta },
+        sub {
+            my ($author) = grep { /Jesse Luehrs/ } @{ $_[0]->meta->{author} };
+            $author && $author !~ /<doy\@tozt\.net>/
+        },
+        "using the wrong email address"
+    ],
+    [
+        sub { $_[0]->meta },
+        sub { !$_[0]->meta->{x_authority} },
+        "no AUTHORITY info set"
+    ],
+    [
+        sub { $_[0]->meta },
+        sub { $_[0]->meta->{generated_by} !~ /Dist::Zilla/ },
+        "not using Dist::Zilla"
+    ],
+    [
+        sub { $_[0]->meta && $_[0]->meta->{generated_by} =~ /Dist::Zilla/ },
+        sub {
+            $_[0]->meta->{generated_by} !~
+                /Dist::Zilla version .*, CPAN::Meta::Converter version .*/
+        },
+        "using ancient Dist::Zilla"
+    ],
+    [
+        sub { 1 },
+        sub { $_[0]->has_file('weaver.ini') },
+        "still using weaver.ini"
+    ],
+    [
+        sub { $_[0]->meta && $_[0]->meta->{x_Dist_Zilla} },
+        sub {
+            !grep { $_->{class} eq 'Dist::Zilla::Plugin::AutoPrereqs' }
+                  @{ $_[0]->meta->{x_Dist_Zilla}{plugins} }
+        },
+        "not using [AutoPrereqs]"
+    ],
+    [
+        sub { $_[0]->meta && $_[0]->meta->{x_Dist_Zilla} },
+        sub {
+            !grep { $_->{class} eq 'Dist::Zilla::Plugin::ContributorsFromGit' }
+                  @{ $_[0]->meta->{x_Dist_Zilla}{plugins} }
+        },
+        "not using [ContributorsFromGit]"
+    ],
+
+    # TODO:
+    # using @DOY? probably have to parse dist.ini to detect this
+    # github description
+    # number of github issues
+    # number of rt.cpan tickets
+    # kwalitee score
+    # .travis.yml and .gitignore in the repository
+    # travis configuration should show build.log on cpanm errors
+    # tests should not have test numbers
+    # scripts shouldn't use #!/usr/bin/env perl
+);
+
+package Dist::To::Lint {
+    sub new {
+        my $class = shift;
+        my ($dist, $minicpan) = @_;
+
+        my %args = (
+            dist => $dist,
+            lint => [],
+        );
+
+        if ($minicpan) {
+            bless { %args, minicpan => $minicpan }, "Dist::To::Lint::Minicpan";
+        }
+        else {
+            bless { %args }, "Dist::To::Lint::HTTPTiny";
+        }
+    }
+
+    sub dist { shift->{dist} }
+    sub name { shift->dist->dist }
+    sub lint { @{ shift->{lint} } }
+    sub add_lint {
+        my $self = shift;
+        push @{ $self->{lint} }, @_;
+    }
+
+    sub tarball_name {
+        my $self = shift;
+
+        die "tarball_name must be implemented in a subclass";
+    }
+
+    sub tar {
+        my $self = shift;
+
+        $self->{tar} //= Archive::Tar->new($self->tarball_name);
+    }
+
+    sub directory {
+        my $self = shift;
+        $self->{directory} //= ($self->tar->list_files)[0] =~ s/\/.*//r;
+    }
+
+    sub has_file {
+        my $self = shift;
+        $self->tar->contains_file(join('/', $self->directory, $_[0]));
+    }
+
+    sub read_file {
+        my $self = shift;
+        $self->tar->get_content(join('/', $self->directory, $_[0]));
+    }
+
+    sub meta {
+        my $self = shift;
+        $self->{meta} //= do {
+            if ($self->has_file('META.json')) {
+                Parse::CPAN::Meta->load_json_string(
+                    $self->read_file('META.json')
+                );
+            }
+            elsif ($self->has_file('META.yml')) {
+                Parse::CPAN::Meta->load_yaml_string(
+                    $self->read_file('META.yml')
+                );
+            }
+            else {
+                undef
+            }
+        };
+    }
+
+    sub has_meta_2 {
+        my $self = shift;
+        $self->meta && ($self->meta->{'meta-spec'}{version} // 0) >= 2
+    }
+
+    sub report {
+        my $self = shift;
+
+        say $self->name;
+        say "=====================";
+
+        if ($self->lint) {
+            say for $self->lint;
+        }
+        else {
+            say "No issues found";
+        }
+    }
+}
+
+package Dist::To::Lint::Minicpan {
+    our @ISA = ('Dist::To::Lint');
+
+    sub minicpan { shift->{minicpan} }
+
+    sub tarball_name {
+        my $self = shift;
+        $self->{tarball_name} //=
+            $self->minicpan . "/authors/id/" . $self->dist->pathname
+    }
+}
+
+package Dist::To::Lint::HTTPTiny {
+    our @ISA = ('Dist::To::Lint');
+
+    sub tarball_name {
+        my $self = shift;
+        $self->{tarball_name} //= $self->_fetch_tarball;
+    }
+
+    sub _fetch_tarball {
+        my $self = shift;
+
+        require HTTP::Tiny;
+
+        my $res = HTTP::Tiny->new->get(
+            'http://cpan.metacpan.org/authors/id/' . $self->dist->pathname
+        );
+        die "Couldn't get distribution tarball"
+            unless $res->{status} == 200;
+
+        require File::Temp;
+        my $fh = File::Temp->new;
+        $fh->print($res->{content});
+        $fh->seek(0, 0);
+        $self->{_tar_fh} = $fh;
+
+        return $fh->filename;
+    }
+}
+
 my ($all, $minicpan);
 my $cpanid = uc($ENV{USER});
 GetOptions(
@@ -22,6 +295,7 @@ my @dists = $all
 
 for my $dist (@dists) {
     lint_dist($dist, $minicpan);
+    say '';
 }
 
 sub get_all_dists_for {
@@ -71,150 +345,14 @@ sub _packages {
 sub lint_dist {
     my ($dist, $minicpan) = @_;
 
-    say $dist->dist;
-    say "===============";
+    my $to_lint = Dist::To::Lint->new($dist, $minicpan);
 
-    my @lint;
-
-    my $dist_tarball = find_dist_tarball($dist);
-
-    my $tar = Archive::Tar->new($dist_tarball);
-    my $directory = ($tar->list_files)[0] =~ s/\/.*//r;
-    my $has_file  = sub { $tar->contains_file("$directory/$_[0]") };
-    my $read_file = sub { $tar->get_content("$directory/$_[0]")   };
-
-    my $meta;
-    if ($has_file->('META.json')) {
-        $meta = Parse::CPAN::Meta->load_json_string(
-            $read_file->('META.json')
-        );
-    }
-    elsif ($has_file->('META.yml')) {
-        push @lint, "No META.json file found, using META.yml";
-        $meta = Parse::CPAN::Meta->load_yaml_string(
-            $read_file->('META.yml')
-        );
-    }
-
-    if (grep { $has_file->($_) } ('MYMETA.yml', 'MYMETA.json')) {
-        push @lint, "MYMETA found in dist";
-    }
-
-    if ($meta) {
-        my $spec_version = $meta->{'meta-spec'}{version};
-        if ($spec_version && $spec_version >= 2) {
-            if (!grep { $_ eq 'mit' } @{ $meta->{license} }) {
-                push @lint, "not using the MIT license";
-            }
-
-            if (my $bugtracker = $meta->{resources}{bugtracker}{web}) {
-                if ($bugtracker && $bugtracker !~ /github\.com/) {
-                    push @lint, "not using github issues";
-                }
-            }
-
-            if (my $repo = $meta->{resources}{repository}{url}) {
-                if ($repo !~ /github\.com/) {
-                    push @lint, "repository not on github";
-                }
-                elsif ($repo !~ /\/\L$meta->{name}\.git$/) {
-                    push @lint, "repository named incorrectly";
-                }
-            }
-        }
-        else {
-            push @lint, "not using META spec version 2";
-
-            if ($meta->{license} ne 'mit') {
-                push @lint, "not using the MIT license";
-            }
-
-            if (my $bugtracker = $meta->{resources}{bugtracker}) {
-                if ($bugtracker !~ /github\.com/) {
-                    push @lint, "not using github issues";
-                }
-            }
-
-            if (my $repo = $meta->{resources}{repository}) {
-                if ($repo !~ /github\.com/) {
-                    push @lint, "repository not on github";
-                }
-                elsif ($repo !~ /\/\L$meta->{name}\.git$/) {
-                    push @lint, "repository named incorrectly";
-                }
-            }
-        }
-
-        if ($meta->{generated_by} !~ /Dist::Zilla/) {
-            push @lint, "not using Dist::Zilla";
-        }
-        else {
-            if ($meta->{generated_by} !~ /Dist::Zilla version .*, CPAN::Meta::Converter version .*/) {
-                push @lint, "using ancient Dist::Zilla";
-            }
-
-            if ($has_file->('weaver.ini')) {
-                push @lint, "still using weaver.ini";
-            }
-
-            if (!grep { $_->{class} eq 'Dist::Zilla::Plugin::AutoPrereqs' } @{ $meta->{x_Dist_Zilla}{plugins} }) {
-                push @lint, "not using [AutoPrereqs]";
-            }
-
-            if (!grep { $_->{class} eq 'Dist::Zilla::Plugin::ContributorsFromGit' } @{ $meta->{x_Dist_Zilla}{plugins} }) {
-                push @lint, "not using [ContributorsFromGit]";
-            }
-        }
-
-        my ($author) = grep { /Jesse Luehrs/ } @{ $meta->{author} };
-        if ($author && $author !~ /<doy\@tozt\.net>/) {
-            push @lint, "using the wrong email address";
-        }
-
-        if (!$meta->{x_authority}) {
-            push @lint, "no AUTHORITY info set";
+    for my $check (@checks) {
+        next unless $check->[0]->($to_lint);
+        if ($check->[1]->($to_lint)) {
+            $to_lint->add_lint($check->[2]);
         }
     }
 
-    my $main_module = 'lib/' . ($dist->dist =~ s/-/\//gr) . '.pm';
-    if ($read_file->($main_module) =~ /search\.cpan\.org/) {
-        push @lint, "module docs link to s.c.o";
-    }
-
-    # TODO:
-    # using @DOY? probably have to parse dist.ini to detect this
-    # github description
-    # number of github issues
-    # number of rt.cpan tickets
-    # kwalitee score
-    # .travis.yml and .gitignore in the repository
-
-    push @lint, 'No issues found'
-        if !@lint;
-
-    say for @lint, '';
-
-    unlink $dist_tarball if !$minicpan;
-}
-
-sub find_dist_tarball {
-    my ($dist) = @_;
-
-    if ($minicpan) {
-        return "$minicpan/authors/id/" . $dist->pathname
-    }
-    else {
-        require HTTP::Tiny;
-        my $res = HTTP::Tiny->new->get(
-            'http://cpan.metacpan.org/authors/id/' . $dist->pathname
-        );
-        die "Couldn't get distribution tarball" unless $res->{status} == 200;
-
-        require File::Temp;
-        my $fh = File::Temp->new(UNLINK => 0);
-        $fh->print($res->{content});
-        $fh->seek(0, 0);
-
-        return $fh->filename;
-    }
+    $to_lint->report;
 }