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