current commit
170402.11 · Update DEVELOPERS.md. Change a bunch of ack2s to ack3.
#!/usr/bin/env perl

# This script looks through the list of dependencies in
# @dependencies (see below) and tries to find the minimum
# version of each with which ack3 will run.
#
# This script considers each version in isolation, so
# it won't catch things like "Getopt::Long 10 + File::Spec 5 works,
# Getopt::Long 5 + File::Spec 10 works, but Getopt::Long 5 +
# File::Spec 5 doesn't work".  I figured this would be acceptable,
# and I didn't want the script to work through the exponential number
# of combinations.
#
# This script also assumes that for each dependency, there exists a
# release R for which all releases before R fail, and all releases
# including and after R succeed.  This script is intended as a rough
# estimate tools that delivers minimum module versions higher than
# 0.

use strict;
use warnings;
use feature 'say';

use Capture::Tiny qw(capture_merged);
use File::Spec;
use File::Temp;
use MetaCPAN::API;

# ANSI terminal control codes
my $SAVE         = "\e[s";
my $UNSAVE       = "\e[u";
my $ERASE_TO_END = "\e[K";

sub get_releases {
    my ( $module ) = @_;

    my $mcpan  = MetaCPAN::API->new;
    my $distribution = $mcpan->fetch(
        'module/' . $module,
    )->{'distribution'};

    my $from = 0;
    my $hits;
    my @releases;

    do {
        my $result = $mcpan->post(
            release => {
                query => {
                    term => {
                        'release.distribution' => $distribution,
                    },
                },
                filter => {
                    term => {
                        maturity => 'released',
                    },
                },
                sort => [
                    { version => 'asc' },
                ],
                from   => $from,
                fields => [qw/download_url version/],
            },
        );

        $hits  = $result->{'hits'}{'hits'};
        $from += @$hits;

        if(@$hits) {
            foreach my $hit (@$hits) {
                push @releases, {
                    version => $hit->{'fields'}{'version'},
                    url     => $hit->{'fields'}{'download_url'},
                },
            }
        }
    } while(@$hits);

    return @releases;
}

sub bisect (&@) {
    my ( $predicate, @values ) = @_;

    my $low  = 0;
    my $high = @values;
    my $last_good;

    while($low <= $high) {
        my $middle = $low + int(($high - $low) / 2);
        local $_ = $values[$middle];
        my $result = $predicate->($_);

        if ($result) {
            $last_good = $_;
            $high = $middle - 1;
        }
        else {
            $low = $middle + 1;
        }
    }

    return $last_good;
}

my @dependencies = (
    'Carp',
    'Cwd',
    'File::Basename',
    'File::Next',
    'File::Spec',
    'File::Temp',
    'Getopt::Long',
    'Pod::Usage',
    'Term::ANSIColor',
    'Test::Harness',
    'Test::More',
    'Text::ParseWords',
);

my @output;

local $| = 1;
foreach my $dep (@dependencies) {
    print "Testing $dep... $SAVE";

    my @releases = get_releases($dep);
    my $first_good_release = bisect {
        print "$UNSAVE$ERASE_TO_END$_->{'version'}";
        my $tempdir = File::Temp->newdir;
        my $status;
        capture_merged {
            $status = system 'cpanm', '--notest', '--local-lib', $tempdir->dirname, $_->{'url'};
            return if $status;

            local $ENV{'PERL5LIB'} = File::Spec->catdir($tempdir->dirname, 'lib/perl5');

            $status = system 'make', 'test';
        };

        $status == 0
    } @releases;

    print "\n";
    if (!defined $first_good_release) {
        push @output, "$dep - no suitable version found";
    }
    elsif ($first_good_release == $releases[0]) {
        # All tested versions are ok. Earlier, untested versions might also work
        push @output, "$dep - <=$first_good_release->{'version'}";
    }
    else {
        push @output, "$dep - $first_good_release->{'version'}";
    }
    print "$output[-1]\n";
}

print "\n";
say foreach @output;