File Coverage

blib/lib/App/perlimports/Document.pm
Criterion Covered Total %
statement 317 379 83.6
branch 115 152 75.6
condition 71 90 78.8
subroutine 57 63 90.4
pod 3 3 100.0
total 563 687 81.9


line stmt bran cond sub pod time code
1             package App::perlimports::Document;
2              
3 75     75   1243759 use Moo;
  75         604082  
  75         394  
4 75     75   146671 use utf8;
  75         1122  
  75         419  
5              
6             our $VERSION = '0.000052';
7              
8 75     75   35038 use App::perlimports::Annotations ();
  75         356  
  75         2425  
9 75     75   40726 use App::perlimports::ExportInspector ();
  75         407  
  75         2860  
10 75     75   41482 use App::perlimports::Include ();
  75         378  
  75         2701  
11 75     75   597 use App::perlimports::Sandbox ();
  75         194  
  75         1690  
12 75     75   438 use File::Basename qw( fileparse );
  75         193  
  75         8479  
13 75     75   638 use List::Util qw( any uniq );
  75         240  
  75         5161  
14 75     75   528 use Module::Runtime qw( module_notional_filename );
  75         220  
  75         885  
15 75     75   3890 use MooX::StrictConstructor;
  75         203  
  75         844  
16 75     75   144164 use Path::Tiny qw( path );
  75         906219  
  75         4438  
17 75     75   678 use PPI::Document ();
  75         234  
  75         1975  
18 75         4612 use PPIx::Utils::Classification qw(
19             is_function_call
20             is_hash_key
21             is_method_call
22 75     75   516 );
  75         234  
23 75     75   562 use Ref::Util qw( is_plain_arrayref is_plain_hashref );
  75         260  
  75         4047  
24 75     75   516 use Scalar::Util qw( refaddr );
  75         212  
  75         3803  
25 75     75   549 use Sub::HandlesVia;
  75         2840  
  75         829  
26 75     75   61193 use Text::Diff ();
  75         527736  
  75         2341  
27 75     75   576 use Try::Tiny qw( catch try );
  75         187  
  75         4736  
28 75     75   538 use Types::Standard qw( ArrayRef Bool HashRef InstanceOf Maybe Object Str );
  75         225  
  75         710  
