1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
package Perl::Critic::Policy::TooMuchCode::ProhibitUnusedInclude;
use strict;
use warnings;
use Scalar::Util qw(refaddr);
use Perl::Critic::Utils;
use parent 'Perl::Critic::Policy';
sub default_themes { return qw( maintenance ) }
sub applies_to { return 'PPI::Document' }
sub supported_parameters {
return (
+{
name => 'ignore',
description => 'List of modules to be disregarded. Separated by whitespaces.',
behavior => 'string list',
}
)
}
#---------------------------------------------------------------------------
use constant {
## Some modules works like pragmas -- their very existence in the code implies that they are used.
PRAGMATIST => {
map { $_ => 1 }
qw(
Moose
Mouse
Moo
Mo
Test::NoWarnings
)
},
TRY_FAMILY => {
map { $_ => 1 }
qw(Try::Tiny Try::Catch Try::Lite TryCatch Try)
},
## These are the modules that, when used, the module name itself appears in the code.
USE_BY_MODULE_NAME => {
map { $_ => 1 }
qw(Hijk HTTP::Tiny HTTP::Lite LWP::UserAgent File::Spec)
},
## this mapping fines a set of modules with behaviour that introduce
## new words as subroutine names or method names when they are `use`ed
## without arguments.
#### for mod in $(perlbrew list-modules) Test2::V0; do perl -M${mod} -l -e 'if (my @e = grep /\A\w+\z/, (@'$mod'::EXPORT) ) { print "### \x27'$mod'\x27 => [qw(@e)],"; }' \; 2>/dev/null | grep '^### ' | cut -c 5- ; done
DEFAULT_EXPORT => {
'App::ModuleBuildTiny' => [qw(modulebuildtiny)],
'B::Hooks::EndOfScope' => [qw(on_scope_end)],
'Carp::Assert' => [qw(assert affirm should shouldnt DEBUG assert affirm should shouldnt DEBUG)],
'Carp::Assert::More' => [qw(assert_all_keys_in assert_arrayref assert_coderef assert_defined assert_empty assert_exists assert_fail assert_hashref assert_in assert_integer assert_is assert_isa assert_isa_in assert_isnt assert_lacks assert_like assert_listref assert_negative assert_negative_integer assert_nonblank assert_nonempty assert_nonnegative assert_nonnegative_integer assert_nonref assert_nonzero assert_nonzero_integer assert_numeric assert_positive assert_positive_integer assert_undefined assert_unlike)],
'Class::Method::Modifiers' => [qw(before after around)],
'Compress::Raw::Bzip2' => [qw(BZ_RUN BZ_FLUSH BZ_FINISH BZ_OK BZ_RUN_OK BZ_FLUSH_OK BZ_FINISH_OK BZ_STREAM_END BZ_SEQUENCE_ERROR BZ_PARAM_ERROR BZ_MEM_ERROR BZ_DATA_ERROR BZ_DATA_ERROR_MAGIC BZ_IO_ERROR BZ_UNEXPECTED_EOF BZ_OUTBUFF_FULL BZ_CONFIG_ERROR)],
'Compress::Raw::Zlib' => [qw(ZLIB_VERSION ZLIB_VERNUM OS_CODE MAX_MEM_LEVEL MAX_WBITS Z_ASCII Z_BEST_COMPRESSION Z_BEST_SPEED Z_BINARY Z_BLOCK Z_BUF_ERROR Z_DATA_ERROR Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY Z_DEFLATED Z_ERRNO Z_FILTERED Z_FIXED Z_FINISH Z_FULL_FLUSH Z_HUFFMAN_ONLY Z_MEM_ERROR Z_NEED_DICT Z_NO_COMPRESSION Z_NO_FLUSH Z_NULL Z_OK Z_PARTIAL_FLUSH Z_RLE Z_STREAM_END Z_STREAM_ERROR Z_SYNC_FLUSH Z_TREES Z_UNKNOWN Z_VERSION_ERROR WANT_GZIP WANT_GZIP_OR_ZLIB crc32 adler32 DEF_WBITS)],
'Cookie::Baker' => [qw(bake_cookie crush_cookie)],
'Cpanel::JSON::XS' => [qw(encode_json decode_json to_json from_json)],
'Crypt::RC4' => [qw(RC4)],
'DBIx::DSN::Resolver::Cached' => [qw(dsn_resolver)],
'DBIx::DisconnectAll' => [qw(dbi_disconnect_all)],
'Data::Clone' => [qw(clone)],
'Data::Compare' => [qw(Compare)],
'Data::Dump' => [qw(dd ddx)],
'Data::NestedParams' => [qw(expand_nested_params collapse_nested_params)],
'Data::UUID' => [qw(NameSpace_DNS NameSpace_OID NameSpace_URL NameSpace_X500)],
'Data::Validate::Domain' => [qw(is_domain is_hostname is_domain_label)],
'Data::Validate::IP' => [qw(is_ip is_ipv4 is_ipv6 is_innet_ipv4 is_multicast_ipv4 is_testnet_ipv4 is_anycast_ipv4 is_loopback_ipv4 is_private_ipv4 is_unroutable_ipv4 is_linklocal_ipv4 is_public_ipv4 is_loopback_ipv6 is_orchid_ipv6 is_special_ipv6 is_multicast_ipv6 is_private_ipv6 is_linklocal_ipv6 is_ipv4_mapped_ipv6 is_documentation_ipv6 is_teredo_ipv6 is_discard_ipv6 is_public_ipv6 is_linklocal_ip is_loopback_ip is_multicast_ip is_private_ip is_public_ip)],
'Data::Walk' => [qw(walk walkdepth)],
'Devel::CheckCompiler' => [qw(check_c99 check_c99_or_exit check_compile)],
'Devel::CheckLib' => [qw(assert_lib check_lib_or_exit check_lib)],
'Devel::GlobalDestruction' => [qw(in_global_destruction)],
'Dist::CheckConflicts' => [qw(conflicts check_conflicts calculate_conflicts dist)],
'Email::MIME::ContentType' => [qw(parse_content_type parse_content_disposition)],
'Encode' => [qw(decode decode_utf8 encode encode_utf8 str2bytes bytes2str encodings find_encoding find_mime_encoding clone_encoding)],
'Eval::Closure' => [qw(eval_closure)],
'ExtUtils::MakeMaker' => [qw(WriteMakefile prompt os_unsupported)],
'File::HomeDir' => [qw(home)],
'File::Listing' => [qw(parse_dir)],
'File::Path' => [qw(mkpath rmtree)],
'File::ShareDir::Install' => [qw(install_share delete_share)],
'File::Which' => [qw(which)],
'File::Zglob' => [qw(zglob)],
'File::pushd' => [qw(pushd tempd)],
'Graphics::ColorUtils' => [qw(rgb2yiq yiq2rgb rgb2cmy cmy2rgb rgb2hls hls2rgb rgb2hsv hsv2rgb)],
'HTML::Escape' => [qw(escape_html)],
'HTTP::Date' => [qw(time2str str2time)],
'HTTP::Negotiate' => [qw(choose)],
'IO::All' => [qw(io)],
'IO::HTML' => [qw(html_file)],
'IO::Socket::SSL' => [qw(SSL_WANT_READ SSL_WANT_WRITE SSL_VERIFY_NONE SSL_VERIFY_PEER SSL_VERIFY_FAIL_IF_NO_PEER_CERT SSL_VERIFY_CLIENT_ONCE SSL_OCSP_NO_STAPLE SSL_OCSP_TRY_STAPLE SSL_OCSP_MUST_STAPLE SSL_OCSP_FAIL_HARD SSL_OCSP_FULL_CHAIN GEN_DNS GEN_IPADD)],
'IPC::Run3' => [qw(run3)],
'JSON' => [qw(from_json to_json jsonToObj objToJson encode_json decode_json)],
'JSON::MaybeXS' => [qw(encode_json decode_json JSON)],
'JSON::PP' => [qw(encode_json decode_json from_json to_json)],
'JSON::Types' => [qw(number string bool)],
'JSON::XS' => [qw(encode_json decode_json)],
'LWP::MediaTypes' => [qw(guess_media_type media_suffix)],
'Lingua::JA::Regular::Unicode' => [qw(hiragana2katakana alnum_z2h alnum_h2z space_z2h katakana2hiragana katakana_h2z katakana_z2h space_h2z)],
'Locale::Currency::Format' => [qw(currency_format currency_name currency_set currency_symbol decimal_precision decimal_separator thousands_separator FMT_NOZEROS FMT_STANDARD FMT_COMMON FMT_SYMBOL FMT_HTML FMT_NAME SYM_UTF SYM_HTML)],
'Log::Minimal' => [qw(critf critff warnf warnff infof infoff debugf debugff croakf croakff ddf)],
'MIME::Charset' => [qw(body_encoding canonical_charset header_encoding output_charset body_encode encoded_header_len header_encode)],
'Math::Round' => [qw(round nearest)],
'Module::Build::Tiny' => [qw(Build Build_PL)],
'Module::Find' => [qw(findsubmod findallmod usesub useall setmoduledirs)],
'Module::Functions' => [qw(get_public_functions)],
'Module::Spy' => [qw(spy_on)],
'PLON' => [qw(encode_plon decode_pson)],
'Path::Class' => [qw(file dir)],
'Path::Tiny' => [qw(path)],
'Proc::Wait3' => [qw(wait3)],
'Readonly' => [qw(Readonly)],
'SQL::QueryMaker' => [qw(sql_op sql_raw sql_and sql_or sql_in sql_not_in sql_ne sql_not sql_like sql_is_not_null sql_is_null sql_ge sql_gt sql_eq sql_lt sql_le sql_between sql_not_between)],
'Smart::Args' => [qw(args args_pos)],
'Socket' => [qw(PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6 PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN PF_X25 AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6 AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN AF_X25 SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE IP_HDRINCL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS IP_TTL MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC MSG_DONTROUTE MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FASTOPEN MSG_FIN MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE SHUT_RD SHUT_RDWR SHUT_WR INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP SOMAXCONN IOV_MAX UIO_MAXIOV sockaddr_family pack_sockaddr_in unpack_sockaddr_in sockaddr_in pack_sockaddr_in6 unpack_sockaddr_in6 sockaddr_in6 pack_sockaddr_un unpack_sockaddr_un sockaddr_un inet_aton inet_ntoa)],
'String::Format' => [qw(stringf)],
'String::ShellQuote' => [qw(shell_quote shell_quote_best_effort shell_comment_quote)],
'Sub::Name' => [qw(subname)],
'Sub::Quote' => [qw(quote_sub unquote_sub quoted_from_sub qsub)],
'Sub::Retry' => [qw(retry)],
'Teng::Plugin::TextTable' => [qw(draw_text_table)],
'Test2::V0' => [qw(ok pass fail diag note todo skip plan skip_all done_testing bail_out intercept context gen_event def do_def cmp_ok warns warning warnings no_warnings subtest can_ok isa_ok DOES_ok set_encoding imported_ok not_imported_ok ref_ok ref_is ref_is_not mock mocked dies lives try_ok is like isnt unlike match mismatch validator hash array bag object meta meta_check number float rounded within string subset bool in_set not_in_set check_set item field call call_list call_hash prop check all_items all_keys all_vals all_values etc end filter_items T F D DF E DNE FDNE U event fail_events exact_ref)],
'Test::BinaryData' => [qw(is_binary)],
'Test::Deep' => [qw(Isa blessed obj_isa all any array array_each arrayelementsonly arraylength arraylengthonly bag bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply hash hash_each hashkeys hashkeysonly ignore isa listmethods methods noclass none noneof num re reftype regexpmatches regexponly regexpref regexprefonly scalarrefonly scalref set shallow str subbagof subhashof subsetof superbagof superhashof supersetof useclass)],
'Test::Differences' => [qw(eq_or_diff eq_or_diff_text eq_or_diff_data unified_diff context_diff oldstyle_diff table_diff)],
'Test::Exception' => [qw(dies_ok lives_ok throws_ok lives_and)],
'Test::Fatal' => [qw(exception)],
'Test::Kantan' => [qw(Feature Scenario Given When Then subtest done_testing setup teardown describe context it before_each after_each expect ok diag ignore spy_on skip_all)],
'Test::LongString' => [qw(is_string is_string_nows like_string unlike_string contains_string lacks_string)],
'Test::Mock::Guard' => [qw(mock_guard)],
'Test::More' => [qw(ok use_ok require_ok is isnt like unlike is_deeply cmp_ok skip todo todo_skip pass fail eq_array eq_hash eq_set plan done_testing can_ok isa_ok new_ok diag note explain subtest BAIL_OUT)],
'Test::Object' => [qw(object_ok)],
'Test::Output' => [qw(output_like stderr_from output_isnt stderr_is stdout_unlike combined_isnt output_is combined_is stdout_is stderr_isnt stdout_like combined_unlike stderr_unlike output_from combined_from stdout_isnt output_unlike combined_like stdout_from stderr_like)],
'Test::Simple' => [qw(ok)],
'Test::Spec' => [qw(runtests describe xdescribe context xcontext it xit they xthey before after around yield spec_helper share shared_examples_for it_should_behave_like)],
'Test::Stub' => [qw(stub make_stub)],
'Test::SubCalls' => [qw(sub_track sub_calls sub_reset sub_reset_all)],
'Test::TempDir::Tiny' => [qw(tempdir in_tempdir)],
'Test::TCP' => [qw(empty_port test_tcp wait_port)],
'Test::Warn' => [qw(warning_is warnings_are warning_like warnings_like warnings_exist)],
'Text::Diff' => [qw(diff)],
'Time::Piece' => [qw(localtime gmtime)],
'Try::Tiny' => [qw(try catch finally)],
'URI::Find' => [qw(find_uris)],
'URL::Builder' => [qw(build_url build_url_utf8)],
'UUID::Tiny' => [qw(UUID_NIL UUID_NS_DNS UUID_NS_URL UUID_NS_OID UUID_NS_X500 UUID_V1 UUID_V3 UUID_V4 UUID_V5 UUID_SHA1_AVAIL create_UUID create_UUID_as_string is_UUID_string UUID_to_string string_to_UUID version_of_UUID time_of_UUID clk_seq_of_UUID equal_UUIDs)],
'Want' => [qw(want rreturn lnoreturn)],
'XML::Simple' => [qw(XMLin XMLout)],
'YAML' => [qw(Dump Load)],
}
};
sub violates {
my ( $self, $elem, $doc ) = @_;
my @includes = grep {
my $mod = $_->module;
!$_->pragma && $mod && (! $self->{_ignore}{$mod})
} @{ $doc->find('PPI::Statement::Include') ||[] };
return () unless @includes;
return () if grep { $_->module eq 'Module::Functions' } @includes;
my %uses;
$self->gather_uses_pragmatists(\@includes, $doc, \%uses);
$self->gather_uses_try_family(\@includes, $doc, \%uses);
$self->gather_uses_generic(\@includes, $doc, \%uses);
return map {
$self->violation(
"Unused include: " . $_->module,
"A module is `use`-ed but not really consumed in other places in the code",
$_
)
} grep {
my $mod = $_->module;
(! $uses{refaddr($_)}) && (TRY_FAMILY->{$mod} || DEFAULT_EXPORT->{$mod} || USE_BY_MODULE_NAME->{$mod})
} @includes;
}
sub gather_uses_pragmatists {
my ( $self, $includes, $doc, $uses ) = @_;
for (grep { PRAGMATIST->{$_->module} } @$includes) {
my $r = refaddr($_);
$uses->{$r} = 1;
}
}
sub gather_uses_generic {
my ( $self, $includes, $doc, $uses ) = @_;
my @words = grep { ! $_->statement->isa('PPI::Statement::Include') } @{ $doc->find('PPI::Token::Word') || []};
my @mods = grep { !$uses->{$_} } map { $_->module } @$includes;
my @inc_without_args;
for my $inc (@$includes) {
if ($inc->arguments) {
my $r = refaddr($inc);
$uses->{$r} = -1;
} else {
push @inc_without_args, $inc;
}
}
for my $word (@words) {
for my $inc (@inc_without_args) {
my $mod = $inc->module;
my $r = refaddr($inc);
next if $uses->{$r};
$uses->{$r} = 1 if ($word->content =~ /\A $mod (\z|::)/x) || (grep { $_ eq $word } @{DEFAULT_EXPORT->{$mod} ||[]}) || ("$word" eq "$inc");
}
}
}
sub gather_uses_try_family {
my ( $self, $includes, $doc, $uses ) = @_;
my @uses_tryish_modules = grep { TRY_FAMILY->{$_->module} } @$includes;
return unless @uses_tryish_modules;
my $has_try_block = 0;
for my $try_keyword (@{ $doc->find(sub { $_[1]->isa('PPI::Token::Word') && $_[1]->content eq 'try' }) ||[]}) {
my $try_block = $try_keyword->snext_sibling or next;
next unless $try_block->isa('PPI::Structure::Block');
$has_try_block = 1;
last;
}
return unless $has_try_block;
$uses->{refaddr($_)} = 1 for @uses_tryish_modules;
}
1;
=encoding utf-8
=head1 NAME
TooMuchCode::ProhibitUnusedInclude -- Find unused include statements.
=head1 DESCRIPTION
This critic policy scans for unused include statement according to their documentation.
For example, L<Try::Tiny> implicitly introduce a C<try> subroutine that takes a block. Therefore, a
lonely C<use Try::Tiny> statement without a C<try { .. }> block somewhere in its scope is considered
to be an "Unused Include".
Notice: This module use a hard-coded list of commonly-used CPAN
modules with symbols exported from them. Although it is relatively
static, it needs to be revised from time to time.
=cut
|
