DESC
=>
'The names of or patterns for modules to forbid'
,
EXPL
=>
'Find an alternative module'
,
};
Class::ISA
Pod::Plainer
Shell
Switch
/
];
sub
evaluate {
my
(
$class
,
$file
,
$tokens
,
$src
,
$args
) =
@_
;
my
$modules_arg
=
$args
->{prohibit_evil_modules}->{modules} ||
''
;
$modules_arg
=~ s/{.*?}//g;
my
@evils
=
split
(/ /,
$modules_arg
);
my
$modules_file
=
$args
->{prohibit_evil_modules}->{modules_file};
if
(
$modules_file
) {
open
my
$fh
,
'<'
,
$modules_file
;
my
$content
=
do
{
local
$/; <
$fh
> };
push
@evils
, (
$content
=~ /^\s*?([^ \n\r\f\t
}
my
@evils_re
=
map
{m!/(.+?)/!; $1}
@evils
;
my
@violations
;
for
(
my
$i
= 0;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== USE_DECL) {
my
$used_name
=
''
;
for
(
$i
++;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
!= NAMESPACE &&
$token_type
!= NAMESPACE_RESOLVER &&
$token_type
!= USED_NAME
) {
last
;
}
$used_name
.=
$token
->{data};
}
if
(
any {
$used_name
eq
$_
} (@{+EVILS},
@evils
) or
any {
$_
&&
$used_name
=~ /
$_
/}
@evils_re
) {
push
@violations
, {
filename
=>
$file
,
line
=>
$token
->{line},
description
=> DESC,
explanation
=> EXPL,
policy
=> __PACKAGE__,
};
}
}
}
return
\
@violations
;
}
1;