File Coverage

blib/lib/Module/ScanDeps/Static.pm
Criterion Covered Total %
statement 142 281 50.5
branch 35 144 24.3
condition 29 100 29.0
subroutine 23 29 79.3
pod 3 12 25.0
total 232 566 40.9


line stmt bran cond sub pod time code
1             package Module::ScanDeps::Static;
2              
3 2     2   3348 use strict;
  2         4  
  2         57  
4 2     2   10 use warnings;
  2         3  
  2         83  
5              
6             our $VERSION = '1.002';
7              
8 2     2   37 use 5.010;
  2         7  
9              
10 2     2   12 use Carp;
  2         3  
  2         121  
11 2     2   577 use Data::Dumper;
  2         7193  
  2         137  
12 2     2   1086 use English qw{ -no_match_vars };
  2         3498  
  2         11  
13 2     2   1580 use ExtUtils::MM;
  2         220952  
  2         133  
14 2     2   2937 use Getopt::Long;
  2         21078  
  2         8  
15 2     2   1846 use JSON::PP;
  2         30791  
  2         144  
16 2     2   5900 use Module::CoreList;
  2         209507  
  2         26  
17 2     2   2808 use Pod::Usage;
  2         74857  
  2         252  
18 2     2   15 use Pod::Find qw{ pod_where };
  2         5  
  2         104  
19 2     2   1085 use Readonly;
  2         7603  
  2         114  
20 2     2   990 use IO::Scalar;
  2         20523  
  2         90  
21 2     2   14 use List::Util qw{ max };
  2         4  
  2         187  
22 2     2   16 use version;
  2         15  
  2         23  
23              
24 2     2   1051 use parent qw{ Class::Accessor::Fast };
  2         529  
  2         12  
