env perl finds the right perl :)

[gitmo/moose-dev-utils.git] / cpan-stable-smolder

#!/usr/bin/env perl

use strict;
use warnings;
use CPAN;
use Cwd;
use File::chdir;
use File::Path qw( rmtree );
use IPC::Run3 qw( run3 );


CPAN::HandleConfig->load();
CPAN::Shell::setup_output();
CPAN::Index->reload();

local $CPAN::Config->{tar_verbosity} = 'none';
local $CPAN::Config->{load_module_verbosity} = 'none';


my $LOGFILE = ( cwd . "/cpan-stable-smolder.log" );

if ( -f $LOGFILE ) {
    unlink $LOGFILE;
}

open my $log, '>', $LOGFILE || die "Could not open $LOGFILE because $!";

test_all_modules(
    qw[
        Moose::Autobox
        MooseX::Accessors::ReadWritePrivate
        MooseX::App::Cmd
        MooseX::Async
        MooseX::Attribute::ENV
        MooseX::AttributeHelpers
        MooseX::Attribute::Prototype
        MooseX::Attributes::Curried
        MooseX::Blessed::Reconstruct
        MooseX::ClassAttribute
        MooseX::Clone
        MooseX::ConfigFromFile
        MooseX::Constructor::AllErrors
        MooseX::Contract
        MooseX::Control
        MooseX::CurriedHandles
        MooseX::Daemonize
        MooseX::Declare
        MooseX::DeepAccessors
        MooseX::DOM
        MooseX::Emulate::Class::Accessor::Fast
        MooseX::FollowPBP
        MooseX::Getopt
        MooseX::GlobRef::Object
        MooseX::InsideOut
        MooseX::Iterator
        MooseX::KeyedMutex
        MooseX::LazyLogDispatch
        MooseX::LogDispatch
        MooseX::Log::Log4perl
        MooseX::MakeImmutable
        MooseX::Meta::TypeConstraint::ForceCoercion
        MooseX::MetaDescription
        MooseX::MethodAttributes
        MooseX::Method::Signatures
        MooseX::MultiInitArg
        MooseX::MultiMethods
        MooseX::MutatorAttributes
        MooseX::NaturalKey
        MooseX::NonMoose
        MooseX::Object::Pluggable
        MooseX::Param
        MooseX::Params::Validate
        MooseX::Plaggerize
        MooseX::POE
        MooseX::Policy::SemiAffordanceAccessor
        MooseX::Q4MLog
        MooseX::Role::Cmd
        MooseX::Role::Matcher
        MooseX::Role::Parameterized
        MooseX::Role::TraitConstructor
        MooseX::Role::XMLRPC::Client
        MooseX::Scaffold
        MooseX::SemiAffordanceAccessor
        MooseX::SimpleConfig
        MooseX::Singleton
        MooseX::Storage
        MooseX::Storage::Format::XML::Simple
        MooseX::StrictConstructor
        MooseX::Struct
        MooseX::Templated
        MooseX::Timestamp
        MooseX::Traits
        MooseX::Traits::Attribute::CascadeClear
        MooseX::Types
        MooseX::Types::Authen::Passphrase
        MooseX::Types::Common
        MooseX::Types::Data::GUID
        MooseX::Types::DateTime
        MooseX::Types::IO
        MooseX::Types::Path::Class
        MooseX::Types::Set::Object
        MooseX::Types::Structured
        MooseX::Types::URI
        MooseX::Types::UUID
        MooseX::Types::VariantTable
        MooseX::WithCache
        MooseX::Workers
        MooseX::YAML
        Fey::ORM
        KiokuDB
        Catalyst
        ]
);

close $log;

exit;

sub test_all_modules {
    my @statuses;
    my @details;

    foreach my $project (@_) {
        my $dist = get_distro_from_cpan($project);

        unless ($dist) {
            print {$log} "UNKNOWN : $project (not on CPAN?)\n";
            next;
        }

        my ( $passed, $warned, $output ) = test_module( $dist->dir() );

        my $status = $passed && $warned ? 'WARN' : $passed ? 'PASS' : 'FAIL';

        push @statuses, "$status: $project - " . $dist->base_id();

        push @details, [ $project, $output ]
            if $warned || ! $passed;
    }

    for my $status (@statuses) {
        print {$log} "$status\n";
    }

    if (@details) {
        print {$log} "\n\n";

        for my $detail (@details) {
            print {$log} q{-} x 50;
            print {$log} "\n";
            print {$log} "$detail->[0]\n\n";
            print {$log} "$detail->[1]\n\n";
        }
    }
}

sub get_distro_from_cpan {
    my $project = shift;

    ( my $module = $project ) =~ s/-/::/g;

    my @mods = CPAN::Shell->expand( 'Module', $module );

    die "Cannot resolve $project to a single module object"
        if @mods > 1;

    return unless @mods;

    my $dist = $mods[0]->distribution();

    $dist->get();

    return $dist;
}

sub test_module {
    my $dir = shift;

    local $CWD = $dir;

    local $ENV{PERL_AUTOINSTALL} = '--defaultdeps';
    if ( -f "Build.PL" ) {
        return
            unless _run_commands(
            [ $^X, 'Build.PL' ],
            ['./Build'],
            );
    }
    else {
        return
            unless _run_commands(
            [ $^X, 'Makefile.PL' ],
            ['make'],
            );
    }

    return _run_tests();
}

sub _run_commands {
    for my $cmd (@_) {
        my $output;

        unless ( run3 $cmd, \undef, \$output, \$output ) {
            warn "Failed to run @{$cmd}\n";
            return ( 0, $output );
        }
    }

    return 1;
}

sub _run_tests {
    my $output;

    run3 [ qw( prove -b ) ], undef, \$output, \$output;

    my $passed = $output =~ /Result: PASS/;
    my $warned = $output =~ /at .+ line \d+/;

    return ( $passed, $warned, $output );
}