Shoddy dzil-free cpanfile generator cloned from the Dist::Zilla::Plugin::AutoPrereqs logic

scan-perl-prereqs-cpanfile

#!/usr/bin/env perl

use strict;
use warnings;

use lib ();

use File::Find;
use List::Util qw{ max };
use Perl::PrereqScanner;
use CPAN::Meta::Requirements ();
use Scalar::Util qw(looks_like_number);
use Module::CPANfile;
use File::Slurper 'read_text';

use Getopt::Long::Descriptive;

my ($opt, $usage) = describe_options(
  'scan-perl-prereqs-cpanfile %o [DIR|FILES]',
  [ 'lib|I=s@' => 'specifies include paths, like perl\'s -I' ],

  [ 'version' => 'print usage message and exit' ],
  [ 'help'    => 'print version and exit' ],
);

lib->import(@{ $opt->lib }) if $opt->lib;

print('scan-perl-prereqs v' . (Perl::PrereqScanner->VERSION || 'DEV') . "\n")
  if $opt->version;
print($usage->text) if $opt->help;
exit if $opt->version or $opt->help;

my @modules = qw(Config Errno); # never indexed

my %result = map { $_ => CPAN::Meta::Requirements->new } qw( test runtime );

find( {
	no_chdir => 1,
	wanted => sub {
		scan_file($_)
			if /\.(pl|PL|pm|cgi|psgi|t)$/ && -f $_
			or do { local *ARGV = [$_]; <> =~ /^#!(?:.*)perl(?:$|\s)/ }
	}
}, '.' );

for my $phase ( values %result ) { # remove prereqs shipped with current dist
	$phase->clear_requirement($_) for @modules;
}

for ( $result{'test'}->required_modules ) {
	no warnings 'uninitialized';
	$result{'test'}->clear_requirement( $_ )
		if $result{'runtime'}->requirements_for_module( $_ )
		ge $result{'test'}->requirements_for_module( $_ );
}

$_ = { requires => $_->as_string_hash } for values %result;

print Module::CPANfile->from_prereqs( \%result )->to_string;

sub scan_file {
	my ($file) = @_;

	my $file_req = Perl::PrereqScanner->new->scan_file($file);
	my $phase = $file =~ /\.t\z/ ? 'test' : 'runtime';
	my $req = $result{$phase} ||= CPAN::Meta::Requirements->new;

	# store module name, to trim it from require list later on
	my @this_thing = $file;

	# t/lib/Foo.pm is treated as providing t::lib::Foo, lib::Foo, and Foo
	if ($this_thing[0] =~ /^t/) {
		push @this_thing, ($this_thing[0]) x 2;
		$this_thing[1] =~ s{^t/}{};
		$this_thing[2] =~ s{^t/lib/}{};
	} else {
		$this_thing[0] =~ s{^lib/}{};
	}
	s{\.pm$}{} for @this_thing;
	s{/}{::}g for @this_thing;

	push @modules, @this_thing, read_text($file) =~ /package\s+([^\s;]+)/g;

	$req->add_requirements($file_req);
}