cpan-stable-smolder

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use CPAN;
   6 use Cwd;
   7 use File::chdir;
   8 use File::Path qw( rmtree );
   9 use IPC::Run3 qw( run3 );
  10
  11
  12 CPAN::HandleConfig->load();
  13 CPAN::Shell::setup_output();
  14 CPAN::Index->reload();
  15
  16 local $CPAN::Config->{tar_verbosity} = 'none';
  17 local $CPAN::Config->{load_module_verbosity} = 'none';
  18
  19
  20 my $LOGFILE = ( cwd . "/cpan-stable-smolder.log" );
  21
  22 if ( -f $LOGFILE ) {
  23     unlink $LOGFILE;
  24 }
  25
  26 open my $log, '>', $LOGFILE || die "Could not open $LOGFILE because $!";
  27
  28 my $MODULE_LIST_FILE = ( cwd . '/cpan-stable-modules' );
  29
  30 my @modules;
  31 {
  32     open my $fh, $MODULE_LIST_FILE or die "Can't open $MODULE_LIST_FILE: $!";
  33     @modules = map { chomp; $_ } <$fh>;
  34 }
  35
  36 test_all_modules(@modules);
  37
  38 close $log;
  39
  40 exit;
  41
  42 sub test_all_modules {
  43     my @statuses;
  44     my @details;
  45
  46     foreach my $project (@_) {
  47         my $dist = get_distro_from_cpan($project);
  48
  49         unless ($dist) {
  50             print {$log} "UNKNOWN : $project (not on CPAN?)\n";
  51             next;
  52         }
  53
  54         my ( $passed, $warned, $output ) = test_module( $dist->dir() );
  55
  56         my $status = $passed && $warned ? 'WARN' : $passed ? 'PASS' : 'FAIL';
  57
  58         push @statuses, "$status: $project - " . $dist->base_id();
  59
  60         push @details, [ $project, $output ]
  61             if $warned || ! $passed;
  62     }
  63
  64     for my $status (@statuses) {
  65         print {$log} "$status\n";
  66     }
  67
  68     if (@details) {
  69         print {$log} "\n\n";
  70
  71         for my $detail (@details) {
  72             print {$log} q{-} x 50;
  73             print {$log} "\n";
  74             print {$log} "$detail->[0]\n\n";
  75             print {$log} "$detail->[1]\n\n";
  76         }
  77     }
  78 }
  79
  80 sub get_distro_from_cpan {
  81     my $project = shift;
  82
  83     ( my $module = $project ) =~ s/-/::/g;
  84
  85     my @mods = CPAN::Shell->expand( 'Module', $module );
  86
  87     die "Cannot resolve $project to a single module object"
  88         if @mods > 1;
  89
  90     return unless @mods;
  91
  92     my $dist = $mods[0]->distribution();
  93
  94     $dist->get();
  95
  96     return $dist;
  97 }
  98
  99 sub test_module {
 100     my $dir = shift;
 101
 102     local $CWD = $dir;
 103
 104     local $ENV{PERL_AUTOINSTALL} = '--defaultdeps';
 105     if ( -f "Build.PL" ) {
 106         return
 107             unless _run_commands(
 108             [ $^X, 'Build.PL' ],
 109             ['./Build'],
 110             );
 111     }
 112     else {
 113         return
 114             unless _run_commands(
 115             [ $^X, 'Makefile.PL' ],
 116             ['make'],
 117             );
 118     }
 119
 120     return _run_tests();
 121 }
 122
 123 sub _run_commands {
 124     for my $cmd (@_) {
 125         my $output;
 126
 127         unless ( run3 $cmd, \undef, \$output, \$output ) {
 128             warn "Failed to run @{$cmd}\n";
 129             return ( 0, $output );
 130         }
 131     }
 132
 133     return 1;
 134 }
 135
 136 sub _run_tests {
 137     my $output;
 138
 139     run3 [ qw( prove -b ) ], undef, \$output, \$output;
 140
 141     my $passed = $output =~ /Result: PASS/;
 142     my $warned = $output =~ /at .+ line \d+/;
 143
 144     return ( $passed, $warned, $output );
 145 }
 146