File Coverage

bin/report-prereqs

Criterion	Covered	Total	%
statement	111	112	99.1
branch	34	36	94.4
condition	7	9	77.7
subroutine	13	13	100.0
pod			n/a
total	165	170	97.0

#!perl

use 5.006;
use strict;
use warnings;

our $VERSION = '0.005';

package App::ReportPrereqs;

use ExtUtils::MakeMaker ();
use File::Basename qw(fileparse);
use Getopt::Long qw(GetOptions);
use HTTP::Tiny 0.014 ();
use List::Util qw(max);
use Module::CPANfile ();
use Module::Path qw(module_path);
use version 0.77 ();

if ( !caller ) {
    my $rc = _main();
    exit 0 if !defined $rc;
    exit 2 if $rc == 2;
    exit 1;
}

sub _main {
    my $with_develop = 0;
    my @features;
    return _usage() if !GetOptions( 'with-develop' => \$with_develop, 'with-feature=s@' => \@features );

    my $cpanfile     = 'cpanfile';
    my $cpanfile_src = $cpanfile;

    if ( @ARGV == 1 ) {
        $cpanfile_src = $ARGV[0];

        my $res = HTTP::Tiny->new->get($cpanfile_src);
        if ( !$res->{success} ) {
            print {*STDERR} $res->{content};
            return 1;
        }

        $cpanfile = \$res->{content};
    }
    elsif (@ARGV) {
        return _usage();
    }

    my $prereqs;
    if ( !eval { $prereqs = Module::CPANfile->load($cpanfile)->prereqs_with(@features); 1; } ) {
        my $error = $@;
        print {*STDERR} "\n$error\n";
        return 1;
    }

    my @full_reports;
    my @dep_errors;

  PHASE:
    for my $phase (qw(configure build test runtime develop)) {
        next PHASE if ( $phase eq 'develop' ) and ( !$with_develop );

      TYPE:
        for my $type (qw(requires recommends suggests conflicts)) {
            my $req_ref = $prereqs->requirements_for( $phase, $type )->as_string_hash;
            my @modules = grep { $_ ne 'perl' } keys %{$req_ref};
            next TYPE if !@modules;

            my $title   = "\u$phase \u$type";
            my @reports = ( [qw(Module Want Have)] );

          MODULE:
            for my $module ( sort @modules ) {
                my $want = $req_ref->{$module};
                if ( !defined $want ) {
                    $want = 'undef';
                }
                elsif ( $want eq '0' ) {
                    $want = 'any';
                }

                my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";

                my $mod_path = module_path($module);

                if ( defined $mod_path ) {
                    my $have = MM->parse_version($mod_path);    ## no critic (Modules::RequireExplicitInclusion)

                    # This validation was added in EUMM 7.47_01 in ExtUtils::MM_Unix
                    # We use the same validation to make the file testable - otherwise the
                    # result depends on the version of EUMM used.
                    if (   ( !defined $have )
                        or ( $have !~ m{ ^ v? [0-9_\.\-]+ $ }xsm )
                        or ( !eval { version->parse($have) } ) )
                    {
                        $have = 'undef';
                    }

                    push @reports, [ $module, $want, $have ];

                    next MODULE if $type ne 'requires';

                    if ( $have eq 'undef' ) {
                        push @dep_errors, "$module version unknown ($req_string)";
                        next MODULE;
                    }

                    if ( !$prereqs->requirements_for( $phase, $type )->accepts_module( $module => $have ) ) {
                        push @dep_errors, "$module version '$have' is not in required range '$want'";
                        next MODULE;
                    }

                    next MODULE;
                }

                push @reports, [ $module, $want, 'missing' ];

                next MODULE if $type ne 'requires';

                push @dep_errors, "$module is not installed ($req_string)";
            }

            push @full_reports, "=== $title ===\n\n";

            my $ml = max( map { length $_->[0] } @reports );
            my $wl = max( map { length $_->[1] } @reports );
            my $hl = max( map { length $_->[2] } @reports );

            splice @reports, 1, 0, [ q{-} x $ml, q{-} x $wl, q{-} x $hl ];
            push @full_reports, map { sprintf "    %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2] } @reports;

            push @full_reports, "\n";
        }
    }

    if (@full_reports) {
        print "Versions for all modules listed in $cpanfile_src:\n\n", @full_reports;
    }

    if (@dep_errors) {
        print "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n\n";
        print "The following REQUIRED prerequisites were not satisfied:\n\n";

        for my $error (@dep_errors) {
            print $error, "\n";
        }
    }

    return;
}

sub _usage {
    my $basename = fileparse($0);

    print {*STDERR} "usage: $basename [--with-{develop,feature=id}] [URL]\n";
    return 2;
}

1;

__END__