1package Perl::Lint::Policy::BuiltinFunctions::ProhibitUniversalIsa;
2use strict;
3use warnings;
4use Perl::Lint::Constants::Type;
5use parent "Perl::Lint::Policy";
6
7use constant {
8    DESC => 'UNIVERSAL::isa should not be used as a function',
9    EXPL => 'Use eval{$obj->isa($pkg)} instead',
10};
11
12sub evaluate {
13    my ($class, $file, $tokens, $src, $args) = @_;
14
15    my @violations;
16    for (my $i = 0; my $token = $tokens->[$i]; $i++) {
17        my $token_type = $token->{type};
18        my $token_data = $token->{data};
19
20        if ($token_type == KEY && $token_data eq 'isa') { # for isa()
21            $token = $tokens->[++$i];
22            if ($token->{type} == LEFT_PAREN) {
23                push @violations, {
24                    filename => $file,
25                    line     => $token->{line},
26                    description => DESC,
27                    explanation => EXPL,
28                    policy => __PACKAGE__,
29                };
30            }
31        }
32        elsif ($token_type == NAMESPACE && $token_data eq 'UNIVERSAL') { # for UNIVERSAL::isa()
33            $i += 2; # skip the name space resolver
34            $token = $tokens->[$i];
35            if ($token->{type} == NAMESPACE && $token->{data} eq 'isa') {
36                if ($tokens->[++$i]->{type} == LEFT_PAREN) {
37                    push @violations, {
38                        filename => $file,
39                        line     => $token->{line},
40                        description => DESC,
41                        explanation => EXPL,
42                        policy => __PACKAGE__,
43                    };
44                }
45            }
46        }
47    }
48
49    return \@violations;
50}
51
521;
53
54