DESC
=>
'Return value of "close" ignored'
,
EXPL
=>
'Check the return value of "close" for success'
,
};
sub
evaluate {
my
(
$class
,
$file
,
$tokens
,
$src
,
$args
) =
@_
;
my
$is_in_assign_context
= 0;
my
$is_in_statement_context
= 0;
my
$is_called_close_in_void
= 0;
my
$is_enabled_autodie
= 0;
my
@violations
;
for
(
my
$i
= 0;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
my
$token_kind
=
$token
->{kind};
my
$token_data
=
$token
->{data};
if
(
$token_type
== ASSIGN) {
$is_in_assign_context
= 1;
next
;
}
if
(
$token_type
== USED_NAME) {
if
(
$token_data
eq
'Fatal'
) {
my
$next_token
=
$tokens
->[
$i
+1];
my
$next_token_type
=
$next_token
->{type};
if
(
$next_token_type
== REG_LIST) {
for
(
$i
+= 3;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== REG_EXP &&
$token
->{data} eq
'close'
) {
return
[];
}
elsif
(
$token_type
== REG_DELIM) {
last
;
}
}
}
elsif
(
$next_token_type
== LEFT_PAREN) {
my
$left_paren_num
= 1;
for
(
$i
+= 2;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== LEFT_PAREN) {
$left_paren_num
++;
}
elsif
((
$token_type
== STRING ||
$token_type
== RAW_STRING) &&
$token
->{data} eq
'close'
) {
return
[];
}
else
{
last
if
--
$left_paren_num
<= 0;
}
}
}
elsif
((
$next_token_type
== STRING ||
$next_token_type
== RAW_STRING) &&
$next_token
->{data} eq
'close'
) {
last
;
}
}
elsif
(
$token_data
eq
'autodie'
) {
if
(
$tokens
->[
$i
+1]->{type} == REG_LIST) {
for
(
$i
+= 3;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== REG_EXP &&
$token
->{data} =~ /\A\s*:io\s*\Z/) {
$is_enabled_autodie
= 1;
}
elsif
(
$token_type
== REG_DELIM) {
last
;
}
}
}
else
{
$is_enabled_autodie
= 1;
}
}
next
;
}
if
(
$token_type
== NAMESPACE &&
$token_data
eq
'Fatal'
) {
my
$skipped_token
=
$tokens
->[
$i
+2];
if
(
$skipped_token
&&
$skipped_token
->{type} == NAMESPACE &&
$skipped_token
->{data} eq
'Exception'
) {
for
(
$i
+= 3;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== REG_LIST) {
for
(
$i
+= 2;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== REG_EXP &&
$token
->{data} eq
'close'
) {
return
[];
}
elsif
(
$token_type
== REG_DELIM) {
last
;
}
}
}
elsif
(
$token_type
== LEFT_PAREN) {
my
$left_paren_num
= 1;
for
(
$i
++;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== LEFT_PAREN) {
$left_paren_num
++;
}
elsif
((
$token_type
== STRING ||
$token_type
== RAW_STRING) &&
$token
->{data} eq
'close'
) {
return
[];
}
else
{
last
if
--
$left_paren_num
<= 0;
}
}
}
elsif
((
$token_type
== STRING ||
$token_type
== RAW_STRING) &&
$token
->{data} eq
'close'
) {
last
;
}
elsif
(
$token
->{kind} == KIND_STMT_END) {
last
;
}
}
}
next
;
}
if
(
$token_kind
== KIND_STMT) {
$is_in_statement_context
= 1;
if
(
$tokens
->[
$i
+1]->{type} == LEFT_PAREN) {
$i
++;
my
$left_paren_num
= 1;
for
(
$i
++;
my
$token
=
$tokens
->[
$i
];
$i
++) {
my
$token_type
=
$token
->{type};
if
(
$token_type
== LEFT_PAREN) {
$left_paren_num
++;
}
else
{
last
if
--
$left_paren_num
<= 0;
}
}
}
next
;
}
if
(
$token_type
== BUILTIN_FUNC) {
if
(
$token_data
eq
'close'
) {
if
(!
$is_in_assign_context
&& !
$is_in_statement_context
) {
$is_called_close_in_void
= 1;
}
}
elsif
(
$token_data
eq
'no'
) {
my
$next_token
=
$tokens
->[++
$i
];
if
(
$next_token
->{type} == KEY &&
$next_token
->{data} eq
'autodie'
) {
$is_enabled_autodie
= 0;
}
}
next
;
}
if
(
$token_kind
== KIND_OP) {
$is_called_close_in_void
= 0;
next
;
}
if
(
$token_kind
== KIND_STMT_END) {
next
if
$is_enabled_autodie
;
if
(
$is_called_close_in_void
) {
push
@violations
, {
filename
=>
$file
,
line
=>
$token
->{line},
description
=> DESC,
explanation
=> EXPL,
policy
=> __PACKAGE__,
};
}
$is_in_assign_context
= 0;
$is_in_statement_context
= 0;
$is_called_close_in_void
= 0;
next
;
}
}
return
\
@violations
;
}
1;