view release on metacpan or  search on metacpan

share/PerlCritic/Critic/Utils.pm  view on Meta::CPAN

Readonly::Hash my %BAREWORDS => hashify( @B::Keywords::Barewords );

sub is_perl_bareword {
    my $elem = shift;
    return if !$elem;

    return exists $BAREWORDS{ _name_for_sub_or_stringified_element($elem) };
}

#-----------------------------------------------------------------------------

sub _build_globals_without_sigils {
    # B::Keywords as of 1.08 forgot $\
    my @globals =
        map { substr $_, 1 }
            @B::Keywords::Arrays,
            @B::Keywords::Hashes,
            @B::Keywords::Scalars,
            '$\\'; ## no critic (RequireInterpolationOfMetachars)

    # Not all of these have sigils
    foreach my $filehandle (@B::Keywords::Filehandles) {
        (my $stripped = $filehandle) =~ s< \A [*] ><>xms;
        push @globals, $stripped;
    }

    return @globals;
}

Readonly::Array my @GLOBALS_WITHOUT_SIGILS => _build_globals_without_sigils();

Readonly::Hash my %GLOBALS => hashify( @GLOBALS_WITHOUT_SIGILS );

sub is_perl_global {
    my $elem = shift;
    return if !$elem;
    my $var_name = "$elem"; #Convert Token::Symbol to string
    $var_name =~ s{\A [\$@%*] }{}xms;  #Chop off the sigil
    return exists $GLOBALS{ $var_name };
}

#-----------------------------------------------------------------------------

Readonly::Hash my %FILEHANDLES => hashify( @B::Keywords::Filehandles );

sub is_perl_filehandle {
    my $elem = shift;
    return if !$elem;

    return exists $FILEHANDLES{ _name_for_sub_or_stringified_element($elem) };
}

## use critic
#-----------------------------------------------------------------------------

# egrep '=item.*LIST' perlfunc.pod
Readonly::Hash my %BUILTINS_WHICH_PROVIDE_LIST_CONTEXT =>
    hashify(
        qw{
            chmod
            chown
            die
            exec
            formline
            grep
            import
            join
            kill
            map
            no
            open
            pack
            print
            printf
            push
            reverse
            say
            sort
            splice
            sprintf
            syscall
            system
            tie
            unlink
            unshift
            use
            utime
            warn
        },
    );

sub is_perl_builtin_with_list_context {
    my $elem = shift;

    return
        exists
            $BUILTINS_WHICH_PROVIDE_LIST_CONTEXT{
                _name_for_sub_or_stringified_element($elem)
            };
}

#-----------------------------------------------------------------------------

# egrep '=item.*[A-Z],' perlfunc.pod
Readonly::Hash my %BUILTINS_WHICH_TAKE_MULTIPLE_ARGUMENTS =>
    hashify(
        qw{
            accept
            atan2
            bind
            binmode
            bless
            connect
            crypt
            dbmopen
            fcntl
            flock
            gethostbyaddr
            getnetbyaddr
            getpriority
            getservbyname