File Coverage

blib/lib/Module/Extract/Use.pm
Criterion Covered Total %
statement 86 89 96.6
branch 23 26 88.4
condition 5 6 83.3
subroutine 25 26 96.1
pod 5 5 100.0
total 144 152 94.7


line stmt bran cond sub pod time code
1 4     4   2890 use v5.10;
  4         15  
2              
3             package Module::Extract::Use;
4 4     4   22 use strict;
  4         8  
  4         95  
5              
6 4     4   20 use warnings;
  4         8  
  4         97  
7 4     4   20 no warnings;
  4     0   20  
  4         5472  
8              
9             our $VERSION = '1.049';
10              
11             =encoding utf8
12              
13             =head1 NAME
14              
15             Module::Extract::Use - Discover the modules a module explicitly uses
16              
17             =head1 SYNOPSIS
18              
19             use Module::Extract::Use;
20              
21             my $extor = Module::Extract::Use->new;
22              
23             my @modules = $extor->get_modules( $file );
24             if( $extor->error ) { ... }
25              
26             my $details = $extor->get_modules_with_details( $file );
27             foreach my $detail ( @$details ) {
28             printf "%s %s imports %s\n",
29             $detail->module, $detail->version,
30             join ' ', @{ $detail->imports }
31             }
32              
33             =head1 DESCRIPTION
34              
35             Extract the names of the modules used in a file using a static
36             analysis. Since this module does not run code, it cannot find dynamic
37             uses of modules, such as C. It only reports modules
38             that the file loads directly or are in the import lists for L
39             or L.
40              
41             The module can handle the conventional inclusion of modules with either
42             C or C as the statement:
43              
44             use Foo;
45             require Foo;
46              
47             use Foo 1.23;
48             use Foo qw(this that);
49              
50             It now finds C as an expression, which is useful to lazily
51             load a module once (and may be faster):
52              
53             sub do_something {
54             state $rc = require Foo;
55             ...
56             }
57              
58             Additionally, it finds module names used with C and C,
59             either of which establish an inheritance relationship:
60              
61             use parent qw(Foo);
62             use base qw(Foo);
63              
64             In the case of namespaces found in C or C, the value of
65             the C method is false. In all other cases, it is true. You
66             can then skip those namespaces:
67              
68             my $details = $extor->get_modules_with_details( $file );
69             foreach my $detail ( @$details ) {
70             next unless $detail->direct;
71              
72             ...
73             }
74              
75             This module does not discover runtime machinations to load something,
76             such as string evals:
77              
78             eval "use Foo";
79              
80             my $bar = 'Bar';
81             eval "use $bar";
82              
83             If you want that, you might consider L (a confusingly
84             similar name).
85              
86             =cut
87              
88             =over 4
89              
90             =item new
91              
92             Makes an object. The object doesn't do anything just yet, but you need
93             it to call the methods.
94              
95             =cut
96              
97             sub new {
98 3     3 1 1657 my $class = shift;
99              
100 3         9 my $self = bless {}, $class;
101              
102 3         9 $self->init;
103              
104 3         6 $self;
105             }
106              
107             =item init
108              
109             Set up the object. You shouldn't need to call this yourself.
110              
111             =cut
112              
113             sub init {
114 3     3 1 9 $_[0]->_clear_error;
115             }
116              
117             =item get_modules( FILE )
118              
119             Returns a list of namespaces explicity use-d in FILE. Returns the
120             empty list if the file does not exist or if it can't parse the file.
121              
122             Each used namespace is only in the list even if it is used multiple
123             times in the file. The order of the list does not correspond to
124             anything so don't use the order to infer anything.
125              
126             =cut
127              
128             sub get_modules {
129 7     7 1 23672 my( $self, $file ) = @_;
130              
131 7         25 $self->_clear_error;
132              
133 7         17 my $details = $self->get_modules_with_details( $file );
134              
135 7         18 my @modules = map { $_->module } @$details;
  12         24  
136              
137 7         59 @modules;
138             }
139              
140             =item get_modules_with_details( FILE )
141              
142             Returns a list of hash references, one reference for each namespace
143             explicitly use-d in FILE. Each reference has keys for:
144              
145             namespace - the namespace, always defined
146             version - defined if a module version was specified
147             imports - an array reference to the import list
148             pragma - true if the module thinks this namespace is a pragma
149             direct - false if the module name came from parent or base
150              
151             Each used namespace is only in the list even if it is used multiple
152             times in the file. The order of the list does not correspond to
153             anything so don't use the order to infer anything.
154              
155             =cut
156              
157             sub get_modules_with_details {
158 9     9 1 2050 my( $self, $file ) = @_;
159              
160 9         26 $self->_clear_error;
161              
162 9         22 my $modules = $self->_get_ppi_for_file( $file );
163 9 100       7622 return [] unless defined $modules;
164              
165 8         26 $modules;
166             }
167              
168             sub _get_ppi_for_file {
169 9     9   20 my( $self, $file ) = @_;
170              
171 9 100       153 unless( -e $file ) {
172 1         6 $self->_set_error( ref( $self ) . ": File [$file] does not exist!" );
173 1         3 return;
174             }
175              
176 8         1728 require PPI;
177              
178 8         338572 my $Document = eval { PPI::Document->new( $file ) };
  8         65  
179 8 50       140402 unless( $Document ) {
180 0         0 $self->_set_error( ref( $self ) . ": Could not parse file [$file]" );
181 0         0 return;
182             }
183              
184             # this handles the
185             # use Foo;
186             # use Bar;
187 8         40 my $regular_modules = $self->_regular_load( $Document );
188              
189             # this handles
190             # use parent qw(...)
191 8         28 my $isa_modules = $self->_isa_load( $regular_modules );
192              
193             # this handles
194             # my $rc = require Foo;
195 8         24 my $expression_loads = $self->_expression_load( $Document );
196              
197 8         24 my @modules = map { @$_ }
  24         62  
198             $regular_modules,
199             $isa_modules,
200             $expression_loads
201             ;
202              
203 8         51 return \@modules;
204             }
205              
206             sub _regular_load {
207 8     8   24 my( $self, $Document ) = @_;
208              
209             my $modules = $Document->find(
210             sub {
211 1229     1229   13624 $_[1]->isa( 'PPI::Statement::Include' )
212             }
213 8         67 );
214              
215 8 100       165 return [] unless $modules;
216              
217 5         13 my %Seen;
218             my @modules =
219 29 100       472 grep { ! $Seen{ $_->{module} }++ && $_->{module} }
220             map {
221 5         54 my $hash = bless {
222             direct => 1,
223             content => $_->content,
224             pragma => $_->pragma,
225             module => $_->module,
226             imports => [ $self->_list_contents( $_->arguments ) ],
227 29 50       1408 version => eval{ $_->module_version->literal || ( undef ) },
  29         530  
228             }, 'Module::Extract::Use::Item';
229             } @$modules;
230              
231 5         37 \@modules;
232             }
233              
234             sub _isa_load {
235 8     8   37 my( $self, $modules ) = @_;
236             my @isa_modules =
237             map {
238 1         2 my $m = $_;
239             map {
240 1         5 bless {
241             content => $m->content,
242             pragma => '',
243             direct => 0,
244             module => $_,
245             imports => [],
246             version => undef,
247             }, 'Module::Extract::Use::Item';
248 1         2 } @{ $m->imports };
  1         4  
249             }
250 8 100       21 grep { $_->module eq 'parent' or $_->module eq 'base' }
  22         47  
251             @$modules;
252              
253 8         26 \@isa_modules;
254             }
255              
256             sub _expression_load {
257 8     8   22 my( $self, $Document ) = @_;
258              
259             my $in_statements = $Document->find(
260             sub {
261 1229     1229   12411 my $sib;
262 1229 100 100     4422 $_[1]->isa( 'PPI::Token::Word' ) &&
      66        
263             $_[1]->content eq 'require' &&
264             ( $sib = $_[1]->snext_sibling() ) &&
265             $sib->isa( 'PPI::Token::Word' )
266             }
267 8         47 );
268              
269 8 100       148 return [] unless $in_statements;
270              
271             my @modules =
272             map {
273 1         4 bless {
  2         82  
274             content => $_->parent->content,
275             pragma => undef,
276             direct => 1,
277             module => $_->snext_sibling->content,
278             imports => [],
279             version => undef,
280             }, 'Module::Extract::Use::Item';
281             }
282             @$in_statements;
283              
284 1         69 \@modules;
285             }
286              
287 0         0 BEGIN {
288             package Module::Extract::Use::Item;
289              
290 1     1   2762 sub direct { $_[0]->{direct} }
291 2     2   16 sub content { $_[0]->{content} }
292 1     1   7 sub pragma { $_[0]->{pragma} }
293 56     56   185 sub module { $_[0]->{module} }
294 1     1   4 sub imports { $_[0]->{imports} }
295 1     1   5 sub version { $_[0]->{version} }
296             }
297              
298             sub _list_contents {
299 29     29   2887 my( $self, $node ) = @_;
300              
301 29         51 eval {
302 29 100       123 if( ! defined $node ) {
    100          
    100          
    50          
303 15         35 return;
304             }
305             elsif( $node->isa( 'PPI::Token::QuoteLike::Words' ) ) {
306 6         23 ( $node->literal )
307             }
308             elsif( $node->isa( 'PPI::Structure::List' ) ) {
309 1     5   20 my $nodes = $node->find( sub{ $_[1]->isa( 'PPI::Token::Quote' ) } );
  5         67  
310 1         14 map { $_->string } @$nodes;
  2         12  
311             }
312             elsif( $node->isa( 'PPI::Token::Quote' ) ) {
313 7         26 ( $node->string );
314             }
315             };
316              
317             }
318              
319             =item error
320              
321             Return the error from the last call to C.
322              
323             =cut
324              
325 1     1   2 sub _set_error { $_[0]->{error} = $_[1]; }
326              
327 19     19   46 sub _clear_error { $_[0]->{error} = '' }
328              
329 2     2 1 42 sub error { $_[0]->{error} }
330              
331             =back
332              
333             =head1 TO DO
334              
335             =head1 SEE ALSO
336              
337             L, L
338              
339             =head1 SOURCE AVAILABILITY
340              
341             The source code is in Github:
342              
343             https://github.com/briandfoy/module-extract-use
344              
345             =head1 AUTHOR
346              
347             brian d foy, C<< >>
348              
349             =head1 COPYRIGHT AND LICENSE
350              
351             Copyright © 2008-2022, brian d foy C<< >>. All rights reserved.
352              
353             This project is under the Artistic License 2.0.
354              
355             =cut
356              
357             1;