DESC
=>
'Magic punctuation variable %s used'
,
EXPL
=> [79],
};
my
%var_token_types
= (
&VAR
=> 1,
&ARRAY_VAR
=> 1,
&HASH_VAR
=> 1,
&GLOBAL_VAR
=> 1,
&GLOBAL_ARRAY_VAR
=> 1,
&GLOBAL_HASH_VAR
=> 1,
);
my
%expands_regexp_token_types
= (
®_EXEC
=> 1,
®_DECL
=> 1,
®_DOUBLE_QUOTE
=> 1,
);
my
%special_variable_token_types
= (
&SPECIFIC_VALUE
=> 1,
&ARRAY_SIZE
=> 1,
);
my
%magic_variables
= (
'$1'
=> 1,
'$2'
=> 1,
'$3'
=> 1,
'$4'
=> 1,
'$5'
=> 1,
'$6'
=> 1,
'$7'
=> 1,
'$8'
=> 1,
'$9'
=> 1,
'$_'
=> 1,
'$&'
=> 1,
'$`'
=> 1,
'$+'
=> 1,
'@+'
=> 1,
'@*'
=> 1,
'%+'
=> 1,
'$*'
=> 1,
'$.'
=> 1,
'$/'
=> 1,
'$|'
=> 1,
'$('
=> 1,
'$"'
=> 1,
'$;'
=> 1,
'$%'
=> 1,
'$='
=> 1,
'$-'
=> 1,
'@-'
=> 1,
'%-'
=> 1,
'$)'
=> 1,
'$~'
=> 1,
'$^'
=> 1,
'$:'
=> 1,
'$?'
=> 1,
'$!'
=> 1,
'%!'
=> 1,
'$@'
=> 1,
'$$'
=> 1,
'$<'
=> 1,
'$>'
=> 1,
'$0'
=> 1,
'$['
=> 1,
'$]'
=> 1,
'@_'
=> 1,
q{$'}
=> 1,
'$^L'
=> 1,
'$^A'
=> 1,
'$^E'
=> 1,
'$^C'
=> 1,
'$^D'
=> 1,
'$^F'
=> 1,
'$^H'
=> 1,
'$^I'
=> 1,
'$^M'
=> 1,
'$^N'
=> 1,
'$^O'
=> 1,
'$^P'
=> 1,
'$^R'
=> 1,
'$^S'
=> 1,
'$^T'
=> 1,
'$^V'
=> 1,
'$^W'
=> 1,
'$^X'
=> 1,
'%^H'
=> 1,
'$\\'
=> 1,
'$::|'
=> 1,
'$}'
=> 1,
'$,'
=> 1,
'$#'
=> 1,
'$#+'
=> 1,
'$#-'
=> 1,
);
my
%ignore_for_interpolation
= (
q{$'}
=> 1,
q{$$}
=> 1,
q{$#}
=> 1,
q{$:}
=> 1,
);
sub
evaluate {
my
(
$class
,
$file
,
$tokens
,
$src
,
$args
) =
@_
;
my
$string_mode
=
''
;
my
%exempt_vars
= (
'$_'
=> 1,
'@_'
=> 1,
'$]'
=> 1,
'$1'
=> 1,
'$2'
=> 1,
'$3'
=> 1,
'$4'
=> 1,
'$5'
=> 1,
'$6'
=> 1,
'$7'
=> 1,
'$8'
=> 1,
'$9'
=> 1,
);
if
(
my
$this_policies_arg
=
$args
->{prohibit_punctuation_vars}) {
$string_mode
=
$this_policies_arg
->{string_mode} ||
''
;
if
(
$string_mode
eq
'thorough'
) {
%exempt_vars
= ();
}
for
my
$exempt_var
(
split
(/\s+/,
$this_policies_arg
->{allow} ||
''
)) {
$exempt_vars
{
$exempt_var
} = 1;
}
}
my
$lexer_for_str
= Compiler::Lexer->new;
my
@violations
;
for
(
my
$i
= 0,
my
$token_type
,
my
$token_data
,
my
$is_ref
= 0,
my
$is_raw_heredoc_tag
= 0;
my
$token
=
$tokens
->[
$i
];
$i
++
) {
$token_type
=
$token
->{type};
$token_data
=
$token
->{data};
if
(
$special_variable_token_types
{
$token_type
}) {
if
(
$is_ref
) {
$is_ref
= 0;
next
;
}
if
(
$exempt_vars
{
$token_data
}) {
next
;
}
if
(!
$magic_variables
{
$token_data
}) {
next
;
}
push
@violations
, {
filename
=>
$file
,
line
=>
$token
->{line},
description
=>
sprintf
(DESC,
$token_data
),
explanation
=> EXPL,
policy
=> __PACKAGE__,
};
next
;
}
if
(
$var_token_types
{
$token_type
}) {
if
(
$is_ref
) {
$is_ref
= 0;
next
;
}
if
(
$exempt_vars
{
$token_data
}) {
next
;
}
if
(!
$magic_variables
{
$token_data
}) {
next
;
}
if
(
substr
(
$token_data
, 1, 1) =~ /\A[^a-zA-Z]\Z/) {
push
@violations
, {
filename
=>
$file
,
line
=>
$token
->{line},
description
=>
sprintf
(DESC,
$token_data
),
explanation
=> EXPL,
policy
=> __PACKAGE__,
};
}
next
;
}
if
(
$token_type
== REF) {
$is_ref
= 1;
next
;
}
if
(
$token_type
== HERE_DOCUMENT_RAW_TAG) {
$is_raw_heredoc_tag
= 1;
next
;
}
if
(
$token_type
== HERE_DOCUMENT_END) {
$is_raw_heredoc_tag
= 0;
next
;
}
if
(
$expands_regexp_token_types
{
$token_type
}) {
$i
+= 2;
$token
=
$tokens
->[
$i
];
if
(
$token
->{type} != REG_EXP) {
next
;
}
$token_data
=
$token
->data;
$token_type
= STRING;
}
if
(
$token_type
== STRING ||
$token_type
== EXEC_STRING
) {
if
(
$string_mode
eq
'disable'
) {
next
;
}
my
$parts
=
$lexer_for_str
->tokenize(
$token_data
);
my
$ref_count
= 0;
for
(
my
$j
= 0,
my
$part_type
,
my
$used_var
;
my
$part
=
$parts
->[
$j
];
$j
++) {
$part_type
=
$part
->{type};
$used_var
=
$part
->{data};
if
(
$part_type
== REF) {
$ref_count
++;
next
;
}
if
(
$ref_count
% 2 != 0) {
$ref_count
= 0;
next
;
}
if
(
$part_type
== SPECIFIC_VALUE) {
if
(
$used_var
eq
'$:'
) {
$part
=
$parts
->[
$j
+1];
if
(
$part
&&
$part
->{type} == COLON) {
$part
=
$parts
->[
$j
+2];
if
(
$part
&&
$part
->{type} == BIT_OR) {
$used_var
=
'$::|'
;
}
else
{
next
;
}
}
}
}
elsif
(
$part_type
!= ARRAY_SIZE) {
if
(!
$var_token_types
{
$part_type
}) {
next
;
}
$part
=
$parts
->[++
$j
];
if
(
$part
) {
if
(
$used_var
eq
'$'
) {
if
(
$part
->{type} == RIGHT_BRACE) {
$used_var
=
'$}'
;
}
}
elsif
(
$used_var
eq
'@'
) {
if
(
$part
->{type} == MUL) {
$used_var
=
'@*'
;
}
}
elsif
(
$used_var
eq
'%-'
) {
if
(
$part
->{type} == INT) {
next
;
}
}
}
}
if
(
$exempt_vars
{
$used_var
}) {
next
;
}
if
(
$string_mode
eq
'simple'
&&
$ignore_for_interpolation
{
$used_var
}) {
next
;
}
if
(
$magic_variables
{
$used_var
}) {
push
@violations
, {
filename
=>
$file
,
line
=>
$token
->{line},
description
=>
sprintf
(DESC,
$used_var
),
explanation
=> EXPL,
policy
=> __PACKAGE__,
};
}
}
next
;
}
}
return
\
@violations
;
}
1;