File: extractuse.pl

package info (click to toggle)
libmodule-extractuse-perl 0.344-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 868 kB
  • sloc: perl: 11,270; makefile: 17
file content (149 lines) | stat: -rw-r--r-- 3,794 bytes parent folder | download | duplicates (3)
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