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 test_all_modules(
  29     qw[
  30         Moose::Autobox
  31         MooseX::Accessors::ReadWritePrivate
  32         MooseX::App::Cmd
  33         MooseX::Async
  34         MooseX::Attribute::ENV
  35         MooseX::AttributeHelpers
  36         MooseX::Attribute::Prototype
  37         MooseX::Attributes::Curried
  38         MooseX::Blessed::Reconstruct
  39         MooseX::ClassAttribute
  40         MooseX::Clone
  41         MooseX::ConfigFromFile
  42         MooseX::Constructor::AllErrors
  43         MooseX::Contract
  44         MooseX::Control
  45         MooseX::CurriedHandles
  46         MooseX::Daemonize
  47         MooseX::Declare
  48         MooseX::DeepAccessors
  49         MooseX::DOM
  50         MooseX::Emulate::Class::Accessor::Fast
  51         MooseX::FollowPBP
  52         MooseX::Getopt
  53         MooseX::GlobRef::Object
  54         MooseX::InsideOut
  55         MooseX::Iterator
  56         MooseX::KeyedMutex
  57         MooseX::LazyLogDispatch
  58         MooseX::LogDispatch
  59         MooseX::Log::Log4perl
  60         MooseX::MakeImmutable
  61         MooseX::Meta::TypeConstraint::ForceCoercion
  62         MooseX::MetaDescription
  63         MooseX::MethodAttributes
  64         MooseX::Method::Signatures
  65         MooseX::MultiInitArg
  66         MooseX::MultiMethods
  67         MooseX::MutatorAttributes
  68         MooseX::NaturalKey
  69         MooseX::NonMoose
  70         MooseX::Object::Pluggable
  71         MooseX::Param
  72         MooseX::Params::Validate
  73         MooseX::Plaggerize
  74         MooseX::POE
  75         MooseX::Policy::SemiAffordanceAccessor
  76         MooseX::Q4MLog
  77         MooseX::Role::Cmd
  78         MooseX::Role::Matcher
  79         MooseX::Role::Parameterized
  80         MooseX::Role::TraitConstructor
  81         MooseX::Role::XMLRPC::Client
  82         MooseX::Scaffold
  83         MooseX::SemiAffordanceAccessor
  84         MooseX::SimpleConfig
  85         MooseX::Singleton
  86         MooseX::Storage
  87         MooseX::Storage::Format::XML::Simple
  88         MooseX::StrictConstructor
  89         MooseX::Struct
  90         MooseX::Templated
  91         MooseX::Timestamp
  92         MooseX::Traits
  93         MooseX::Traits::Attribute::CascadeClear
  94         MooseX::Types
  95         MooseX::Types::Authen::Passphrase
  96         MooseX::Types::Common
  97         MooseX::Types::Data::GUID
  98         MooseX::Types::DateTime
  99         MooseX::Types::IO
 100         MooseX::Types::Path::Class
 101         MooseX::Types::Set::Object
 102         MooseX::Types::Structured
 103         MooseX::Types::URI
 104         MooseX::Types::UUID
 105         MooseX::Types::VariantTable
 106         MooseX::WithCache
 107         MooseX::Workers
 108         MooseX::YAML
 109         Fey::ORM
 110         KiokuDB
 111         Catalyst
 112         ]
 113 );
 114
 115 close $log;
 116
 117 exit;
 118
 119 sub test_all_modules {
 120     my @statuses;
 121     my @details;
 122
 123     foreach my $project (@_) {
 124         my $dist = get_distro_from_cpan($project);
 125
 126         unless ($dist) {
 127             print {$log} "UNKNOWN : $project (not on CPAN?)\n";
 128             next;
 129         }
 130
 131         my ( $passed, $warned, $output ) = test_module( $dist->dir() );
 132
 133         my $status = $passed && $warned ? 'WARN' : $passed ? 'PASS' : 'FAIL';
 134
 135         push @statuses, "$status: $project - " . $dist->base_id();
 136
 137         push @details, [ $project, $output ]
 138             if $warned || ! $passed;
 139     }
 140
 141     for my $status (@statuses) {
 142         print {$log} "$status\n";
 143     }
 144
 145     if (@details) {
 146         print {$log} "\n\n";
 147
 148         for my $detail (@details) {
 149             print {$log} q{-} x 50;
 150             print {$log} "\n";
 151             print {$log} "$detail->[0]\n\n";
 152             print {$log} "$detail->[1]\n\n";
 153         }
 154     }
 155 }
 156
 157 sub get_distro_from_cpan {
 158     my $project = shift;
 159
 160     ( my $module = $project ) =~ s/-/::/g;
 161
 162     my @mods = CPAN::Shell->expand( 'Module', $module );
 163
 164     die "Cannot resolve $project to a single module object"
 165         if @mods > 1;
 166
 167     return unless @mods;
 168
 169     my $dist = $mods[0]->distribution();
 170
 171     $dist->get();
 172
 173     return $dist;
 174 }
 175
 176 sub test_module {
 177     my $dir = shift;
 178
 179     local $CWD = $dir;
 180
 181     local $ENV{PERL_AUTOINSTALL} = '--defaultdeps';
 182     if ( -f "Build.PL" ) {
 183         return
 184             unless _run_commands(
 185             [ $^X, 'Build.PL' ],
 186             ['./Build'],
 187             );
 188     }
 189     else {
 190         return
 191             unless _run_commands(
 192             [ $^X, 'Makefile.PL' ],
 193             ['make'],
 194             );
 195     }
 196
 197     return _run_tests();
 198 }
 199
 200 sub _run_commands {
 201     for my $cmd (@_) {
 202         my $output;
 203
 204         unless ( run3 $cmd, \undef, \$output, \$output ) {
 205             warn "Failed to run @{$cmd}\n";
 206             return ( 0, $output );
 207         }
 208     }
 209
 210     return 1;
 211 }
 212
 213 sub _run_tests {
 214     my $output;
 215
 216     run3 [ qw( prove -b ) ], undef, \$output, \$output;
 217
 218     my $passed = $output =~ /Result: PASS/;
 219     my $warned = $output =~ /at .+ line \d+/;
 220
 221     return ( $passed, $warned, $output );
 222 }
 223