#!/usr/bin/perl

use v5.10;

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

use Pod::Usage;
use Getopt::Std qw(getopts);

=head1 NAME

extract_modules - determine which Perl modules a given file uses

=cut

our $VERSION = '1.101';

getopts('jl0', \my %opts);

=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"
	]

=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 analyze the source without compiling or running it.
These modules cannot discover modules loaded dynamically through a
string eval.

=cut

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

my( $object, $method );
my @classes = qw( Module::Extract::Use Module::ExtractUse );
my %methods = qw(
	Module::Extract::Use get_modules
	Module::ExtractUse   extract_use
	);

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

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


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

	my @modules = $object->$method( $file );
	push @Grand_modules, @modules;

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

	long_list( $file, @modules )
	}

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


sub short_list {
	state $Seen = {};

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

sub json_list {
	state $Seen = {};

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

}

=head1 AUTHORS

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

brian d foy C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT & LICENSE

Copyright © 2009-2017, brian d foy <bdfoy@cpan.org>. 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