The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
# Make sure we can "use" every module

use strict;
use warnings;
use Test::More;
use File::Find::Rule;

use constant CONCURRENCY => 5;

eval q/use Test::Builder; 1;/
  or plan skip_all => 'Necessary modules not installed';
  
my @classes = 
  map  { path_to_pkg($_) }
  grep { !/00\d[a-z]+.pm/ }
  File::Find::Rule->file()->name('*.pm')->in('lib');

my @scripts;
eval q{
  use Module::Build;
  Module::Build->current->script_files;
  @scripts = keys %{ Module::Build->current->script_files };
};

push @scripts, grep { !/\.svn\b/ and !/~$/ } File::Find::Rule
    ->file()					# find all files
    ->in('bin') if -d 'bin';			# ... but only if there's a bin/ dir

@scripts = 
  grep { _perl_shebang($_) }            # only check perl scripts.
  keys %{{ map { $_ => 1 } @scripts }}; # only check scripts once.

sub _perl_shebang {
  my $file = shift;
  open FILE, $file or die "Can't read $file: $!";
  return <FILE> =~ /^#!.*\bperl/;
}

plan skip_all => "No modules" unless scalar @classes + @scripts;
plan tests => scalar @classes + @scripts;

# We need to tweak the numbers of the tests

my %waits;
my $current = 0;
while (@classes or keys %waits) {
  while ($current < CONCURRENCY && (my $class = shift @classes)) {
    my $child = fork;
    if ($child) {
      $waits{$child} = $class;
      ++$current;
    }
    else {
      my $null;
      open $null, '>', \(my $str);
      my $test = Test::Builder->new;
      $test->output($null);

      # Ok, now exit. Veeery important, unless we want to drive the load on the
      # machine to, say, 788.55. That would be bad.

      exit !use_ok($class);
    }
  }
  if ($current) {
    my $pid = wait;
    --$current;
    ok(!$?, "use $waits{$pid}" );
  }
  else {
    last;
  }
}

use Config;
my $open3 = eval "use IPC::Open3; 1";
foreach my $script (@scripts) {
  my @lib = -d 'blib' ? '-Iblib/lib' : 
            -d 'lib'  ? '-Ilib'  : ();
  my @cmd = ($Config{perlpath}, "-c", @lib, $script);
  if ($open3) {
    my $pid = open3(my ($in, $out, undef), "@cmd");
    last if wait == -1;
    ok( ! $?, "@cmd" ) or do {
      read($out, my $error, 9999) or die "could not read from file: $!";
      diag $error;
    };
  } else {
    ok( ! system(@cmd), "@cmd" );
  }
}

sub path_to_pkg ($) {
  for (shift) {
    s|.*lib/||;
    s|/|::|g;
    s|\.pm$||;
    return $_;
  }
}