25              
26             __PACKAGE__->follow_best_practice;
27             __PACKAGE__->mk_accessors(
28             qw{
29             json raw text handle include_require core
30             add_version perlreq require path separator min_core_version
31             }
32             );
33              
34             # booleans
35             Readonly my $TRUE => 1;
36             Readonly my $FALSE => 0;
37              
38             # shell success/failure
39             Readonly my $SUCCESS => 0;
40             Readonly my $FAILURE => 1;
41              
42             # chars
43             Readonly my $COMMA => q{,};
44             Readonly my $DOUBLE_COLON => q{::};
45             Readonly my $EMPTY => q{};
46             Readonly my $NEWLINE => qq{\n};
47             Readonly my $SLASH => q{/};
48             Readonly my $SPACE => q{ };
49              
50             Readonly my $DEFAULT_MIN_CORE_VERSION => '5.8.9';
51              
52             our $HAVE_VERSION = eval {
53             require version;
54             return $TRUE;
55             };
56              
57             caller or __PACKAGE__->main();
58              
59             ########################################################################
60             sub new {
61             ########################################################################
62 2     2 1 7312 my ( $class, $args ) = @_;
63              
64 2   50     7 $args = $args || {};
65              
66 2         4 my %options = %{$args};
  2         14  
67              
68 2         5 foreach my $k ( keys %options ) {
69 3         7 my $v = $options{$k};
70              
71 3         8 delete $options{$k};
72              
73 3         6 $k =~ s/-/_/gxsm;
74              
75 3         6 $options{$k} = $v;
76             }
77              
78             # defaults
79 2   33     16 $options{'core'} //= $TRUE;
80 2   33     21 $options{'include_require'} //= $FALSE;
81 2   66     16 $options{'add_version'} //= $TRUE;
82 2   33     13 $options{'min_core_version'} //= $DEFAULT_MIN_CORE_VERSION;
83              
84 2         18 my $self = $class->SUPER::new( \%options );
85              
86 2         68 $self->set_perlreq( {} );
87 2         56 $self->set_require( {} );
88              
89 2         16 return $self;
90             }
91              
92             ########################################################################
93             sub make_path_from_module {
94             ########################################################################
95 4     4 0 6 my ( $self, $module ) = @_;
96              
97 4         11 my $file = join $SLASH, split /$DOUBLE_COLON/xsm, $module;
98              
99 4         53 return "$file.pm";
100             }
101              
102             ########################################################################
103             sub get_module_version {
104             ########################################################################
105 4     4 0 6 my ( $self, $module_w_version, @include_path ) = @_;
106              
107 4 50       9 if ( !@include_path ) {
108 4         13 @include_path = @INC;
109             }
110              
111 4         13 my ( $module, $version ) = split /\s+/xsm, $module_w_version;
112              
113 4         15 my %module_version = (
114             module => $module,
115             version => $version,
116             path => undef,
117             );
118              
119 4 50       8 return \%module_version
120             if $version;
121              
122 4         8 $module_version{'file'} = $self->make_path_from_module($module);
123              
124 4         10 foreach my $prefix (@include_path) {
125              
126 40         130 my $path = $prefix . $SLASH . $module_version{'file'};
127 40 100       632 next if !-e $path;
128              
129 2         7 $module_version{'path'} = $path;
130              
131 2         3 $module_version{'version'} = eval {
132 2         20 my $v = ExtUtils::MM->parse_version($path);
133              
134 2 50 50     1871 return $v eq 'undef' ? 0 : $v || 0;
135             };
136              
137 2         5 last;
138             }
139              
140 4         18 return \%module_version;
141             }
142              
143             ########################################################################
144             sub is_core {
145             ########################################################################
146 0     0 0 0 my ( $self, $module_w_version ) = @_;
147              
148 0         0 my ( $module, $version ) = split /\s/xsm, $module_w_version;
149              
150 0         0 my $core = $FALSE;
151              
152 0         0 my @ms = Module::CoreList->find_modules(qr/\A$module\z/xsm);
153              
154 0 0       0 if (@ms) {
155 0         0 my $first_release = Module::CoreList->first_release($module);
156              
157 0         0 my $first_release_version = version->parse($first_release);
158 0         0 my $min_core_version = $self->get_min_core_version;
159              
160             # consider a module core if its first release was less than some
161             # version of Perl. This is done because CPAN testers don't seem to
162             # test modules against Perls that are older than 5.8.9 - however,
163             # some modules like JSON::PP did not appear until > 5.10
164              
165             # print {*STDERR} "$module: $first_release_version $min_core_version\n";
166              
167 0 0       0 $core = version->parse($first_release_version)
168             <= version->parse($min_core_version) ? 1 : 0;
169              
170             }
171              
172             # print {*STDERR} "$module: [$core]\n";
173              
174 0         0 return $core;
175             }
176              
177             ########################################################################
178             sub parse_line { ## no critic (Subroutines::ProhibitExcessComplexity)
179             ########################################################################
180 8     8 0 17 my ( $self, $line ) = @_;
181              
182 8         158 my $fh = $self->get_handle;
183              
184             # skip the "= <<" block
185 8 50 33     78 if ( $line =~ /\A\s*(?:my\s*)?\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/xsm
186             || $line =~ /\A\s*(?:my\s*)?\$(.*)\s*=\s*<<(\w+)\s*;/xsm ) {
187 0         0 my $tag = $2;
188              
189 0         0 while ( $line = <$fh> ) {
190 0         0 chomp $line;
191              
192 0 0       0 last if $line eq $tag;
193             }
194              
195 0         0 $line = <$fh>;
196              
197 0 0       0 return if !$line;
198              
199             }
200              
201             # skip q{} quoted sections - just hope we don't have curly brackets
202             # within the quote, nor an escaped hash mark that isn't a comment
203             # marker, such as occurs right here. Draw the line somewhere.
204 8 50 33     25 if ( $line =~ /\A.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/xsm
205             && $line !~ /\A\s*require|use\s/xsm ) {
206 0         0 my $tag = $1;
207              
208 0         0 $tag =~ tr/{\(\[\#|\//})]#|\//;
209 0         0 $tag = quotemeta $tag;
210              
211 0         0 while ( $line = <$fh> ) {
212 0 0       0 last if $line =~ /$tag/xsm;
213             }
214              
215 0 0       0 return if !$line;
216             }
217              
218             # skip the documentation
219              
220             # we should not need to have item in this if statement (it
221             # properly belongs in the over/back section) but people do not
222             # read the perldoc.
223              
224 8 50       14 if ( $line =~ /\A=(head[\d]|pod|for|item)/xsm ) {
225              
226 0         0 while ( $line = <$fh> ) {
227 0 0       0 last if $line =~ /\A^=cut/xsm;
228             }
229              
230 0 0       0 return if !$line;
231             }
232              
233 8 50       15 if ( $line =~ /\A=over/xsm ) {
234 0         0 while ( $line = <$fh> ) {
235 0 0       0 last if /\A=back/xsm;
236             }
237              
238 0 0       0 return if !$line;
239             }
240              
241             # skip the data section
242 8 50       12 return if $line =~ /\A__(DATA|END)__/xsm;
243              
244 8         27 my $modver_re = qr/[.\d]+/xsm;
245              
246             #
247             # The (require|use) match further down in this subroutine will match lines
248             # within a multi-line print or return statements. So, let's skip over such
249             # statements whose content should not be loading modules anyway. -BEF-
250             #
251 8 50 33     37 if ( $line =~ /print(?:\s+|\s+\S+\s+)\<\<\s*(["'`])(.+?)\1/xsm
      33        
252             || $line =~ /print(\s+|\s+\S+\s+)\<\<(\w+)/xsm
253             || $line =~ /return(\s+)\<\<(\w+)/xsm ) {
254              
255 0         0 my $tag = $2;
256 0         0 while ( $line = <$fh> ) {
257 0         0 chomp $line;
258 0 0       0 last if $line eq $tag;
259             }
260              
261 0         0 $line = <$fh>;
262              
263 0 0       0 return if !$line;
264             }
265              
266             # Skip multiline print and assign statements
267 8 50 33     50 if ( $line =~ /\$\S+\s*=\s*(")([^"\\]|(\\.))*\z/xsm
      33        
      33        
268             || $line =~ /\$\S+\s*=\s*(')([^'\\]|(\\.))*\z/xsm
269             || $line =~ /print\s+(")([^"\\]|(\\.))*\z/xsm
270             || $line =~ /print\s+(')([^'\\]|(\\.))*\z/xsm ) {
271              
272 0         0 my $quote = $1;
273              
274 0         0 while ( $line = <$fh> ) {
275 0 0       0 last if $line =~ /\A([^\\$quote]|(\\.))*$quote/xsm;
276             }
277              
278 0         0 $line = <$fh>;
279              
280 0 0       0 return if !$line;
281             }
282              
283             # ouch could be in a eval, perhaps we do not want these since we catch
284             # an exception they must not be required
285              
286             # eval { require Term::ReadLine } or die $@;
287             # eval "require Term::Rendezvous;" or die $@;
288             # eval { require Carp } if defined $^S; # If error/warning during compilation,
289              
290             ## no critic (ProhibitComplexRegexes, RequireBracesForMultiline)
291 8 100       238 if (
292             ( $line =~ /\A(\s*) # we hope the inclusion starts the line
293             (require|use)\s+(?![{]) # do not want 'do {' loops
294             # quotes around name are always legal
295             ['"]?([\w:.\/]+?)['"]?[\t; ]
296             # the syntax for 'use' allows version requirements
297             # the latter part is for "use base qw(Foo)" and friends special case
298             \s*($modver_re|(qw\s*[{(\/'"]\s*|['"])[^})\/"'\$]*?\s*[})\/"'])?/xsm
299             )
300             ) {
301              
302             # \s*($modver_re|(qw\s*[(\/'"]\s*|['"])[^)\/"'\$]*?\s*[)\/"'])?
303              
304 6         27 my ( $whitespace, $statement, $module, $version ) = ( $1, $2, $3, $4 );
305              
306 6   66     25 $version //= $EMPTY;
307              
308             #print {*STDERR} "$whitespace, $statement, $module, $version\n";
309              
310             # fix misidentification of version when use parent qw{ Foo };
311             #
312             # Pragmatism dictates that I just identify the misidentification
313             # instead of trying to make the regexp above even more
314             # complicated...
315              
316 6 50 66     44 if ( $statement eq 'use' && $module =~ /(parent|base)/xsm ) {
317 0 0       0 if ( $version =~ /\A\s*qw?\s*['"{(\/]\s*([^'")}\/]+)\s*['")}\/]/xsm ) {
    0          
318 0         0 $module = $1;
319 0         0 $version = $EMPTY;
320             }
321             elsif ( $version =~ /\A\s*['"]([^"']+)['"]\s*\z/xsm ) {
322 0         0 $module = $1;
323 0         0 $version = $EMPTY;
324             }
325             }
326              
327             #print {*STDERR} "$whitespace, $statement, $module, $version\n";
328              
329             #
330              
331             # we only consider require statements that are flushed against
332             # the left edge. any other require statements give too many
333             # false positives, as they are usually inside of an if statement
334             # as a fallback module or a rarely used option
335              
336 6 50       121 if ( !$self->get_include_require ) {
    0          
337 6 50 33     42 return $line if $whitespace ne $EMPTY && $statement eq 'require';
338             }
339             elsif ( $statement eq 'require' ) {
340 0 0       0 return $line if $line =~ /\$/xsm; # eval?
341             }
342              
343             # if there is some interpolation of variables just skip this
344             # dependency, we do not want
345             # do "$ENV{LOGDIR}/$rcfile";
346              
347 6 50       48 return $line if $module =~ /\$/xsm;
348              
349             # skip if the phrase was "use of" -- shows up in gimp-perl, et al.
350 6 50       11 return $line if $module eq 'of';
351              
352             # if the module ends in a comma we probably caught some
353             # documentation of the form 'check stuff,\n do stuff, clean
354             # stuff.' there are several of these in the perl distribution
355              
356 6 50       15 return $line if $module =~ /[,>]\z/xsm;
357              
358             # if the module name starts in a dot it is not a module name.
359             # Is this necessary? Please give me an example if you turn this
360             # back on.
361              
362             # ($module =~ m/^\./) && next;
363              
364             # if the module starts with /, it is an absolute path to a file
365 6 50       10 if ( $module =~ /\A\//xsm ) {
366 0         0 $self->add_require($module);
367 0         0 return $line;
368             }
369              
370             # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc.
371             # we can strip qw.*$, as well as (.*$:
372 6         9 $module =~ s/qw.*\z//xsm;
373 6         9 $module =~ s/[(].*\z//xsm;
374              
375             # if the module ends with .pm, strip it to leave only basename.
376 6         7 $module =~ s/[.]pm\z//xsm;
377              
378             # some perl programmers write 'require URI/URL;' when
379             # they mean 'require URI::URL;'
380              
381 6         8 $module =~ s/\//::/xsm;
382              
383             # trim off trailing parentheses if any. Sometimes people pass
384             # the module an empty list.
385              
386 6         6 $module =~ s/[(]\s*[)]$//xsm;
387              
388 6 50       17 if ( $module =~ /\Av?([\d._]+)\z/xsm ) {
389             # if module is a number then both require and use interpret that
390             # to mean that a particular version of perl is specified
391              
392 0         0 my $ver = $1;
393              
394 0         0 $self->get_perlreq->{'perl'} = $ver;
395              
396 0         0 return $line;
397              
398             }
399              
400             # ph files do not use the package name inside the file.
401             # perlmodlib documentation says:
402              
403             # the .ph files made by h2ph will probably end up as
404             # extension modules made by h2xs.
405              
406             # so do not expend much effort on these.
407              
408             # there is no easy way to find out if a file named systeminfo.ph
409             # will be included with the name sys/systeminfo.ph so only use the
410             # basename of *.ph files
411              
412 6 50       12 return $line if $module =~ /[.]ph\z/xsm;
413              
414             # use base|parent qw(Foo) dependencies
415 6 50 33     23 if ( $statement eq 'use'
      66        
416             && ( $module eq 'base' || $module eq 'parent' ) ) {
417 0         0 $self->add_require( $module, $version );
418             #print {*STDERR}
419             # "statement: $statement module: $module, version: $version\n";
420              
421 0 0       0 if ( $version =~ /\Aqw\s*[{(\/'"]\s*([^)}\/"']+?)\s*[})\/"']/xsm ) {
    0          
422 0         0 foreach ( split $SPACE, $1 ) {
423 0         0 $self->add_require( $line, undef );
424             }
425             }
426             elsif ( $version =~ /(["'])([^"']+)\1/xsm ) {
427 0         0 $self->add_require( $2, undef );
428             }
429              
430 0         0 return $line;
431             }
432              
433 6 50 66     44 if ( $version && $version !~ /\A$modver_re\z/oxsm ) {
434 0         0 $version = undef;
435             }
436             #print {*STDERR}
437             # "statement: $statement module: $module, version: $version\n";
438              
439 6         17 my @module_list = split /\s+/xsm, $module;
440              
441 6 50       15 if ( @module_list > 1 ) {
442 0         0 for (@module_list) {
443 0         0 $self->add_require( $_, $EMPTY );
444             }
445             }
446             else {
447 6         15 $self->add_require( $module, $version );
448             }
449             }
450              
451 8         76 return $line;
452             }
453              
454             ########################################################################
455             sub parse {
456             ########################################################################
457 2     2 1 15 my ( $self, $script ) = @_;
458              
459 2 50       36 if ( my $file = $self->get_path ) {
460 0         0 chomp $file;
461              
462 0 0       0 open my $fh, '<', $file ## no critic (InputOutput::RequireBriefOpen)
463             or croak "could not open file '$file' for reading: $OS_ERROR";
464              
465 0         0 $self->set_handle($fh);
466             }
467              
468 2 50 33     49 if ( !$self->get_handle && $script ) {
    50          
469 0         0 $self->set_handle( IO::Scalar->new($script) );
470             }
471             elsif ( !$self->get_handle ) {
472 0 0       0 open my $fh, '<&STDIN' ## no critic (InputOutput::RequireBriefOpen)
473             or croak 'could not open STDIN';
474              
475 0         0 $self->set_handle($fh);
476             }
477              
478 2         94 my $fh = $self->get_handle;
479              
480 2         38 while ( my $line = <$fh> ) {
481 8 50       17 last if !$self->parse_line($line);
482             }
483              
484             # only close the file if we opened...
485 2 50       55 if ( $self->get_path ) {
486 0 0       0 close $fh
487             or croak 'could not close file ' . $self->get_path . "$OS_ERROR\n";
488             }
489              
490 2         12 my @sorted_dependencies = sort keys %{ $self->get_require };
  2         37  
491              
492 2         32 return @sorted_dependencies;
493             }
494              
495             ########################################################################
496             #
497             # To be honest, I'm really not sure what the code below should do
498             # other than simply put the version number in the hash. I can only
499             # surmise that if the original script was running in the context of a
500             # list of perl scripts in a project AND one script specified an older
501             # version of a module, then that version is replace with the newer
502             # version.
503             #
504             # In our implementation here, the typical use case (I think) will be
505             # for an instance of Module::ScanDeps::Static to parse one
506             # script. However, it is possible for the instance to scan multiple
507             # files by calling "parse()" iteratively, accumulating the
508             # dependencies along the way. In that case this method's actions
509             # appear to be relevant.
510             #
511             # Thinking through the above use case and the way it is being
512             # implemented might indicate a "bug", or at least a design flaw. Take
513             # the case where two Perl scripts (presumably in the same project
514             # considering that this utility was written for packaging RPMs)
515             # require different versions of the same module. Rare, and odd, but
516             # possible - although one might wonder why the author of these scripts
517             # didn't resolve any conflicts between the modules so that he could
518             # use one version of said module.
519             #
520             # In any event this method enforces a single version of the module
521             # (the highest) as the answer to the question what version of
522             # __fill_in_the_blank__ module do I require?
523             #
524             # The original method did not attempt to find the version of the
525             # module on the system where this script was being executed. This
526             # implementation does try to do that if you've sent the "add_version"
527             # option to a true value.
528             ########################################################################
529              
530             ########################################################################
531             sub add_require {
532             ########################################################################
533 6     6 0 13 my ( $self, $module, $newver ) = @_;
534              
535 6   33     16 $newver //= $EMPTY;
536              
537 6         18 $module =~ s/\A\s*//xsm;
538 6         21 $module =~ s/\s*\z//xsm;
539              
540 6         135 my $require = $self->get_require;
541              
542 6         28 my $oldver = $require->{$module};
543              
544 6 50       13 if ($oldver) {
    100          
545 0 0 0     0 if ( $HAVE_VERSION && $newver && version->new($oldver) < $newver ) {
      0        
546 0         0 $require->{$module} = $newver;
547             }
548             }
549             elsif ( !$newver ) {
550 4         8 my $m = {};
551              
552 4 50       73 if ( $self->get_add_version ) {
553 4         24 $m = $self->get_module_version($module);
554             }
555              
556 4   66     21 $require->{$module} = $m->{'version'} // $EMPTY;
557             }
558             else {
559 2   33     6 $require->{$module} = $newver // $EMPTY;
560             }
561              
562 6         31 return $self;
563             }
564              
565             ########################################################################
566             sub format_json {
567             ########################################################################
568 0     0 0   my ( $self, @requirements ) = @_;
569              
570 0           my %perlreq = %{ $self->get_perlreq };
  0            
571              
572 0           my %requires = %{ $self->get_require };
  0            
573              
574 0 0         if ( exists $perlreq{'perl'} ) {
575 0           my $perl_version = $perlreq{'perl'};
576              
577 0 0 0       if ( !$perl_version && $self->get_add_version ) {
578 0           $perl_version = $PERL_VERSION;
579             }
580              
581 0   0       push @requirements,
582             {
583             name => 'perl',
584             version => $perl_version // $EMPTY
585             };
586             }
587              
588 0           foreach my $m ( sort keys %requires ) {
589              
590 0 0 0       next if !$self->get_core && $self->is_core($m);
591              
592             push @requirements,
593             {
594             name => $m,
595 0           version => $requires{$m}
596             };
597             }
598              
599 0           my $json = JSON::PP->new->pretty;
600              
601 0 0         return wantarray ? @requirements : $json->encode( \@requirements );
602             }
603              
604             ########################################################################
605             sub get_dependencies {
606             ########################################################################
607 0     0 1   my ( $self, %options ) = @_;
608              
609 0 0 0       if ( $options{json} || $self->get_json ) {
    0 0        
      0        
610 0           return scalar $self->format_json;
611             }
612             elsif ( $options{text} || $self->get_text || $self->get_raw ) {
613 0           return $self->format_text;
614             }
615             else {
616 0           return $self->format_json;
617             }
618             }
619              
620             ########################################################################
621             sub format_text {
622             ########################################################################
623 0     0 0   my ($self) = @_;
624              
625 0           my @requirements = $self->format_json;
626 0 0         return if !@requirements;
627              
628 0           my $str = $EMPTY;
629              
630 0           my $max_len = 2 + max map { length $_->{'name'} } @requirements;
  0            
631              
632 0           my @output;
633              
634 0           foreach my $module (@requirements) {
635 0           my ( $name, $version ) = @{$module}{qw{ name version }};
  0            
636              
637 0           my $separator = $self->get_separator;
638 0           my $format = "%-${max_len}s%s'%s',";
639              
640 0 0         if ( $self->get_raw ) {
641 0           $separator = $SPACE;
642 0           $format = "%-${max_len}s%s%s";
643             }
644             else {
645 0           $name = "'$name'";
646             }
647              
648 0   0       push @output, sprintf $format, $name, $separator, $version // $EMPTY;
649             }
650              
651 0           return join $NEWLINE, @output, $EMPTY;
652             }
653              
654             ########################################################################
655             sub to_rpm {
656             ########################################################################
657 0     0 0   my ($self) = @_;
658              
659 0           my @rpm_deps = ();
660              
661 0           foreach my $perlver ( sort keys %{ $self->get_perlreq } ) {
  0            
662 0           push @rpm_deps, "perl >= $perlver";
663             }
664              
665 0           my %require = %{ $self->get_require };
  0            
666              
667 0           foreach my $module ( sort keys %require ) {
668 0 0 0       next if !$self->get_core && $self->is_core($module);
669              
670 0 0         if ( !$require{$module} ) {
671 0           my $m;
672              
673 0 0         if ( $self->get_add_version ) {
674 0           $m = $self->get_module_version($module);
675 0 0         if ( $m->{'version'} ) {
676 0           $require{$module} = $m->{'version'};
677              
678 0           push @rpm_deps, "perl($module) >= %s", $m->{'version'};
679             }
680             }
681              
682 0 0 0       if ( !$m || !$m->{'version'} ) {
683 0           push @rpm_deps, "perl($module)";
684             }
685             }
686             else {
687 0           push @rpm_deps, "perl($module) >= $require{$module}";
688             }
689             }
690              
691 0           return join $EMPTY, @rpm_deps;
692             }
693              
694             ########################################################################
695             sub main {
696             ########################################################################
697              
698 0     0 0   my %options = (
699             core => $TRUE,
700             'add-version' => $TRUE,
701             'include-require' => $TRUE,
702             'json' => $FALSE,
703             'text' => $TRUE,
704             'separator' => q{ => },
705             'min-core-version' => '5.8.9',
706             );
707              
708 0           GetOptions(
709             \%options, 'json|j',
710             'text|t', 'core!',
711             'min-core-version|m=s', 'add-version|a!',
712             'include-require|i!', 'help|h',
713             'separator|s=s', 'version|v',
714             'raw|r',
715             );
716              
717             # print {*STDERR} Dumper( \%options );
718              
719 0 0         if ( $options{'version'} ) {
720 0           pod2usage(
721             -exitval => 1,
722             -input => pod_where( { -inc => 1 }, __PACKAGE__ ),
723             -sections => 'VERSION|NAME|AUTHOR',
724             -verbose => 99,
725             );
726             }
727              
728 0 0         if ( $options{'help'} ) {
729 0           pod2usage(
730             -exitval => 1,
731             -input => pod_where( { -inc => 1 }, __PACKAGE__ ),
732             -sections => 'USAGE|VERSION',
733             -verbose => 99,
734             );
735             }
736              
737 0           $options{'path'} = shift @ARGV;
738              
739 0           my $scanner = Module::ScanDeps::Static->new( {%options} );
740 0           $scanner->parse;
741              
742 0 0         if ( $options{'json'} ) {
743 0           print $scanner->get_dependencies( format => 'json' );
744             }
745             else {
746 0           print $scanner->get_dependencies( format => 'text' );
747             }
748              
749 0           exit $SUCCESS;
750             }
751              
752             1;
753              
754             __END__