extractuse.pl 3.71 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
#!/usr/bin/perl

# bin/extractuse
#  Extract modules used by this distribution
#
# $Id: extractuse 6744 2009-04-29 14:32:07Z FREQUENCY@cpan.org $
#
# This package and its contents are released by the author into the
# Public Domain, to the full extent permissible by law. For additional
# information, please see the included `LICENSE' file.

use strict;
use warnings;

use Pod::Usage;

=head1 NAME

extractuse - determine what Perl modules are used in a given file

=head1 VERSION

Version 1.0 ($Id: extractuse 6744 2009-04-29 14:32:07Z FREQUENCY@cpan.org $)

=cut

use version; our $VERSION = qv('1.0');

=head1 SYNOPSIS

Usage: extractuse filename [...]

Given a single path referring to a file containing Perl code, this script will
determine the modules included statically. This means that files included
by C<use> and C<require> will be retrieved and listed.

=head1 DESCRIPTION

This script is safe because the Perl code is never executed, only parsed by
C<Module::Extract::Use> or C<Module::ExtractUse>, which are two different
implementations of this idea. This module will prefer C<Module::Extract::Use>
if it is installed, because it uses PPI to do its parsing, rather than its
own separate grammar.

However, one limitation of this script is that only statically included
modules can be found - that is, they have to be C<use>'d or C<require>'d
at runtime, and not inside an eval string, for example. Because eval strings
are completely dynamic, there is no way of determining which modules might
be loaded under different conditions.

=cut

my @files = @ARGV;
my $class = 'Module::Extract::Use';

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

eval {
  require Module::Extract::Use;
};
if ($@) {
  $class = 'Module::ExtractUse';
  eval {
    require Module::ExtractUse;
  };
  if ($@) {
    print {*STDERR} "No usable module found; exiting...\n";
    exit 1;
  }
}

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

foreach my $file (@files) {
  my $mlist;
  unless (-e $file and -r _) {
    printf {*STDERR} "Failed to open file '%s' for reading\n", $file;
    next;
  }
  if ($class eq 'Module::ExtractUse') {
    $mlist = Module::ExtractUse->new;
    $mlist->extract_use($file);
    dumplist($file, $mlist->array);
  }
  else {
    $mlist = Module::Extract::Use->new;
    dumplist($file, $mlist->get_modules($file));
  }
}

sub dumplist {
  my ($file, @mods) = @_;

  printf "Modules required by %s:\n", $file;
  my $core = 0;
  my $extern = 0;
  foreach my $name (@mods) {
    print ' - ' . $name;
    if ($corelist) {
      my $ver = Module::CoreList->first_release($name);
      if (defined $ver) {
        printf ' (first released with Perl %s)', $ver;
        $core++;
      }
      else {
        $extern++;
      }
    }
    print "\n";
  }
  printf "%d module(s) in core, %d external module(s)\n\n", $core, $extern;
}

=head1 AUTHOR

Jonathan Yu E<lt>frequency@cpan.orgE<gt>

=head1 SUPPORT

For support details, please look at C<perldoc Module::Extract::Use> or
C<perldoc Module::ExtractUse> and use the corresponding support methods.

=head1 LICENSE

Copyleft (C) 2009 by Jonathan Yu <frequency@cpan.org>. All rights reversed.

I, the copyright holder of this script, hereby release the entire contents
therein into the public domain. This applies worldwide, to the extent that
it is permissible by law.

In case this is not legally possible, I grant any entity the right to use
this work for any purpose, without any conditions, unless such conditions
are required by law. If not applicable, you may use this script under the
same terms as Perl itself.

=head1 SEE ALSO

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

=cut