—
—
—

              
#!/usr/bin/perl
use v5.10;
use open qw(:std :utf8);
use strict;
use warnings;
use Pod::Usage;
use Getopt::Std qw(getopts);
HideShow 8 lines of Pod
=encoding utf8
=head1 NAME
extract_modules - determine which Perl modules a given file uses
=cut
our $VERSION = '1.104';
getopts('ecjl0', \my %opts);
HideShow 74 lines of Pod
=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';
=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.
=head2 Command-line options
=over 4
=item * -c  cpanfile output
=item * -e  exclude core modules
=item * -j  JSON output
=item * -l  succint list, one module per line
=item * -0  succint list, modules null separated (for xargs -0)
=cut
# if no parameters are passed, give usage information
unless( @ARGV ) {
        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 "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 );
        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( @Grand_modules ) }
elsif( $opts{j} )             { json_list(  @Grand_modules ) }
elsif( $opts{c} )             { cpan_file(  @Grand_modules ) }
sub short_list {
        state $Seen = {};
        my $glue = $opts{0} ? "\000" : "\n";
        print join( $glue,
                grep( { ! $Seen->{$_}++ } sort map { $_->[0] } @_ ),
                ''
                );
        }
sub json_list {
        state $Seen = {};
        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 = {};
        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;
        }
}
HideShow 20 lines of Pod
=head1 AUTHORS
Jonathan Yu C<< <frequency@cpan.org> >>
brian d foy C<< <bdfoy@cpan.org> >>
=head1 COPYRIGHT & LICENSE
Copyright © 2009-2024, 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