view release on metacpan or  search on metacpan

lib/App/Prove/Plugin/TraceUse.pm  view on Meta::CPAN

    use List::Util qw/max/;

    use Term::ANSIColor;

    sub _uniquify_dependencies {

        my $self = shift;

        my %d;

        for ( @{ $self->{collected_dependencies} } ) {

            if ( version->new($_->[1]) > version->new($d{ $_->[0] } || 0) ) {
                $d{ $_->[0] } = $_->[1];
            }

        }

        my @d;
        while ( my ($k,$v) = each %d ) {
            push @d, [$k,$v];
        }

        $self->{collected_dependencies} = \@d;

    }

    sub present_dependencies {

        my $self = shift;

        my @d = sort {
            $a->[0] cmp $b->[0]
        } @{ $self->{collected_dependencies} };

        my $n = max( map {length $_->[0]} @d ) + 2;

        print "# TraceUse report:\n";

        if ( not @d ) {
            print "# no noncore dependencies found\n";
            return;
        }

        my $makefile_requirements = App::Prove::Plugin::TraceUse::_parse_makefile_pl();
        my $build_requirements = App::Prove::Plugin::TraceUse::_parse_build_pl();

        my $present_file_dep = sub {
            my ($dep_hash) = @_;

            my $hash_fails = 0;

            for (@d) {

                my($mod,$ver) = @$_;

                my $v = $dep_hash->{$mod};

                if ( not $v ) {
                    print "# ";
                    print colored ['bold red'], sprintf "%-${n}s => '%s',\n", "'".$_->[0]."'", $_->[1];
                    $hash_fails = 1;
                }
                elsif ( $v and qv($v) < qv($ver) ) {
                    print "# ";
                    print colored ['bold yellow'], sprintf "%-${n}s => '%s',\n", "'".$_->[0]."'", $_->[1];
                    $hash_fails = 1;
                }

            }

            if ( not $hash_fails ) {
                print "# - dependencies are ok\n";
            }

            return not $hash_fails;

        };

        my $dependencies_are_good = 1;

        if ( $makefile_requirements ) {

            print "# Makefile.PL:\n";
            my $ok = $present_file_dep->($makefile_requirements);
            $dependencies_are_good &&= $ok;

        }

        if ( $build_requirements ) {

            print "# Build.PL:\n";
            my $ok = $present_file_dep->($build_requirements);
            $dependencies_are_good &&= $ok;

        }

        if ( not $dependencies_are_good and 0 ) {
            print "# List of dependencies found during testing:\n";
            for ( @d ) {
                printf "# %-${n}s => '%s',\n", "'".$_->[0]."'", $_->[1];
            }
        }

    }

    sub new {

        my $self = shift;

        my $tf = File::Temp->new;
        my $fn = "$tf";

        ## add the traceuse option
        $_[0]->{switches} = ["-d:TraceUse=hidecore,output:$fn"];

        my $obj = $self->SUPER::new(@_);

        $obj->{collected_dependencies} = [];

        my $trace_use_sub = sub {

            my $dt = read_file( $fn );
            my $p = App::Prove::Plugin::TraceUse::_parse_traceuse($dt);
            my $deps = App::Prove::Plugin::TraceUse::_find_dependent_modules($p);
            push @{ $obj->{collected_dependencies} }, @$deps;