#!/usr/bin/env perl use strict; use warnings; use CPAN; use Cwd; use File::chdir; 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 $!"; my $MODULE_LIST_FILE = ( cwd . '/cpan-stable-modules' ); my @modules; { open my $fh, $MODULE_LIST_FILE or die "Can't open $MODULE_LIST_FILE: $!"; @modules = map { chomp; $_ } <$fh>; } test_all_modules(@modules); 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'; my $summary = "$status: $project - " . $dist->base_id(); print {$log} "$summary\n"; push @details, [ $project, $output ] if $warned || ! $passed; } 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 -br ) ], undef, \$output, \$output; my $passed = $output =~ /Result: PASS/; my $warned = $output =~ /at .+ line \d+/; return ( $passed, $warned, $output ); }