i am unlikely to ever use this again

1 files changed, 0 insertions, 713 deletions

diff --git a/bin/lint-dist b/bin/lint-dist
deleted file mode 100755
index 8516093..0000000
--- a/bin/lint-dist
+++ /dev/null
@@ -1,713 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use 5.016;
-
-use Archive::Tar;
-use Getopt::Long;
-use HTTP::Tiny;
-use JSON;
-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 {
-            my $main_module = 'lib/' . ($_[0]->name =~ s/-/\//gr) . '.pm';
-            $_[0]->read_file($main_module) =~ m{rt\.cpan\.org/NoAuth/ReportBug};
-        },
-        "module docs link to rt.cpan"
-    ],
-    [
-        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 { !$_[0]->meta->{resources}{homepage} },
-        "no homepage set"
-    ],
-    [
-        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]"
-    ],
-    [
-        sub { $_[0]->has_file('dist.ini') },
-        sub {
-            return if $_[0]->name eq 'Dist-Zilla-PluginBundle-DOY';
-            require Config::INI::Reader;
-            my $contents = Config::INI::Reader->read_string(
-                $_[0]->read_file('dist.ini')
-            );
-            !exists $contents->{'@DOY'}
-            || !exists $contents->{'@DOY'}{':version'}
-            || $contents->{'@DOY'}{':version'} < 0.14;
-        },
-        "not using the latest version of \@DOY"
-    ],
-    [
-        sub { 1 },
-        sub {
-            grep { $_->get_content =~ m{\A\#!/usr/bin/env perl} }
-                 grep { $_->has_content && $_->name !~ /\.t$/ }
-                      $_[0]->tar->get_files
-        },
-        "using #!/usr/bin/env perl"
-    ],
-    [
-        sub { 1 },
-        sub {
-            grep { $_->get_content =~ m{use_ok} }
-                 grep { $_->has_content && $_->name =~ /\.t$/ }
-                      $_[0]->tar->get_files
-        },
-        "uses use_ok"
-    ],
-    [
-        sub { 1 },
-        sub {
-            my %allowed = map { $_ => 1 } qw(
-                00-compile.t
-            );
-            grep { /\/\d+.*\.t$/ }
-                 grep { !$allowed{s/.*\///r} }
-                      $_[0]->tar->list_files
-        },
-        "has tests with numbers"
-    ],
-    [
-        sub { 1 },
-        sub {
-            grep { $_->get_content =~ /\$ENV{RELEASE_TESTING}/ }
-                 grep { $_->has_content && $_->full_path =~ /\/t\/.*\.t$/ }
-                      $_[0]->tar->get_files
-        },
-        "has release tests in t/"
-    ],
-    [
-        sub { 1 },
-        sub { !$_[0]->has_file('Changes') },
-        "no Changes file"
-    ],
-    [
-        sub { $_[0]->has_file('Changes') },
-        sub {
-            my $dist = $_[0]->name;
-            $_[0]->read_file('Changes') !~ /\ARevision history for $dist$/m
-        },
-        "changelog has incorrect header"
-    ],
-    [
-        sub { $_[0]->has_file('Changes') },
-        sub {
-            require CPAN::Changes;
-            require version;
-
-            my $changes = eval {
-                CPAN::Changes->load_string($_[0]->read_file('Changes'))
-            };
-
-            return "Couldn't parse file" unless $changes;
-            return "No releases"         unless @{[$changes->releases]};
-
-            return "Invalid date format" if grep {
-                ($_->date // '') eq ''
-            } $changes->releases;
-            return "Invalid version format" if grep {
-                !version::is_lax($_->version =~ s/-TRIAL$//r)
-            } $changes->releases;
-            return "No entry for the current version" if !grep {
-                $_->version =~ s/-TRIAL$//r eq $_[0]->version
-            } $changes->releases;
-
-            return;
-        },
-        sub { "changelog doesn't follow the CPAN::Changes format: $_[1]" }
-    ],
-    [
-        sub { 1 },
-        sub {
-            my $kwalitee = $_[0]->get_json(
-                'http://cpants.cpanauthors.org/dist/' . $_[0]->name . '.json'
-            );
-            return ['Most recent dist has not yet been processed.']
-                if $kwalitee->{recent}[0]{distv} ne $_[0]->distvname;
-
-            # - use_strict and use_warnings don't notice Moose::Exporter, or
-            #   things that use Moose::Exporter, so they will give a lot of
-            #   false positives
-            # - is_prereq isn't something i can control
-            # - metayml_declares_perl_version i just don't care about
-            my %ignored = map { $_ => 1 } qw(
-                use_strict
-                use_warnings
-                is_prereq
-                metayml_declares_perl_version
-            );
-            my @res = grep { defined }
-                      map  { $_->{error} }
-                      grep { !$ignored{$_->{key}} }
-                      map  { @$_ }
-                      @{ $kwalitee->{kwalitee} };
-            return unless @res;
-            return \@res;
-        },
-        sub { map { "Kwalitee: $_" } @{ $_[1] } }
-    ],
-    [
-        sub { 1 },
-        sub {
-            state $rt_data //= $_[0]->get_json(
-                'https://rt.cpan.org/Public/bugs-per-dist.json'
-            );
-            return $rt_data->{$_[0]->name}{counts}{active}
-
-        },
-        sub { "has $_[1] bug(s) on rt.cpan.org" }
-    ],
-    [
-        sub { $_[0]->repository && $_[0]->repository =~ m{/github\.com/} },
-        sub { !$_[0]->has_github_data },
-        "github repository doesn't exist"
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub { !$_[0]->github_data->{has_issues} },
-        "github issues is not enabled"
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub { $_[0]->github_data->{open_issues_count} },
-        sub { "has $_[1] bug(s) on github issues" }
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub {
-            my $abstract = $_[0]->meta->{abstract} // '';
-            my $description = $_[0]->github_data->{description} // '';
-            $description ne $abstract;
-        },
-        sub { "github description doesn't match abstract" }
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub {
-            my $meta_site = $_[0]->meta->{resources}{homepage} // '';
-            my $gh_site = $_[0]->github_data->{homepage} // '';
-            $meta_site ne $gh_site;
-        },
-        sub { "github homepage doesn't match meta homepage" }
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub { !$_[0]->repo_has_file('.gitignore') },
-        sub { "repository doesn't contain .gitignore" }
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub { !$_[0]->repo_has_file('.travis.yml') },
-        sub { "repository doesn't contain .travis.yml" }
-    ],
-    [
-        sub { $_[0]->has_github_data && $_[0]->repo_has_file('.travis.yml') },
-        sub {
-            my $travis = $_[0]->repo_read_file('.travis.yml');
-            grep { /cpanm/ && !/build\.log/ } split /\n/, $travis;
-        },
-        sub { "travis.yml doesn't display build.log on failures" }
-    ],
-    [
-        sub { $_[0]->has_github_data },
-        sub {
-            my $gh = $_[0]->github_data;
-            my $tags = $_[0]->get_json($gh->{tags_url});
-            my $commit = $_[0]->get_json(
-                $gh->{commits_url} =~ s!{/sha}!/$gh->{default_branch}!r
-            );
-            !grep { $_->{commit}{sha} eq $commit->{sha} } @$tags
-        },
-        "repository has unreleased changes"
-    ],
-    [
-        sub { $_[0]->has_github_data && $_[0]->repo_has_file('.travis.yml') },
-        sub {
-            my $gh = $_[0]->github_data;
-            # XXX not sure how to get the current status for a specific branch
-            # other than from the status image
-            my $url =
-                "https://travis-ci.org/$gh->{full_name}.png"
-              . "?branch=$gh->{default_branch}";
-            my $res = HTTP::Tiny->new->get($url);
-            die "couldn't get data for $url ($res->{status}): $res->{content}"
-                unless $res->{success};
-
-            require Digest::MD5;
-            Digest::MD5::md5_hex($res->{content}) ne '64f1b7ce47060cdfca7ac94338e92294';
-        },
-        sub { "travis isn't passing" }
-    ],
-);
-
-package Dist::To::Lint {
-    sub new {
-        my $class = shift;
-        my (%args) = @_;
-
-        $args{lint} = [];
-
-        if ($args{minicpan}) {
-            bless { %args }, "Dist::To::Lint::Minicpan";
-        }
-        else {
-            bless { %args }, "Dist::To::Lint::HTTPTiny";
-        }
-    }
-
-    sub dist { shift->{dist} }
-    sub name { shift->dist->dist }
-    sub version { shift->dist->version }
-    sub distvname { shift->dist->distvname }
-    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 repository {
-        my $self = shift;
-        return unless $self->meta;
-        return $self->has_meta_2
-            ? $self->meta->{resources}{repository}{url}
-            : $self->meta->{resources}{repository};
-    }
-
-    # XXX doesn't handle files not in the repo root
-    sub repo_has_file {
-        my $self = shift;
-        my ($file) = @_;
-
-        my $repo_name =
-            $self->repository =~ s{.*://github\.com/(.*?)(?:\.git)?$}{$1}r;
-
-        my $gh_data = $self->github_data;
-
-        my $tree_data = $self->get_json(
-            $gh_data->{trees_url} =~ s!{/sha}!/$gh_data->{default_branch}!r
-        );
-
-        grep { $_->{path} eq $file } @{ $tree_data->{tree} };
-    }
-
-    # XXX doesn't handle files not in the repo root
-    sub repo_read_file {
-        my $self = shift;
-        my ($file) = @_;
-
-        my $repo_name =
-            $self->repository =~ s{.*://github\.com/(.*?)(?:\.git)?$}{$1}r;
-
-        my $gh_data = $self->github_data;
-
-        my $tree_data = $self->get_json(
-            $gh_data->{trees_url} =~ s!{/sha}!/$gh_data->{default_branch}!r
-        );
-
-        my ($url) =
-            map { $_->{url} }
-            grep { $_->{path} eq $file }
-            @{ $tree_data->{tree} };
-        my $data = $self->get_json($url);
-        die "unknown encoding"
-            unless $data->{encoding} eq 'base64';
-
-        require MIME::Base64;
-        return MIME::Base64::decode_base64($data->{content});
-    }
-
-    sub github_data {
-        my $self = shift;
-
-        return unless $self->repository;
-
-        my $repo_name =
-            $self->repository =~ s{.*://github\.com/(.*?)(?:\.git)?$}{$1}r;
-
-        return $self->get_json("https://api.github.com/repos/$repo_name");
-    }
-
-    sub has_github_data {
-        my $self = shift;
-        eval { $self->github_data };
-    }
-
-    sub report {
-        my $self = shift;
-
-        say $self->distvname;
-        say "=====================";
-
-        if ($self->lint) {
-            say for $self->lint;
-        }
-        else {
-            say "No issues found";
-        }
-
-        STDOUT->flush;
-    }
-
-    sub get_json {
-        my $self = shift;
-        my ($url) = @_;
-
-        my $auth_url = $url;
-        if ($url =~ /api\.github\.com/) {
-            state $auth //= $self->github_auth;
-            $auth_url =~ s{://api\.github\.com}{://$auth\@api.github.com};
-        }
-
-        $self->{_json}{$url} //= do {
-            my $res = HTTP::Tiny->new->get($auth_url);
-            die "couldn't get data for $url ($res->{status}): $res->{content}"
-                unless $res->{success};
-            JSON->new->utf8->decode($res->{content});
-        }
-    }
-
-    sub github_auth {
-        my $self = shift;
-
-        return '' unless $self->{github_user};
-
-        $self->{github_pass} //= do {
-            require Term::ReadKey;
-
-            open my $read, '<', '/dev/tty'
-                or die "couldn't get the terminal for reading: $!";
-            open my $write, '>', '/dev/tty'
-                or die "couldn't get the terminal for reading: $!";
-            $write->print("Github API secret: ");
-            $write->flush;
-
-            Term::ReadKey::ReadMode(2);
-            chomp(my $pass = <$read>);
-            Term::ReadKey::ReadMode(0);
-
-            $write->print("\n");
-
-            $pass;
-        };
-
-        return join(':',
-            map { HTTP::Tiny->_uri_escape($self->{$_}) }
-                'github_user', 'github_pass'
-        );
-    }
-}
-
-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;
-
-        my $res = HTTP::Tiny->new->get(
-            'http://cpan.metacpan.org/authors/id/' . $self->dist->pathname
-        );
-        die "Couldn't get distribution tarball"
-            unless $res->{success};
-
-        require File::Temp;
-        my $fh = File::Temp->new;
-        $fh->print($res->{content});
-        $fh->flush;
-        $fh->seek(0, 0);
-        $self->{_tar_fh} = $fh;
-
-        return $fh->filename;
-    }
-}
-
-my ($all, $minicpan, $github_user);
-my $cpanid = uc($ENV{USER});
-GetOptions(
-    'all'           => \$all,
-    'minicpan=s'    => \$minicpan,
-    'cpanid'        => \$cpanid,
-    'github_user=s' => \$github_user,
-) or die;
-
-my @dists = $all
-    ? (get_all_dists_for($cpanid, $minicpan))
-    : (get_info_for_dists(\@ARGV, $minicpan));
-
-for my $dist (@dists) {
-    lint_dist(@$dist, $minicpan, $github_user);
-    say '';
-}
-
-sub get_all_dists_for {
-    my ($cpanid, $minicpan) = @_;
-
-    return map { [ $_, undef ] }
-           sort { fc($a->dist) cmp fc($b->dist) }
-           grep { $_->dist ne 'perl' }
-           grep { $_->cpanid eq $cpanid }
-           _packages($minicpan)->latest_distributions;
-}
-
-sub get_info_for_dists {
-    my ($dists, $minicpan) = @_;
-
-    my $p = _packages($minicpan);
-
-    return map {
-        my $name = (-e) ? get_name_for_tarball($_) : $_;
-        [
-            ($p->latest_distribution($name)
-                || die "Couldn't find $_ in the index"),
-            ((-e) ? $_ : undef)
-        ]
-    } @$dists;
-}
-
-sub get_name_for_tarball {
-    my ($tarball_name) = @_;
-    require CPAN::DistnameInfo;
-    my $d = CPAN::DistnameInfo->new($tarball_name);
-    return $d->dist;
-}
-
-sub _packages {
-    my ($minicpan) = @_;
-
-    my ($packages_file, $packages_fh);
-
-    if ($minicpan) {
-        $packages_file = "$minicpan/modules/02packages.details.txt.gz";
-    }
-    else {
-        my $res = HTTP::Tiny->new->get(
-            'http://cpan.metacpan.org/modules/02packages.details.txt.gz'
-        );
-        die "Couldn't get package file" unless $res->{success};
-
-        require File::Temp;
-        $packages_fh = File::Temp->new;
-        $packages_file = $packages_fh->filename;
-        $packages_fh->print($res->{content});
-        $packages_fh->flush;
-    }
-
-    return Parse::CPAN::Packages::Fast->new($packages_file);
-}
-
-sub lint_dist {
-    my ($dist, $tarball_name, $minicpan, $github_user) = @_;
-
-    my $to_lint = Dist::To::Lint->new(
-        dist         => $dist,
-        tarball_name => $tarball_name,
-        minicpan     => $minicpan,
-        github_user  => $github_user,
-    );
-
-    for my $check (@checks) {
-        next unless $check->[0]->($to_lint);
-        if (my $ret = $check->[1]->($to_lint)) {
-            my @messages = ref($check->[2])
-                ? $check->[2]->($to_lint, $ret)
-                : $check->[2];
-            $to_lint->add_lint($_) for @messages;
-        }
-    }
-
-    $to_lint->report;
-}