view release on metacpan or  search on metacpan

lib/App/Test/Generator/Analyzer/SideEffect.pm  view on Meta::CPAN

C<impure>.

=back

=head3 Notes

Detection is based on regex pattern matching against the raw source
text and will not catch dynamically constructed calls or aliased
operations. The global variable pattern covers common Perl specials
but is not exhaustive.

=head3 API specification

=head4 input

    {
        self   => { type => OBJECT, isa => 'App::Test::Generator::Analyzer::SideEffect' },
        method => { type => HASHREF },
    }

=head4 output

    {
        type => HASHREF,
        keys => {
            mutates_self    => { type => SCALAR },
            mutates_globals => { type => SCALAR },
            performs_io     => { type => SCALAR },
            calls_external  => { type => SCALAR },
            mutation_fields => { type => ARRAYREF },
            purity_level    => { type => SCALAR },
        },
    }

=cut

sub analyze {
	my ($self, $method) = @_;

	# Method argument is a raw hashref from SchemaExtractor
	my $body = $method->{body} // '';

	# IO/exec keywords are only real side effects as bare identifiers;
	# the same words inside string literals or comments (e.g. a log
	# message "system check failed" or a comment "# warn the caller")
	# must not trigger a false positive
	my $code_only = _strip_strings_and_comments($body);

	my %result = (
		mutates_self    => 0,
		mutates_globals => 0,
		performs_io     => 0,
		calls_external  => 0,
		mutation_fields => [],
	);

	# --------------------------------------------------
	# Detect assignment to $self->{field} — any such
	# assignment means the method mutates its own state.
	# Matched against $code_only so a field-assignment-like
	# fragment appearing inside a string literal or comment
	# is not mistaken for an actual mutation.
	# --------------------------------------------------
	my %seen_fields;
	while($code_only =~ /\$self->\{(\w+)\}\s*=/g) {
		$result{mutates_self} = 1;

		# Deduplicate field names in case the same field
		# is assigned more than once in the method body
		push @{ $result{mutation_fields} }, $1
			unless $seen_fields{$1}++;
	}

	# --------------------------------------------------
	# Detect mutation of global variables — %ENV, %SIG,
	# @ARGV and common Perl special variables. Matched
	# against $code_only for the same reason as above.
	# NOTE: does not catch all possible globals.
	# --------------------------------------------------
	if($code_only =~ GLOBAL_PATTERN) {
		$result{mutates_globals} = 1;
	}

	# --------------------------------------------------
	# Detect IO operations — print, say, warn, open etc.
	# Higher-level logging abstractions are not detected.
	# Matched against $code_only so a keyword appearing
	# inside a string literal or comment is not mistaken
	# for an actual IO call.
	# --------------------------------------------------
	if($code_only =~ IO_PATTERN) {
		$result{performs_io} = 1;
	}

	# --------------------------------------------------
	# Detect external command execution via system(),
	# exec(), qx() or backtick operators. Matched against
	# $code_only for the same reason as IO_PATTERN above.
	# --------------------------------------------------
	if($code_only =~ EXEC_PATTERN) {
		$result{calls_external} = 1;
	}

	# --------------------------------------------------
	# Classify purity level based on detected side effects.
	# pure         — no side effects of any kind
	# self_mutating — only mutates own state, no external effects
	# impure       — any external side effect present
	# --------------------------------------------------
	my $has_external = $result{mutates_globals}
		|| $result{performs_io}
		|| $result{calls_external};

	$result{purity_level} =
		!$result{mutates_self} && !$has_external ? $PURITY_PURE         :
		$result{mutates_self}  && !$has_external ? $PURITY_SELF_MUTATING :
		                                           $PURITY_IMPURE;

	return \%result;
}