1#!/usr/bin/perl 2 3# bin/extractuse 4# Extract modules used by this distribution 5# 6# $Id: extractuse 6744 2009-04-29 14:32:07Z FREQUENCY@cpan.org $ 7# 8# This package and its contents are released by the author into the 9# Public Domain, to the full extent permissible by law. For additional 10# information, please see the included `LICENSE' file. 11 12use strict; 13use warnings; 14 15use Pod::Usage; 16 17=head1 NAME 18 19extractuse - determine what Perl modules are used in a given file 20 21=head1 VERSION 22 23Version 1.0 ($Id: extractuse 6744 2009-04-29 14:32:07Z FREQUENCY@cpan.org $) 24 25=cut 26 27use version; our $VERSION = qv('1.0'); 28 29=head1 SYNOPSIS 30 31Usage: extractuse filename [...] 32 33Given a single path referring to a file containing Perl code, this script will 34determine the modules included statically. This means that files included 35by C<use> and C<require> will be retrieved and listed. 36 37=head1 DESCRIPTION 38 39This script is safe because the Perl code is never executed, only parsed by 40C<Module::Extract::Use> or C<Module::ExtractUse>, which are two different 41implementations of this idea. This module will prefer C<Module::Extract::Use> 42if it is installed, because it uses PPI to do its parsing, rather than its 43own separate grammar. 44 45However, one limitation of this script is that only statically included 46modules can be found - that is, they have to be C<use>'d or C<require>'d 47at runtime, and not inside an eval string, for example. Because eval strings 48are completely dynamic, there is no way of determining which modules might 49be loaded under different conditions. 50 51=cut 52 53my @files = @ARGV; 54my $class = 'Module::Extract::Use'; 55 56# if no parameters are passed, give usage information 57unless (@files) { 58 pod2usage(msg => 'Please supply at least one filename to analyze'); 59 exit(); 60} 61 62eval { 63 require Module::Extract::Use; 64}; 65if ($@) { 66 $class = 'Module::ExtractUse'; 67 eval { 68 require Module::ExtractUse; 69 }; 70 if ($@) { 71 print {*STDERR} "No usable module found; exiting...\n"; 72 exit 1; 73 } 74} 75 76eval { 77 require Module::CoreList; 78}; 79my $corelist = not $@; 80 81foreach my $file (@files) { 82 my $mlist; 83 unless (-e $file and -r _) { 84 printf {*STDERR} "Failed to open file '%s' for reading\n", $file; 85 next; 86 } 87 if ($class eq 'Module::ExtractUse') { 88 $mlist = Module::ExtractUse->new; 89 $mlist->extract_use($file); 90 dumplist($file, $mlist->array); 91 } 92 else { 93 $mlist = Module::Extract::Use->new; 94 dumplist($file, $mlist->get_modules($file)); 95 } 96} 97 98sub dumplist { 99 my ($file, @mods) = @_; 100 101 printf "Modules required by %s:\n", $file; 102 my $core = 0; 103 my $extern = 0; 104 foreach my $name (@mods) { 105 print ' - ' . $name; 106 if ($corelist) { 107 my $ver = Module::CoreList->first_release($name); 108 if (defined $ver) { 109 printf ' (first released with Perl %s)', $ver; 110 $core++; 111 } 112 else { 113 $extern++; 114 } 115 } 116 print "\n"; 117 } 118 printf "%d module(s) in core, %d external module(s)\n\n", $core, $extern; 119} 120 121=head1 AUTHOR 122 123Jonathan Yu E<lt>frequency@cpan.orgE<gt> 124 125=head1 SUPPORT 126 127For support details, please look at C<perldoc Module::Extract::Use> or 128C<perldoc Module::ExtractUse> and use the corresponding support methods. 129 130=head1 LICENSE 131 132Copyleft (C) 2009 by Jonathan Yu <frequency@cpan.org>. All rights reversed. 133 134I, the copyright holder of this script, hereby release the entire contents 135therein into the public domain. This applies worldwide, to the extent that 136it is permissible by law. 137 138In case this is not legally possible, I grant any entity the right to use 139this work for any purpose, without any conditions, unless such conditions 140are required by law. If not applicable, you may use this script under the 141same terms as Perl itself. 142 143=head1 SEE ALSO 144 145L<Module::Extract::Use>, 146L<Module::ExtractUse>, 147L<Module::ScanDeps>, 148 149=cut 150