view release on metacpan or  search on metacpan

lib/PPIx/PerlCompiler/Statement.pm  view on Meta::CPAN

    return 0;
}

sub concise_string {
    my ($self) = @_;

    my $string = $self->content;

    chomp $string;

    $string =~ s/\s+/ /g;

    return $string;
}

sub mutates_special_var {
    my ($self) = @_;

    my $pattern = qr{^
        (?:
            \$[\(\)<>"\/0] |
            [\$\@%](?:
                  ENV
                | SIG
                | ARGV
                | ARGVOUT
                | REAL_GROUP_ID
                | GID
                | REAL_USER_ID
                | UID
                | EFFECTIVE_GROUP_ID
            )
        )
    $}xms;

    return $self->isa_nonlexical_assignment_to($pattern);
}

sub performs_system_io {
    my ($self) = @_;

    my @patterns;

    #
    # Core Perl I/O builtins and POSIX:: variants
    #
    push @patterns, qr{^
        (?:sys|POSIX::|)(?:
              open(?:dir|)
            | close(?:dir|)
            | (?:f|)read
            | (?:f|)write
            | print(?:f|)
            | unlink
            | rmdir
            | tell
            | dup(?:|2)
            | pipe
            | chmod
            | chown
            | creat
            | mknod
            | mkdir
            | exec(?:ve|le|l|v|lp|vp|)
            | fcntl
            | fdopen
            | feof
            | eof
            | (?:f|)flush
            | (?:f|)seek
        )
    $}xms;

    #
    # IPC::Open3
    #
    push @patterns, qr{^(?:IPC::Open3::|)open3$};

    foreach my $pattern (@patterns) {
        return 1 if $self->contains_call_to($pattern);
    }

    return 0;
}

sub performs_process_ops {
    my ($self) = @_;

    my $pattern = qr{^
        (?:POSIX::|)(?:
            | exec(?:ve|le|l|v|lp)
            | exit
            | fork
        )
    $}xms;

    return $self->contains_call_to($pattern);
}

sub has_string_eval {
    my ($self) = @_;

    my $last;

    foreach my $child ( @{ $self->{'children'} } ) {
        next if $child->isa('PPI::Token::Whitespace');

        if ( $last && $last->matches( 'PPI::Token::Word' => 'eval' ) ) {
            return 1 if $child->isa('PPI::Token::Quote');

            if ( $child->isa('PPI::Structure::List') ) {
                my $first = $child->item(0) or return 0;

                return 1 if $first->isa('PPI::Token::Quote');
            }
        }

        $last = $child;
    }