29              
30             with 'App::perlimports::Role::Logger';
31              
32             has _annotations => (
33             is => 'ro',
34             isa => InstanceOf ['App::perlimports::Annotations'],
35             lazy => 1,
36             default => sub {
37             return App::perlimports::Annotations->new(
38             ppi_document => shift->ppi_document );
39             },
40             );
41              
42             has _cache => (
43             is => 'ro',
44             isa => Bool,
45             init_arg => 'cache',
46             lazy => 1,
47             default => 0,
48             );
49              
50             has _cache_dir => (
51             is => 'ro',
52             isa => InstanceOf ['Path::Tiny'],
53             lazy => 1,
54             builder => '_build_cache_dir',
55             );
56              
57             has _filename => (
58             is => 'ro',
59             isa => Str,
60             init_arg => 'filename',
61             required => 1,
62             );
63              
64             has _ignore_modules => (
65             is => 'ro',
66             isa => HashRef,
67             init_arg => 'ignore_modules',
68             default => sub { +{} },
69             );
70              
71             has _ignore_modules_pattern => (
72             is => 'ro',
73             isa => ArrayRef [Str],
74             init_arg => 'ignore_modules_pattern',
75             default => sub { [] },
76             );
77              
78             has includes => (
79             is => 'ro',
80             isa => ArrayRef [Object],
81             handles_via => 'Array',
82             handles => {
83             all_includes => 'elements',
84             },
85             lazy => 1,
86             builder => '_build_includes',
87             );
88              
89             has _inspectors => (
90             is => 'ro',
91             isa => HashRef [ Maybe [Object] ],
92             handles_via => 'Hash',
93             handles => {
94             all_inspector_names => 'keys',
95             _get_inspector_for => 'get',
96             _has_inspector_for => 'exists',
97             _set_inspector_for => 'set',
98             },
99             lazy => 1,
100             default => sub { +{} },
101             );
102              
103             has interpolated_symbols => (
104             is => 'ro',
105             isa => HashRef,
106             lazy => 1,
107             builder => '_build_interpolated_symbols',
108             );
109              
110             has json => (
111             is => 'ro',
112             isa => Bool,
113             lazy => 1,
114             default => 0,
115             );
116              
117             has _json_encoder => (
118             is => 'ro',
119             isa => InstanceOf ['Cpanel::JSON::XS'],
120             lazy => 1,
121             default => sub {
122             require Cpanel::JSON::XS;
123             return Cpanel::JSON::XS->new;
124             },
125             );
126              
127             has lint => (
128             is => 'ro',
129             isa => Bool,
130             lazy => 1,
131             default => 0,
132             );
133              
134             has my_own_inspector => (
135             is => 'ro',
136             isa => Maybe [ InstanceOf ['App::perlimports::ExportInspector'] ],
137             lazy => 1,
138             builder => '_build_my_own_inspector',
139             );
140              
141             has never_exports => (
142             is => 'ro',
143             isa => HashRef,
144             lazy => 1,
145             builder => '_build_never_exports',
146             );
147              
148             has _never_export_modules => (
149             is => 'ro',
150             isa => ArrayRef [Str],
151             init_arg => 'never_export_modules',
152             predicate => '_has_never_export_modules',
153             );
154              
155             has original_imports => (
156             is => 'ro',
157             isa => HashRef,
158             handles_via => 'Hash',
159             handles => {
160             _reset_original_import => 'set',
161             },
162             lazy => 1,
163             builder => '_build_original_imports',
164             );
165              
166             has _padding => (
167             is => 'ro',
168             isa => Bool,
169             init_arg => 'padding',
170             default => 1,
171             );
172              
173             has ppi_document => (
174             is => 'ro',
175             isa => Object,
176             lazy => 1,
177             builder => '_build_ppi_document',
178             );
179              
180             has possible_imports => (
181             is => 'ro',
182             isa => ArrayRef [Object],
183             lazy => 1,
184             builder => '_build_possible_imports',
185             );
186              
187             has _ppi_selection => (
188             is => 'ro',
189             isa => Object,
190             init_arg => 'ppi_selection',
191             lazy => 1,
192             default => sub { $_[0]->ppi_document },
193             );
194              
195             has _preserve_duplicates => (
196             is => 'ro',
197             isa => Bool,
198             init_arg => 'preserve_duplicates',
199             default => 1,
200             );
201              
202             has _preserve_unused => (
203             is => 'ro',
204             isa => Bool,
205             init_arg => 'preserve_unused',
206             default => 1,
207             );
208              
209             has _sub_exporter_export_list => (
210             is => 'ro',
211             isa => ArrayRef,
212             handles_via => 'Array',
213             handles => {
214             sub_exporter_export_list => 'elements',
215             },
216             lazy => 1,
217             builder => '_build_sub_exporter_export_list',
218             );
219              
220             has _sub_names => (
221             is => 'ro',
222             isa => HashRef,
223             handles_via => 'Hash',
224             handles => {
225             is_sub_name => 'exists',
226             },
227             lazy => 1,
228             builder => '_build_sub_names',
229             );
230              
231             has _tidy_whitespace => (
232             is => 'ro',
233             isa => Bool,
234             init_arg => 'tidy_whitespace',
235             lazy => 1,
236             default => sub { 1 },
237             );
238              
239             has _verbose => (
240             is => 'ro',
241             isa => Bool,
242             init_arg => 'verbose',
243             default => sub { 0 },
244             );
245              
246             around BUILDARGS => sub {
247             my ( $orig, $class, @args ) = @_;
248              
249             my %args = @args;
250             if ( my $modules = delete $args{ignore_modules} ) {
251             my %modules = map { $_ => 1 } @{$modules};
252             $args{ignore_modules} = \%modules;
253             }
254              
255             if ( my $selection = delete $args{selection} ) {
256             $args{ppi_selection} = PPI::Document->new( \$selection );
257             }
258              
259             return $class->$orig(%args);
260             };
261              
262             my %default_ignore = (
263             'Carp::Always' => 1,
264             'Constant::Generate' => 1,
265             'Data::Printer' => 1,
266             'DDP' => 1,
267             'Devel::Confess' => 1,
268             'Encode::Guess' => 1,
269             'Env' => 1, # see t/env.t
270             'Exception::Class' => 1,
271             'Exporter' => 1,
272             'Exporter::Lite' => 1,
273             'Feature::Compat::Try' => 1,
274             'Filter::Simple' => 1,
275             'Git::Sub' => 1,
276             'HTTP::Message::PSGI' => 1, # HTTP::Request::(to|from)_psgi
277             'Import::Into' => 1,
278             'MLDBM' => 1,
279             'Modern::Perl' => 1,
280             'Mojo::Base' => 1,
281             'Mojo::Date' => 1,
282             'Mojolicious::Lite' => 1,
283             'Moo' => 1,
284             'Moo::Role' => 1,
285             'Moose' => 1,
286             'Moose::Exporter' => 1,
287             'Moose::Role' => 1,
288             'MooseX::NonMoose' => 1,
289             'MooseX::Role::Parameterized' => 1,
290             'MooseX::SemiAffordanceAccessor' => 1,
291             'MooseX::StrictConstructor' => 1,
292             'MooseX::TraitFor::Meta::Class::BetterAnonClassNames' => 1,
293             'MooseX::Types' => 1,
294             'MooX::StrictConstructor' => 1,
295             'namespace::autoclean' => 1,
296             'PerlIO::gzip' => 1,
297             'Regexp::Common' => 1,
298             'Sort::ByExample' => 1,
299             'Struct::Dumb' => 1,
300             'Sub::Exporter' => 1,
301             'Sub::Exporter::Progressive' => 1,
302             'Sub::HandlesVia' => 1,
303             'Syntax::Keyword::Try' => 1,
304             'Term::Size::Any' => 1,
305             'Test2::Util::HashBase' => 1,
306             'Test::Exception' => 1,
307             'Test::Needs' => 1,
308             'Test::Number::Delta' => 1,
309             'Test::Pod' => 1,
310             'Test::Pod::Coverage' => 1,
311             'Test::Requires::Git' => 1,
312             'Test::RequiresInternet' => 1,
313             'Test::Warnings' => 1,
314             'Test::Whitespaces' => 1,
315             'Test::XML' => 1,
316             'Types::Standard' => 1,
317             'URI::QueryParam' => 1,
318             );
319              
320             # Funky stuff could happen with inner packages.
321             sub _build_my_own_inspector {
322 32     32   1680 my $self = shift;
323             my $pkgs
324             = $self->ppi_document->find(
325 32 100   1763   646 sub { $_[1]->isa('PPI::Statement::Package') && $_[1]->file_scoped } );
  1763         20611  
326              
327 32 100 66     659 if ( !$pkgs || $pkgs->[0]->namespace eq 'main' ) {
328 31         727 return;
329             }
330              
331 1         31 my $pkg = $pkgs->[0];
332              
333             # file_scoped() doesn't seem to be very reliable, so let's just try a crude
334             # check to see if this is a package we might actually find on disk before
335             # we try to require it.
336 1         4 my $notional_file
337             = fileparse( module_notional_filename( $pkg->namespace ) );
338 1         114 my $provided_file = fileparse( $self->_filename );
339 1 50       5 return unless $notional_file eq $provided_file;
340              
341 1         7 return App::perlimports::ExportInspector->new(
342             logger => $self->logger,
343             module_name => $pkg->namespace,
344             );
345             }
346              
347             sub _build_includes {
348 52     52   1363 my $self = shift;
349              
350             # version() returns a value if this a dependency on a version of Perl, e.g
351             # use 5.006;
352             # require 5.006;
353             #
354             # We check for type so that we can filter out undef types or "no".
355              
356             ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
357             return $self->_ppi_selection->find(
358             sub {
359 2015     2015   255591 $_[1]->isa('PPI::Statement::Include')
360             && !$_[1]->pragma # no pragmas
361             && !$_[1]->version # Perl version requirement
362             && $_[1]->type
363             && ( $_[1]->type eq 'use'
364             || $_[1]->type eq 'require' )
365             && !$self->_is_ignored( $_[1] )
366             && !$self->_has_import_switches( $_[1]->module )
367             && !App::perlimports::Sandbox::eval_pkg(
368             $_[1]->module,
369             "$_[1]"
370             );
371             }
372 52   100     1135 ) || [];
373             ## use critic
374             }
375              
376             sub _build_possible_imports {
377 34     34   628 my $self = shift;
378             my $before = $self->ppi_document->find(
379             sub {
380 1883     1883   33221 $_[1]->isa('PPI::Token::Word')
381             || $_[1]->isa('PPI::Token::Symbol')
382             || $_[1]->isa('PPI::Token::Label')
383             || $_[1]->isa('PPI::Token::Prototype');
384             }
385 34   50     728 ) || [];
386              
387 34         654 my @after;
388 34         107 for my $word ( @{$before} ) {
  34         140  
389              
390             # Without the sub name check, we accidentally turn
391             # use List::Util ();
392             # sub any { }
393             #
394             # into
395             #
396             # use List::Util qw( any );
397             # sub any {}
398 421 100       1462 next if $self->is_sub_name("$word");
399              
400 408 100 100     10155 next if !$word->isa('PPI::Token::Symbol') && is_method_call($word);
401              
402 404 100       13300 next if $self->_is_word_interpreted_as_string($word);
403              
404 399         2295 push @after, $word;
405             }
406              
407 34         1151 return \@after;
408             }
409              
410             sub _build_ppi_document {
411 53     53   893 my $self = shift;
412 53         642 return PPI::Document->new( $self->_filename );
413             }
414              
415             # Create a key for every included module.
416             # use Carp;
417             # use Data::Dumper qw( Dumper );
418             # use POSIX ();
419             #
420             # becomes:
421             #
422             # {
423             # Carp => undef,
424             # 'Data::Dumper' => ['Dumper'],
425             # POSIX => [],
426             # }
427             #
428             # The name is a bit of a misnomer. It starts out as a list of original imports,
429             # but with each include that gets processed, this list also gets updated. We do
430             # this so that we can keep track of what previous modules are really importing.
431             # Might not be bad to rename this.
432              
433             sub _build_original_imports {
434 41     41   993 my $self = shift;
435              
436             # We're missing requires which could be followed by an import.
437             my $found = $self->ppi_document->find(
438             sub {
439 2195     2195   55343 $_[1]->isa('PPI::Statement::Include')
440             && !$_[1]->pragma # no pragmas
441             && !$_[1]->version # Perl version requirement
442             && $_[1]->type
443             && $_[1]->type eq 'use';
444             }
445 41   50     817 ) || [];
446              
447 41         867 my %imports;
448              
449 41         165 for my $include ( @{$found} ) {
  41         222  
450 64         253 my $pkg = $include->module;
451 64 100       2032 $imports{$pkg} = undef unless exists $imports{$pkg};
452              
453             # this is probably wrong
454             #next if $self->_is_ignored($pkg);
455              
456             # If a module has been included multiple times, we want to have a
457             # cumulative tally of what has been explicitly imported.
458 64         336 my $found_for_include = _imports_for_include($include);
459 64 100       285 if ($found_for_include) {
460 29 100       116 if ( $imports{$pkg} ) {
461 2         5 push @{ $imports{$pkg} }, @{$found_for_include};
  2         6  
  2         7  
462             }
463             else {
464 27         94 $imports{$pkg} = $found_for_include;
465             }
466             }
467             }
468              
469 41         1179 return \%imports;
470             }
471              
472             sub _build_sub_exporter_export_list {
473 32     32   462 my $self = shift;
474              
475             my $sub_ex = $self->ppi_document->find(
476             sub {
477 1763     1763   23935 $_[1]->isa('PPI::Statement::Include')
478             && $_[1]->module eq 'Sub::Exporter';
479             }
480 32   100     705 ) || [];
481 32 100       667 return [] unless @{$sub_ex};
  32         229  
482              
483 1         2 my @found;
484 1         3 for my $include ( @{$sub_ex} ) {
  1         4  
485 1         6 my @arguments = $include->arguments;
486 1         52 for my $arg (@arguments) {
487 3 100       16 if ( $arg->isa('PPI::Structure::Constructor') ) {
488             ## no critic (BuiltinFunctions::ProhibitStringyEval)
489 1         6 my $thing = eval $arg;
490 1 50       10 if ( is_plain_hashref($thing) ) {
491 1 50       5 if ( is_plain_arrayref( $thing->{exports} ) ) {
492 1         3 push @found, @{ $thing->{exports} };
  1         6  
493             }
494             }
495             }
496             }
497             }
498              
499 1         11 return [ uniq @found ];
500             }
501              
502             sub _imports_for_include {
503 100     100   1298 my $include = shift;
504              
505 100         267 my $imports = undef;
506              
507 100         686 for my $child ( $include->schildren ) {
508 402 100 66     6248 if ( $child->isa('PPI::Structure::List')
509             && !defined $imports ) {
510 14         148 $imports = [];
511             }
512 402 100 100     2358 if ( !$child->isa('PPI::Token::QuoteLike::Words')
513             && !$child->isa('PPI::Token::Quote::Single') ) {
514 351         854 next;
515             }
516 51 100       231 if ( defined $imports ) {
517 4         6 push( @{$imports}, $child->literal );
  4         9  
518             }
519             else {
520 47         324 $imports = [ $child->literal ];
521             }
522             }
523 100         509 return $imports;
524             }
525              
526             sub _extract_symbols_from_snippet {
527 15     15   145 my $snippet = shift;
528 15 50       115 return () unless defined $snippet;
529              
530             # Restore line breaks and tabs
531 15         64 $snippet =~ s{\\n}{\n}g;
532 15         40 $snippet =~ s{\\t}{\t}g;
533              
534 15         107 my $doc = PPI::Document->new( \$snippet );
535 15 100       21750 return () unless defined $doc;
536              
537             my @symbols
538 14 100       37 = map { $_ . q{} } @{ $doc->find('PPI::Token::Symbol') || [] };
  6         2575  
  14         67  
539              
540 14   100     2947 my $casts = $doc->find('PPI::Token::Cast') || [];
541 14         4861 for my $cast ( @{$casts} ) {
  14         61  
542              
543             # Optimistically avoid misinterpreting regex assertions as casts
544             # We don't want to match on "A" in the following example:
545             # if ( $thing =~ m{ \A b }x ) { ... }
546 5 100       306 next if $cast eq '\\';
547              
548 3         96 my $full_cast = $cast . $cast->snext_sibling;
549 3         376 my $cast_as_doc = PPI::Document->new( \$full_cast );
550             push @symbols,
551 1         607 map { $_ . q{} }
552 3 100       5691 @{ $cast_as_doc->find('PPI::Token::Symbol') || [] };
  3         17  
553              
554 3   50     1211 my $words = $cast_as_doc->find('PPI::Token::Word') || [];
555              
556             ## Turn ${FOO} into $FOO
557 3 100 66     1699 if ( $words
      100        
558             && scalar @$words == 1
559             && $full_cast =~ m/([\$\@\%])\{$words->[0]}/ ) {
560 1         43 push @symbols, $1 . $words->[0];
561 1         14 next;
562             }
563              
564             # This could likely be a source of false positives.
565 2         33 for my $word (@$words) {
566 3 100       408 push @symbols, "$word" if is_function_call($word);
567             }
568             }
569              
570 14         708 return @symbols;
571             }
572              
573             sub _unnest_quotes {
574 12     12   35 my $self = shift;
575 12         25 my $token = shift;
576 12         44 my @words = @_;
577              
578 12 100 100     132 if ( !$token->isa('PPI::Token::Quote')
579             || $token->isa('PPI::Token::Quote::Single') ) {
580 3         19 return @words;
581             }
582              
583 9         76 push @words, _extract_symbols_from_snippet( $token->string );
584              
585 9         735 my $doc = PPI::Document->new( \$token->string );
586 9 100       12649 return @words unless $doc;
587              
588 8         36 my $quotes = $doc->find('PPI::Token::Quote');
589 8 100       3395 return @words unless $quotes;
590              
591 3         10 for my $q (@$quotes) {
592 3         16 push @words, _extract_symbols_from_snippet("$q");
593 3         133 push @words, $self->_unnest_quotes($q);
594             }
595              
596 3         179 return @words;
597             }
598              
599             sub _build_interpolated_symbols {
600 33     33   984 my $self = shift;
601 33         93 my @symbols;
602              
603 33         80 for my $token (
604             @{
605             $self->ppi_document->find(
606             sub {
607 1799 50 100 1799   55369 ( $_[1]->isa('PPI::Token::Quote')
      66        
      66        
608             && !$_[1]->isa('PPI::Token::Quote::Single') )
609             || $_[1]->isa('PPI::Token::Quote::Interpolate')
610             || $_[1]->isa('PPI::Token::QuoteLike::Regexp')
611             || $_[1]->isa('PPI::Token::Regexp');
612             }
613             )
614 33 100       630 || []
615             }
616             ) {
617 9 100 66     282 if ( $token->isa('PPI::Token::Regexp')
618             || $token->isa('PPI::Token::QuoteLike::Regexp') ) {
619 1         13 for my $snippet (
620             $token->get_match_string,
621             $token->get_substitute_string,
622             ) {
623 1         52 push @symbols, _extract_symbols_from_snippet($snippet);
624             }
625             }
626              
627 9         171 push @symbols, $self->_unnest_quotes($token);
628             }
629              
630             # Crude hack to catch vars like ${FOO_BAR} in heredocs.
631 33         1099 for my $heredoc (
632             @{
633             $self->ppi_document->find(
634             sub {
635 1799     1799   19988 $_[1]->isa('PPI::Token::HereDoc');
636             }
637             )
638 33 100       872 || []
639             }
640             ) {
641 3         108 my $content = join "\n", $heredoc->heredoc;
642 3 100       31 next if $heredoc =~ m{'};
643 2         19 push @symbols, _extract_symbols_from_snippet($content);
644             }
645              
646             # Catch vars like ${FOO_BAR}. This is probably not good enough.
647 33         699 for my $cast (
648             @{
649             $self->ppi_document->find(
650 1799     1799   20193 sub { $_[1]->isa('PPI::Token::Cast'); }
651             )
652 33 100       737 || []
653             }
654             ) {
655 2 50 33     61 if ( !$cast->snext_sibling
656             || !$cast->snext_sibling->isa('PPI::Structure::Block') ) {
657 0         0 next;
658             }
659              
660 2         108 my $sigil = $cast . q{};
661 2         13 my $sibling = $cast->snext_sibling . q{};
662 2 50       124 if ( $sibling =~ m/{(\w+)}/ ) {
663 2         11 push @symbols, $sigil . $1;
664             }
665             }
666 33         814 my %symbols = map { $_ => 1 } @symbols;
  12         61  
667 33         788 return \%symbols;
668             }
669              
670             # Returns a HashRef of modules which will always be converted to avoid imports.
671             # This is mostly for speed and a matter of convenience so that we don't have to
672             # examine modules (like strictly Object Oriented modules) which we know will
673             # not have anything to export.
674              
675             sub _build_never_exports {
676 36     36   616 my $self = shift;
677              
678 36         410 my %modules = (
679             'App::perlimports::Include' => 1,
680             'File::Spec' => 1,
681             'HTTP::Daemon' => 1,
682             'HTTP::Headers' => 1,
683             'HTTP::Response' => 1,
684             'HTTP::Tiny' => 1,
685             'LWP::UserAgent' => 1,
686             'URI' => 1,
687             'WWW::Mechanize' => 1,
688             );
689              
690 36 50       291 if ( $self->_has_never_export_modules ) {
691 0         0 for my $module ( @{ $self->_never_export_modules } ) {
  0         0  
692 0         0 $modules{$module} = 1;
693             }
694             }
695              
696 36         658 return \%modules;
697             }
698              
699             sub _build_sub_names {
700 34     34   76105 my $self = shift;
701              
702 34         85 my %sub_names;
703 34         85 for my $sub (
704             @{
705             $self->ppi_document->find(
706 1883     1883   21401 sub { $_[1]->isa('PPI::Statement::Sub') }
707             )
708 34 100       857 || []
709             }
710             ) {
711 11         194 my @children = $sub->schildren;
712 11 50 33     243 if ( $children[0] eq 'sub'
713             && $children[1]->isa('PPI::Token::Word') ) {
714 11         302 $sub_names{"$children[1]"} = 1;
715             }
716             }
717              
718 34         744 return \%sub_names;
719             }
720              
721             sub _has_import_switches {
722 54     54   2126 my $self = shift;
723 54         152 my $module_name = shift;
724              
725             # If switches are being passed to import, we can't guess as what is correct
726             # here.
727             #
728             # Getopt::Long uses a leading colon rather than a dash. This overrides
729             # Exporter's defaults. You would normally assume that :config is an export
730             # tag, but instead it's something entirely different.
731             #
732             # use Getopt::Long qw(:config no_ignore_case bundling);
733             #
734             # We will leave this case as broken for the time being. I'm not sure how
735             # common that invocation is.
736              
737 54 100 66     1290 if ( exists $self->original_imports->{$module_name}
738 39     39   480 && any { $_ =~ m{^[\-]} }
739 54 100       2847 @{ $self->original_imports->{$module_name} || [] } ) {
740 1         11 return 1;
741             }
742 53         1096 return 0;
743             }
744              
745             sub _is_used_fully_qualified {
746 13     13   685 my $self = shift;
747 13         28 my $module_name = shift;
748              
749             # We could tighten this up and check that the word following "::" is a sub
750             # which exists in that package.
751             #
752             # Module::function
753             # Module::->new
754             # isa => ArrayRef[Module::]
755             return 1 if $self->ppi_document->find(
756             sub {
757             (
758 2433 100 100 2433   67422 $_[1]->isa('PPI::Token::Word')
      100        
      100        
759             && (
760             $_[1]->content =~ m{\A${module_name}::[a-zA-Z0-9_]*\z}
761             || ( $_[1]->content eq ${module_name}
762             && $_[1]->snext_sibling eq '->' )
763             )
764             )
765             || ( $_[1]->isa('PPI::Token::Symbol')
766             && $_[1] =~ m{\A[*\$\@\%]+${module_name}::[a-zA-Z0-9_]} );
767             }
768 13 100       313 );
769              
770             # We could combine the regexes, but this is easy to read.
771 4         77 for my $key ( keys %{ $self->interpolated_symbols } ) {
  4         121  
772              
773             # package level variable
774 1 50       43 return 1 if $key =~ m{\A[*\$\@\%]+${module_name}::[a-zA-Z0-9_]+\z};
775              
776             # function
777 0 0       0 return 1 if $key =~ m/\A${module_name}::[a-zA-Z0-9_]+\z/;
778             }
779              
780 3         76 return 0;
781             }
782              
783             sub _is_ignored {
784 75     75   18175 my $self = shift;
785 75         179 my $element = shift;
786              
787             my $res
788             = exists $default_ignore{ $element->module }
789             || exists $self->_ignore_modules->{ $element->module }
790             || $self->_annotations->is_ignored($element)
791             || (
792 0     0   0 any { $element->module =~ /$_/ }
793 75   100     256 grep { $_ } @{ $self->_ignore_modules_pattern || [] }
794             )
795             || ( $self->inspector_for( $element->module )
796             && !$self->inspector_for( $element->module )->evals_ok );
797 73         1160 return $res;
798             }
799              
800             sub inspector_for {
801 196     196 1 6489 my $self = shift;
802 196         397 my $module = shift;
803              
804             # This would produce a warning and no helpful information.
805 196 50       587 return undef if $module eq 'Exporter';
806              
807 196 100       813 if ( $self->_has_inspector_for($module) ) {
808 130         3009 return $self->_get_inspector_for($module);
809             }
810              
811 66 50       3609 if ( $self->_cache ) {
812 0         0 require Sereal::Decoder; ## no perlimports
813 0         0 my $decoder = Sereal::Decoder->new( {} );
814 0         0 my $file = $self->_cache_file_for_module($module);
815 0         0 my $inspector;
816 0 0       0 if ( -e $file ) {
817             try {
818 0     0   0 $inspector = $decoder->decode_from_file($file);
819 0         0 $self->_set_inspector_for( $module, $inspector );
820             }
821             catch {
822 0     0   0 $self->logger->error($_);
823 0         0 };
824 0 0       0 if ($inspector) {
825 0         0 $self->logger->info("Using cached version of $module");
826 0         0 $inspector->set_logger( $self->logger );
827 0         0 return $inspector;
828             }
829             }
830             }
831              
832             try {
833 66     66   5122 $self->_set_inspector_for(
834             $module,
835             App::perlimports::ExportInspector->new(
836             logger => $self->logger,
837             module_name => $module,
838             )
839             );
840             }
841             catch {
842 2     2   23375 $self->logger->info( 'inspector_for' . $_ );
843 0         0 $self->_set_inspector_for( $module, undef );
844 66         2836 };
845              
846 64         420706 return $self->_get_inspector_for($module);
847             }
848              
849             sub tidied_document {
850 41     41 1 6364 return shift->_lint_or_tidy_document;
851             }
852              
853             sub linter_success {
854 1     1 1 100 return shift->_lint_or_tidy_document;
855             }
856              
857             # Kind of on odd interface, but right now we return either a tidied document or
858             # the result of linting. Could probably clean this up at some point, but I'm
859             # not sure yet how much the linting will change.
860             sub _lint_or_tidy_document {
861 42     42   124 my $self = shift;
862              
863 42         98 my $linter_error = 0;
864 42         89 my %processed;
865              
866             INCLUDE:
867 42         249 foreach my $include ( $self->all_includes ) {
868              
869             # If a module is used more than once, that's usually a mistake.
870 42 100 100     3263 if ( !$self->_preserve_duplicates
871             && exists $processed{ $include->module } ) {
872              
873 1 50       59 if ( $self->lint ) {
874 0         0 $self->_warn_diff_for_linter(
875             'has already been used and should be removed',
876             $include,
877             $include->content,
878             q{}
879             );
880 0         0 $linter_error = 1;
881 0         0 next INCLUDE;
882             }
883              
884 1         23 $self->logger->info( $include->module
885             . ' has already been used. Removing at line '
886             . $include->line_number );
887 1         157 _remove_with_trailing_characters($include);
888 1         3 next INCLUDE;
889             }
890              
891 41         338 $self->logger->notice( '📦 ' . "Processing include: $include" );
892              
893             my $e = App::perlimports::Include->new(
894             document => $self,
895             include => $include,
896             logger => $self->logger,
897 41         5526 original_imports => $self->original_imports->{ $include->module },
898             pad_imports => $self->_padding,
899             tidy_whitespace => $self->_tidy_whitespace,
900             );
901 41         2420 my $elem;
902             try {
903 41     41   3096 $elem = $e->formatted_ppi_statement;
904             }
905             catch {
906 0     0   0 my $error = $_;
907 0         0 $self->logger->error( 'Error in ' . $self->_filename );
908 0         0 $self->logger->error( 'Trying to format: ' . $include );
909 0         0 $self->logger->error( 'Error is: ' . $error );
910 41         501 };
911              
912 41 50       7404 next INCLUDE unless $elem;
913              
914             # If this is a module with bare imports which is not used anywhere,
915             # maybe we can just remove it.
916 41 100       269 if ( !$self->_preserve_unused ) {
917 15         73 my @args = $elem->arguments;
918              
919 15 100 100     754 if ( $args[0]
      100        
920             && $args[0] eq '()'
921             && !$self->_is_used_fully_qualified( $include->module ) ) {
922              
923 2 50       45 if ( $self->lint ) {
924 0         0 $self->_warn_diff_for_linter(
925             'appears to be unused and should be removed',
926             $include, $include->content,
927             q{}
928             );
929 0         0 $linter_error = 1;
930 0         0 next INCLUDE;
931             }
932              
933 2         94 $self->logger->info( 'Removing '
934             . $include->module
935             . ' as it appears to be unused' );
936 2         277 _remove_with_trailing_characters($include);
937              
938 2         28 next INCLUDE;
939             }
940             }
941              
942             ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
943             # Let's see if the import itself might break something
944 39 100       353 if ( my $err
945             = App::perlimports::Sandbox::eval_pkg( $elem->module, "$elem" ) )
946             {
947 1         9 $self->logger->warning(
948             sprintf(
949             'New include (%s) triggers error (%s)', $elem, $err
950             )
951             );
952 1         132 next INCLUDE;
953             }
954             ## use critic
955              
956 38         356 my $inserted = $include->replace($elem);
957 38 50       3389 if ( !$inserted ) {
958 0         0 $self->logger->error( 'Could not insert ' . $elem );
959             }
960             else {
961 38         172 $processed{ $include->module } = 1;
962              
963 38 100       2083 if ( $self->lint ) {
964             my $before = join q{ },
965 2         24 map { $_->content } $include->arguments;
  1         35  
966 2         40 my $after = join q{ }, map { $_->content } $elem->arguments;
  2         71  
967              
968 2 50       40 if ( $before ne $after ) {
969 2         7 $self->_warn_diff_for_linter(
970             'import arguments need tidying',
971             $include,
972             $include->content,
973             $elem->content
974             );
975 2         121 $linter_error = 1;
976 2         14 next INCLUDE;
977             }
978             }
979              
980 36         1422 $self->logger->info("resetting imports for |$elem|");
981              
982             # Now reset original_imports so that we can account for any changes
983             # when processing includes further down the list.
984 36         4410 my $doc = PPI::Document->new( \"$elem" );
985              
986 36 50       45922 if ( !$doc ) {
987 0         0 $self->logger->error("PPI could not parse $elem");
988             }
989             else {
990             my $new_include
991             = $doc->find(
992 36     288   291 sub { $_[1]->isa('PPI::Statement::Include') } );
  288         3904  
993              
994 36         584 $self->_reset_original_import(
995             $include->module,
996             _imports_for_include( $new_include->[0] )
997             );
998             }
999             }
1000             }
1001              
1002 42         4385 $self->_maybe_cache_inspectors;
1003              
1004             # We need to do serialize in order to preserve HEREDOCs.
1005             # See https://metacpan.org/pod/PPI::Document#serialize
1006 42 100       1538 return $self->lint ? !$linter_error : $self->_ppi_selection->serialize;
1007             }
1008              
1009             sub _warn_diff_for_linter {
1010 2     2   109 my $self = shift;
1011 2         3 my $reason = shift;
1012 2         4 my $include = shift;
1013 2         4 my $before = shift;
1014 2         4 my $after = shift;
1015 2         5 my $after_deleted = !$after;
1016              
1017 2         4 my $json;
1018             my $justification;
1019              
1020 2 50       43 if ( $self->json ) {
1021              
1022 0         0 my $loc = { start => { line => $include->line_number } };
1023 0         0 my $content = $include->content;
1024 0         0 my @lines = split( m{\n}, $content );
1025              
1026 0 0       0 if ( $lines[0] =~ m{[^\s]} ) {
1027 0         0 $loc->{start}->{column} = @-;
1028             }
1029 0         0 $loc->{end}->{line} = $include->line_number + @lines - 1;
1030 0         0 $loc->{end}->{column} = length( $lines[-1] );
1031              
1032 0         0 $json = {
1033             filename => $self->_filename,
1034             location => $loc,
1035             module => $include->module,
1036             reason => $reason,
1037             };
1038             }
1039             else {
1040 2         51 $justification = sprintf(
1041             '❌ %s (%s) at %s line %i',
1042             $include->module, $reason, $self->_filename, $include->line_number
1043             );
1044             }
1045              
1046 2         127 my $padding = $include->line_number - 1;
1047 2         43 $before = sprintf( "%s%s\n", "\n" x $padding, $before );
1048 2         8 $after = sprintf( "%s%s\n", "\n" x $padding, $after );
1049 2 50       6 chomp $after if $after_deleted;
1050              
1051 2         15 my $diff = Text::Diff::diff(
1052             \$before, \$after,
1053             {
1054             CONTEXT => 0,
1055             STYLE => 'Unified',
1056             }
1057             );
1058              
1059 2 50       916 if ( $self->json ) {
1060 0         0 $json->{diff} = $diff;
1061 0         0 $self->logger->error( $self->_json_encoder->encode($json) );
1062             }
1063             else {
1064 2         28 $self->logger->error($justification);
1065 2         166 $self->logger->error($diff);
1066             }
1067             }
1068              
1069             sub _remove_with_trailing_characters {
1070 3     3   10 my $include = shift;
1071              
1072 3         31 while ( my $next = $include->next_sibling ) {
1073 7 50 66     343 if ( !$next->isa('PPI::Token::Whitespace')
1074             && !$next->isa('PPI::Token::Comment') ) {
1075 0         0 last;
1076             }
1077 7         46 $next->remove;
1078 7 100       374 last if $next eq "\n";
1079             }
1080 3         49 $include->remove;
1081 3         133 return;
1082             }
1083              
1084             sub _build_cache_dir {
1085             my $base_path
1086             = defined $ENV{HOME} && -d path( $ENV{HOME}, '.cache' )
1087 0 0 0 0   0 ? path( $ENV{HOME}, '.cache' )
1088             : path('/tmp');
1089              
1090 0         0 my $cache_dir = $base_path->child( 'perlimports', $VERSION );
1091 0         0 $cache_dir->mkpath;
1092              
1093 0         0 return $cache_dir;
1094             }
1095              
1096             sub _cache_file_for_module {
1097 0     0   0 my $self = shift;
1098 0         0 my $module = shift;
1099              
1100 0         0 return $self->_cache_dir->child($module);
1101             }
1102              
1103             sub _maybe_cache_inspectors {
1104 42     42   122 my $self = shift;
1105 42 50       1151 return unless $self->_cache;
1106              
1107 0         0 my @names = sort $self->all_inspector_names;
1108 0         0 $self->logger->info('maybe cache');
1109 0 0       0 return unless @names;
1110              
1111 0         0 my $append = 0;
1112 0         0 require Sereal::Encoder; ## no perlimports
1113 0         0 my $encoder = Sereal::Encoder->new(
1114             { croak_on_bless => 0, undef_unknown => 1, } );
1115              
1116 0         0 for my $name ( $self->all_inspector_names ) {
1117 0         0 my $file = $self->_cache_file_for_module($name);
1118 0 0       0 next if -e $file;
1119              
1120 0         0 $self->logger->info("I would like to cache $name at $file");
1121 0         0 $encoder->encode_to_file(
1122             $file,
1123             $self->inspector_for($name),
1124             $append
1125             );
1126             }
1127 0         0 return;
1128             }
1129              
1130             sub _is_word_interpreted_as_string {
1131 404     404   815 my ( $self, $word ) = @_;
1132              
1133 404 100 66     1147 return unless $word->statement && $word->isa('PPI::Token::Word');
1134 359         6976 my @children = $word->statement->schildren;
1135              
1136             # https://perldoc.perl.org/perlref#Not-so-symbolic-references
1137 359 100 100     9794 return 1 if is_hash_key($word) && @children == 1;
1138              
1139             # The => operator (sometimes pronounced "fat comma") is a synonym for
1140             # the comma except that it causes a word on its left to be interpreted
1141             # as a string if it begins with a letter or underscore and is composed
1142             # only of letters, digits and underscores. This includes operands that
1143             # might otherwise be interpreted as operators, constants, single number
1144             # v-strings or function calls.
1145             # https://perldoc.perl.org/perlop#Comma-Operator
1146 358 100       27020 return unless $word->content =~ /^[a-zA-Z_][a-zA-Z0-9_]*$/;
1147              
1148 321         3107 while ( my $current = shift @children ) {
1149 496 100       1865 last if refaddr($current) == refaddr($word);
1150             }
1151 321 100       1138 return unless ( my $current = shift @children );
1152 316 100 100     1596 return 1
1153             if $current->isa('PPI::Token::Operator')
1154             && $current->content eq '=>';
1155             }
1156              
1157             1;
1158              
1159             # ABSTRACT: Make implicit imports explicit
1160              
1161             __END__
1162              
1163             =pod
1164              
1165             =encoding UTF-8
1166              
1167             =head1 NAME
1168              
1169             App::perlimports::Document - Make implicit imports explicit
1170              
1171             =head1 VERSION
1172              
1173             version 0.000052
1174              
1175             =head1 MOTIVATION
1176              
1177             This module is to be used internally by L<perlimports>. It shouldn't be relied
1178             upon by anything else.
1179              
1180             =head2 inspector_for( $module_name )
1181              
1182             Returns an L<App::perlimports::ExporterInspector> object for the given module.
1183              
1184             =head2 linter_success
1185              
1186             Returns true if document was linted without errors, otherwise false.
1187              
1188             =head2 tidied_document
1189              
1190             Returns a serialized PPI document with (hopefully) tidy import statements.
1191              
1192             =head1 AUTHOR
1193              
1194             Olaf Alders <olaf@wundercounter.com>
1195              
1196             =head1 COPYRIGHT AND LICENSE
1197              
1198             This software is copyright (c) 2020 by Olaf Alders.
1199              
1200             This is free software; you can redistribute it and/or modify it under
1201             the same terms as the Perl 5 programming language system itself.
1202              
1203             =cut