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 |