#!/usr/bin/perl
use v5.10;
use utf8;

use open qw(:std :utf8);
use strict;
use warnings;

use File::Spec::Functions qw(catfile);
use Getopt::Std qw(getopts);

=encoding utf8

=head1 NAME

extract_modules - determine which Perl modules a given file uses

=cut

our $VERSION = '1.104';

=head1 SYNOPSIS

Given Perl files, extract and report the Perl modules included
with C<use> or C<require>.

	# print a verbose text listing
	$ extract_modules filename [...]
	Modules required by examples/extract_modules:
	 - Getopt::Std (first released with Perl 5)
	 - Module::CoreList (first released with Perl 5.008009)
	 - Pod::Usage (first released with Perl 5.006)
	 - strict (first released with Perl 5)
	 - warnings (first released with Perl 5.006)
	5 module(s) in core, 0 external module(s)

	# print a succint list, one module per line
	$ extract_modules -l filename [...]
	Getopt::Std
	Module::CoreList
	Pod::Usage
	open
	strict
	warnings

	# print a succinct list, modules separated by null bytes
	# you might like this with xargs -0
	$ extract_modules -0 filename [...]
	Getopt::StdModule::CoreListPod::Usageopenstrictwarnings

	# print the modules list as JSON
	$ extract_modules -j filename [...]
	[
		"Getopt::Std",
		"Module::CoreList",
		"Pod::Usage",
		"open",
		"strict",
		"warnings"
	]

	# print the modules list as a basic cpanfile
	# https://metacpan.org/pod/cpanfile
	$ extract_modules -c filename [...]
	requires 'Getopt::Std', '1.23';
	requires 'Module::CoreList';
	requires 'Pod::Usage';
	requires 'open';
	requires 'strict';
	requires 'warnings';

	# look for the file in PATH
	$ extract_modules -b some_program

=head1 DESCRIPTION

This script does not execute the code in the files it examines. It
uses the C<Module::Extract::Use> or C<Module::ExtractUse> modules
which statically analyzes the source without compiling or running it.
These modules cannot discover modules loaded dynamically through a
string eval.

=head2 Command-line options

=over 4

=item * -b  look for filename in current directory or in PATH

=item * -c  cpanfile output

=item * -e  exclude core modules

=item * -j  JSON output

=item * -l  succinct list, one module per line

=item * -0  succinct list, modules null separated (for xargs -0)

=cut

run(@ARGV) unless caller;

sub run {
	my @args = @_;

	my %opts;
	{
	local @ARGV = @args;
	getopts('bcejl0', \%opts);
	@args = @ARGV;
	}

	# if no parameters are passed, give usage information
	unless( @args ) {
		require Pod::Usage;
		Pod::Usage::pod2usage( msg => 'Please supply at least one filename to analyze' );
		exit;
		}

	use Data::Dumper;
	my( $object, $method, $sub );
	my @classes = qw( Module::Extract::Use Module::ExtractUse );
	my %methods = (
		'Module::Extract::Use' => [ 'get_modules_with_details', sub {
			[ $_[0]->module, $_[0]->version ];
			} ],
		'Module::ExtractUse' => [ 'extract_use', sub {
			say Dumper( \@_ );
			[ $_[0], undef ];
			} ],
		);

	foreach my $module ( @classes ) {
		eval "require $module";
		next if $@;
		( $object, $method, $sub ) = ( $module->new, @{ $methods{$module} } );
		}

	die join(
			"\n\t",
			"Install one of these modules to make this program work:",
			sort keys %methods
			) . "\n"
		unless defined $object;

	if( $opts{'b'} ) {
		require Config;
		my @dirs = split /\Q$Config::Config{'path_sep'}/, $ENV{'PATH'};

		my @found_args;
		FILE: foreach my $file ( @args ) {
			if( -e $file ) {
				push @found_args, $file;
				next FILE;
				}

			foreach my $dir ( @dirs ) {
				print STDERR "Looking in $dir\n";
				my $path = catfile $dir, $file;
				if( -e $path ) {
					push @found_args, $path;
					next FILE;
					}
				}
			}

		@args = @found_args;
		}

	my @Grand_modules;
	foreach my $file ( @args ) {
		unless ( -r $file ) {
			printf STDERR "Could not read $file\n";
			next;
			}

		my @modules = $object->$method( $file );
		my $ref = ref $modules[0] ? $modules[0] : \@modules;
		push @Grand_modules, map { $sub->( $_ ) } @$ref;

		# remove core modules
		@Grand_modules =
			grep { ! defined Module::CoreList->first_release( $_->[0] ) }
			@Grand_modules
			if $opts{e};

		next if $opts{j} || $opts{l} || $opts{0} || $opts{c}; # do these after

		# Handle this here because we want the filename
		long_list( $file, @Grand_modules )
		}

	# Handle these options after going through all the files
	   if( $opts{l} or $opts{0} ) { short_list( \%opts, @Grand_modules ) }
	elsif( $opts{j} )             { json_list(  \%opts, @Grand_modules ) }
	elsif( $opts{c} )             { cpan_file(  \%opts, @Grand_modules ) }
	}

sub short_list {
	state $Seen = {};
	my $opts = shift;

	my $glue = $opts->{0} ? "\000" : "\n";
	print join( $glue,
		grep( { ! $Seen->{$_}++ } sort map { $_->[0] } @_ ),
		''
		);
	}

sub json_list {
	state $Seen = {};
	my $opts = shift;

	my $glue = $opts->{0} ? "\000" : "\n";
	print
		"[\n\t",
		join( ",\n\t",
			map { qq("$_") }
			grep { ! $Seen->{$_}++ }
			sort
			map { $_->[0] }
			@_
			),
		"\n]\n";
	}

sub cpan_file {
	state $Seen = {};
	my $opts = shift;

	foreach my $module ( @_ ) {
		printf "requires '%s'", $module->[0];
		printf ", '%s'", $module->[1] if defined $module->[1];
		print ";\n";
		}
	}

BEGIN {
my $corelist = eval { require Module::CoreList };

sub long_list {
	my( $file, @modules ) = @_;

	printf "Modules required by %s:\n", $file;

	my( $core, $extern ) = ( 0, 0 );

	foreach my $tuple ( @modules ) {
		my( $module, $version ) = @$tuple;
		printf " - $module%s\n",
			$corelist
				?
				do {
					my $v = Module::CoreList->first_release( $module );
					$core++ if $v;
					$v ? " (first released with Perl $v)" : '';
					}
				:
				do { $extern++; '' }
		}

	printf "%d module(s) in core, %d external module(s)\n\n", $core, $extern;
	}
}

=back

=head1 AUTHORS

Jonathan Yu C<< <frequency@cpan.org> >>

brian d foy C<< <briandfoy@pobox.com> >>

=head1 COPYRIGHT & LICENSE

Copyright © 2009-2026, brian d foy <briandfoy@pobox.com>. All rights reserved.

You can use this script under the same terms as Perl itself.

=head1 SEE ALSO

L<Module::Extract::Use>,
L<Module::ExtractUse>,
L<Module::ScanDeps>,

=cut
